CDRectsImpl.mesa (part of ChipNDale)
Copyright © 1983, 1986 by Xerox Corporation. All rights reserved.
Created by: Christian Jacobi, June 24, 1983 4:58 pm
Last edited by: Christian Jacobi, October 21, 1986 1:00:10 pm PDT
DIRECTORY
CD,
CDBasicsInline,
CDIO,
CDPrivate,
CDProperties,
CDRects,
CDOps,
LRUCache,
Rope,
SafeStorage,
TokenIO;
CDRectsImpl:
CEDAR
MONITOR
IMPORTS CD, CDBasicsInline, CDIO, CDOps, CDPrivate, CDProperties, LRUCache, Rope, SafeStorage
EXPORTS CDRects
SHARES CD =
BEGIN
dummyRectSpecific: CD.RectSpecific = SafeStorage.GetPermanentZone[].NEW[CD.RectRep ← [filler: NIL]];
lruQueue: LRUCache.Handle ← LRUCache.Create[255, CDPrivate.Hash, CDPrivate.Equal];
free: CD.Object ← NIL; --always bare rect
GiveOb:
ENTRY
PROC []
RETURNS [ob:
CD.Object] =
INLINE {
ob ← free; free ← NIL;
IF ob=NIL THEN ob ← NEW[CD.ObjectRep←[class: bareRectClass, specific: dummyRectSpecific]];
};
CreateRectProc: TYPE = PROC [size: CD.Position, l: CD.Layer] RETURNS [CD.Object] ← CreateBareRect;
createRectArray:
REF
ARRAY
CD.Layer
OF CreateRectProc =
SafeStorage.GetPermanentZone[].NEW[ARRAY CD.Layer OF CreateRectProc];
--initialized by default
CreateRect:
PUBLIC
PROC [size:
CD.Position, l:
CD.Layer]
RETURNS [ob:
CD.Object] = {
IF createRectArray[l]=CreateBareRect
THEN {
--don't cache a secod time..
ob ← CreateBareRect[size, l]
}
ELSE {
used: REF; insert: BOOL;
ob ← createRectArray[l][size, l];
[insert: insert, used: used] ← LRUCache.Include[lruQueue, ob];
IF ~insert
THEN ob ←
NARROW[used];
--otherwise do not remember object on free! we don't know its class
};
};
HangExtensionsOn:
PROC[on:
CD.ObjectClass] = {
IF on.newLayer=NIL THEN on.newLayer ← ChangeLayer
};
UseAsCreateRect:
PUBLIC
PROC [l:
CD.Layer,
createRect: PROC [size: CD.Position, l: CD.Layer] RETURNS [CD.Object],
hangExtensionsOn: CD.ObjectClass
] = {
IF createRect=NIL THEN createRect ← CreateBareRect;
createRectArray[l] ← createRect;
IF hangExtensionsOn#NIL THEN HangExtensionsOn[hangExtensionsOn];
CDProperties.PutLayerProp[onto: l, prop: $CDxRectCreation, val: $CDxUser];
};
CreateBareRect:
PUBLIC
PROC [size:
CD.Position, l:
CD.Layer]
RETURNS [ob:
CD.Object] = {
used: REF; insert: BOOL;
ob ← GiveOb[];
ob.bbox ← CDPrivate.MinBBox[size];
ob.layer ← l;
[insert: insert, used: used] ← LRUCache.Include[lruQueue, ob];
IF ~insert THEN {free ← ob; ob ← NARROW[used]};
};
bareRectClass: PUBLIC CD.ObjectClass;
oldSaveRectClass: CD.ObjectClass; --for compatibility only
Init:
PROC [] = {
bareRectClass ←
CD.RegisterObjectClass[$Rect, [
drawMe: DrawMeForRects,
quickDrawMe: DrawMeForRects,
internalRead: ReadRect,
internalWrite: WriteRect,
newLayer: ChangeLayer,
describe: Describe,
wireTyped: TRUE
]];
HangExtensionsOn[bareRectClass];
oldSaveRectClass ← CD.RegisterObjectClass[$SaveRect, [internalRead: ReadRect]];
};
Describe:
PROC[me:
CD.Object]
RETURNS [Rope.
ROPE] = {
RETURN [Rope.Concat["rect ", CDOps.LayerRope[me.layer]]]
};
DrawMeForRects:
PROC [inst:
CD.Instance, trans:
CD.Transformation, pr:
CD.DrawRef] = {
pr.drawRect[CDBasicsInline.MapRect[inst.ob.bbox, trans], inst.ob.layer, pr]
};
ChangeLayer:
CD.ChangeLayerProc = {
newOb: CD.Object ← CreateRect[CD.InterestSize[inst.ob], layer];
IF newOb#NIL THEN inst.ob ← newOb;
RETURN [newOb#NIL];
};
WriteRect:
CD.InternalWriteProc
-- PROC [ob: Object] -- = {
CDIO.WritePos[h, CD.InterestSize[ob]];
CDIO.WriteLayer[h, ob.layer];
};
ReadRect:
CD.InternalReadProc
--PROC [] RETURNS [Object]-- = {
sz: CD.Position = CDIO.ReadPos[h];
l: CD.Layer = CDIO.ReadLayer[h];
ob: CD.Object = CreateRect[sz, l];
RETURN [ob]
};
Init[];
END.