CDRectsImpl.mesa (part of ChipNDale)
Copyright © 1983, 1987 by Xerox Corporation. All rights reserved.
Created by: Christian Jacobi, June 24, 1983 4:58 pm
Last edited by: Christian Jacobi, February 23, 1987 6:59:26 pm PST
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
};
ob.immutable ← TRUE;
};
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: CD.DescribeProc = {
RETURN [Rope.Concat["rect ", CDOps.LayerRope[ob.layer]]]
};
DrawMeForRects: CD.DrawProc = {
pr.drawRect[pr, CDBasicsInline.MapRect[ob.bbox, trans], ob.layer]
};
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.