CDRectsImpl.mesa (part of Chipndale)
Copyright © 1983 by Xerox Corporation. All rights reserved.
Christian Jacobi June 24, 1983 4:58 pm
last edited Christian Jacobi November 5, 1984 10:25:28 am PST
DIRECTORY
Atom,
CD,
CDBasics,
CDCallSpecific,
CDIO,
CDLRUCache,
CDOrient,
CDProperties,
CDRects,
CDDefaults,
Rope,
SafeStorage,
TokenIO;
CDRectsImpl:
CEDAR
MONITOR
IMPORTS Atom, CD, CDCallSpecific, CDBasics, CDIO, CDLRUCache, CDOrient, CDProperties, CDDefaults, Rope, SafeStorage, TokenIO
EXPORTS CDRects
SHARES CD =
BEGIN
permanent: ZONE = SafeStorage.GetPermanentZone[];
lambda: CD.DesignNumber = CD.lambda;
dummyRectPtr: CD.RectPtr = permanent.NEW[CD.RectRecord ← [filler: NIL]];
b1Cache: CDLRUCache.LRUCache = CDLRUCache.Create[size: 41, newProc: New];
b2Cache: CDLRUCache.LRUCache = CDLRUCache.Create[size: 41, newProc: New];
b3Cache: CDLRUCache.LRUCache = CDLRUCache.Create[size: 41, newProc: New];
-- any number of caches; simply for speed up; Yes I know, one big cache could be better
-- but this is faster, and the distribution is crazy, such that not all caches have similar
-- hit rates
sCache: CDLRUCache.LRUCache = CDLRUCache.Create[size: 31, newProc: New];
New:
PROC []
RETURNS [
CD.ObPtr] = {
ob: CD.ObPtr ← NEW[CD.ObjectDefinition];
ob.specificRef ← dummyRectPtr;
RETURN [ob]
};
CreateRectProc:
TYPE =
PROC [size:
CD.DesignPosition, l:
CD.Level]
RETURNS [
CD.ObPtr]
← CreateBareRect;
createRectArray:
REF
ARRAY
CD.Level
OF CreateRectProc =
permanent.NEW[ARRAY CD.Level OF CreateRectProc]; -- initialized by default
CreateRect:
PUBLIC
PROC [size:
CD.DesignPosition, l:
CD.Level]
RETURNS [
CD.ObPtr] =
BEGIN
RETURN [createRectArray[l][size, l]]
END;
HangExtensionsOn:
PROC[on:
REF CD.ObjectProcs] =
BEGIN
CDCallSpecific.Register[$Lengthen, on, Lengthen];
CDCallSpecific.Register[$Default, on, Defaulten];
END;
UseAsCreateRect:
PUBLIC
PROC [
l: CD.Level,
createRect: PROC [size: CD.DesignPosition, l: CD.Level] RETURNS [CD.ObPtr],
hangExtensionsOn: REF CD.ObjectProcs
] =
BEGIN
IF createRect=NIL THEN createRect ← CreateBareRect;
createRectArray[l] ← createRect;
IF hangExtensionsOn#NIL THEN HangExtensionsOn[hangExtensionsOn];
CDProperties.PutPropOnLevel[onto: l, prop: $CDxRectCreation, val: $CDxUser];
END;
CreateBareRect:
PUBLIC
PROC [size:
CD.DesignPosition, l:
CD.Level]
RETURNS [
CD.ObPtr] =
BEGIN
usedCache: CDLRUCache.LRUCache =
IF size.y<37 THEN b1Cache ELSE IF size.x<16 THEN b2Cache ELSE b3Cache;
rp: CD.ObPtr ~ usedCache.UnusedOrNew[];
rp.p ← pForRects;
rp.size ← CDBasics.MaxPoint[size, [1, 1]];
rp.level ← l;
RETURN [usedCache.ReplaceByAequivalent[rp]]
END;
CreateSaveRect:
PUBLIC PROC [size:
CD.DesignPosition, l:
CD.Level]
RETURNS [
CD.ObPtr] =
BEGIN
rp: CD.ObPtr ~ sCache.UnusedOrNew[];
rp.p ← pForSaveRects;
rp.size ← CDBasics.MaxPoint[size, [1, 1]];
rp.level ← l;
RETURN [sCache.ReplaceByAequivalent[rp]]
END;
pForRects: REF CD.ObjectProcs;
pForSaveRects: REF CD.ObjectProcs;
--???setWidth: REF CDCallSpecific.CallProc←permanent.NEW[CDCallSpecific.CallProc←SetWidth];
--???setLength: REF CDCallSpecific.CallProc←permanent.NEW[CDCallSpecific.CallProc←SetLength];
Init:
PROC [] =
BEGIN
pForRects ← CD.RegisterObjectType[$Rect];
pForRects.drawMe ← pForRects.quickDrawMe ← DrawMeForRects;
pForRects.internalRead ← ReadRect;
pForRects.internalWrite ← WriteRect;
pForRects.describe ← Describe;
pForRects.wireTyped ← TRUE;
HangExtensionsOn[pForRects];
pForSaveRects ← CD.RegisterObjectType[$SaveRect];
pForSaveRects.drawMe ← pForSaveRects.quickDrawMe ← DrawMeForSaveRects;
pForSaveRects.internalRead ← ReadRect;
pForSaveRects.internalWrite ← WriteRect;
pForSaveRects.describe ← Describe;
pForSaveRects.wireTyped ← TRUE;
HangExtensionsOn[pForSaveRects];
END;
Describe:
PROC[me: CD.ObPtr]
RETURNS [Rope.
ROPE] =
BEGIN
RETURN [Rope.Concat["rect ", Atom.GetPName[CD.LevelKey[me.level]]]]
END;
DrawMeForRects:
PROC [aptr: CD.ApplicationPtr, pos:
CD.DesignPosition, orient:
CD.Orientation,
pr: CD.DrawRef] =
BEGIN
pr.drawRect[CDOrient.RectAt[pos, aptr.ob.size, orient], aptr.ob.level, pr]
END;
DrawMeForSaveRects:
PROC [aptr: CD.ApplicationPtr, pos:
CD.DesignPosition, orient:
CD.Orientation,
pr: CD.DrawRef] =
BEGIN
pr.saveRect[CDOrient.RectAt[pos, aptr.ob.size, orient], aptr.ob.level, pr]
END;
Lengthen: CDCallSpecific.CallProc =
BEGIN
sz: CD.DesignPosition ← CDBasics.SizeOfRect[aptr.ob.p.insideRect[aptr.ob]];
amount: CD.DesignPosition;
IF x=NIL THEN amount ← [0, lambda]
ELSE IF ISTYPE [x, REF CD.DesignPosition] THEN amount ← NARROW[x, REF CD.DesignPosition]^
ELSE {done←FALSE; RETURN};
sz ← CDBasics.AddPoints[sz, amount];
IF sz.x<=0 OR sz.y<=0 THEN {done ← FALSE; RETURN};
aptr.ob ← CreateRect[sz, aptr.ob.level];
repaintMe ← TRUE;
END;
Defaulten: CDCallSpecific.CallProc =
BEGIN
sz: CD.DesignPosition ← CDBasics.SizeOfRect[aptr.ob.p.insideRect[aptr.ob]];
w: CD.DesignNumber ← CDDefaults.LevelWidth[design, aptr.ob.level];
IF w<=0 THEN {done ← FALSE; RETURN};
sz.x ← w;
aptr.ob ← CreateRect[sz, aptr.ob.level];
repaintMe ←TRUE;
END;
SetLength: CDCallSpecific.CallProc =
BEGIN
newLength: CD.DesignNumber ← NARROW[x, REF CD.DesignNumber]^;
sz: CD.DesignPosition ← aptr.ob.size;
IF sz.y<sz.x THEN sz.x ← newLength
ELSE sz.y ← newLength;
aptr.ob ← CreateRect[sz, aptr.ob.level];
repaintMe ← TRUE;
END;
SetWidth: CDCallSpecific.CallProc =
BEGIN
newWidth: CD.DesignNumber ← NARROW[x, REF CD.DesignNumber]^;
sz: CD.DesignPosition ← aptr.ob.size;
IF sz.y>sz.x THEN sz.x ← newWidth
ELSE sz.y ← newWidth;
aptr.ob ← CreateRect[sz, aptr.ob.level];
repaintMe ← TRUE;
END;
WriteRect:
CD.InternalWriteProc
-- PROC [me: ObPtr] -- =
BEGIN
sz: CD.DesignPosition = CDBasics.SizeOfRect[me.p.insideRect[me]];
TokenIO.WriteInt[sz.x];
TokenIO.WriteInt[sz.y];
CDIO.WriteLevel[me.level];
END;
ReadRect:
CD.InternalReadProc
--PROC [] RETURNS [ObPtr]-- =
BEGIN
x: INT = TokenIO.ReadInt[];
y: INT = TokenIO.ReadInt[];
l: CD.Level = CDIO.ReadLevel[];
ob: CD.ObPtr = CreateRect[CD.DesignPosition[x, y], l];
RETURN [ob]
END;
Init[];
END.