DIRECTORY
Atom,
CD,
CDPrivate,
CDApplications,
CDDirectory,
CDEvents,
CDInline,
CDOrient,
Graphics,
Process,
RefTab,
Rope USING [Cat, IsEmpty, ROPE],
SafeStorage,
TerminalIO;

CDImpl: CEDAR MONITOR 
IMPORTS Atom, CDApplications, CDDirectory, CDEvents, CDInline, CDOrient, Graphics, Process, RefTab, Rope, SafeStorage, TerminalIO 
EXPORTS CD, CDPrivate
SHARES CD, CDPrivate = 
BEGIN

Error: PUBLIC ERROR[ec: CD.ErrorCode _ programmingError, explanation: Rope.ROPE _ NIL] = CODE;
DebugCall: PUBLIC SIGNAL[what: REF] = CODE;
permanent: ZONE ~ SafeStorage.GetPermanentZone[]; 

levels: PUBLIC REF ARRAY CD.Level OF CDPrivate.LevelRef ~ 
permanent.NEW[ARRAY CD.Level OF CDPrivate.LevelRef]; 

registerTechEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$RegisterTechnology];

technologyRegistration: RefTab.Ref ~ RefTab.Create[]; -- contains technologies

TechnologyPrivate: TYPE = REF TechnologyPrivateRep;
TechnologyPrivateRep: PUBLIC TYPE = RECORD [
objectRegisterTab: RefTab.Ref, -- contains object types
levelKeyTab: RefTab.Ref -- contains Levels
];


nilTechnologyPrivate: TechnologyPrivate = NEW[TechnologyPrivateRep_[
objectRegisterTab: RefTab.Create[], --for technology dependant objects it contains NIL 
levelKeyTab: RefTab.Create[]
]];


RegisterObjectType: PUBLIC PROC [objectType: ATOM, technology: CD.Technology_NIL] 
RETURNS [REF CD.ObjectProcs] = 
BEGIN
done: BOOL;
p: REF CD.ObjectProcs ~ permanent.NEW[CD.ObjectProcs];
p.technology _ technology;
p.objectType _ objectType;
p.further _ RefTab.Create[];
p.drawMe _ DefaultDrawMe;
p.quickDrawMe _ DefaultQuickDrawMe;
p.showMeSelected _ OutlineObjectProc;
p.hitInside _ DefaultHitInside;
p.insideRect _ DefaultRectProc;
p.inDirectory _ FALSE;
p.wireTyped _ FALSE;
p.describe _ DefaultDescribe;
IF technology=NIL THEN done _ RefTab.Insert[nilTechnologyPrivate.objectRegisterTab, objectType, p]
ELSE {
techPriv: TechnologyPrivate = technology.technologyPrivate;
objectRegisterTab: RefTab.Ref = techPriv.objectRegisterTab;
globFound: BOOL;
x: REF;
[globFound, x] _ RefTab.Fetch[nilTechnologyPrivate.objectRegisterTab, objectType]; 
IF globFound AND x#NIL THEN done _ FALSE
ELSE { 
[] _ RefTab.Insert[nilTechnologyPrivate.objectRegisterTab, objectType, NIL]; 
done _ RefTab.Insert[objectRegisterTab, objectType, p]; -- technology register
}
};
IF NOT done THEN RETURN [NIL];
RETURN [p]
END;

FetchObjectProcs: PUBLIC PROC [objectType: REF, technology: CD.Technology_NIL] 
RETURNS [REF CD.ObjectProcs] =
BEGIN
x: REF;
p: REF CD.ObjectProcs_NIL;
found: BOOL_FALSE;
IF technology#NIL THEN { -- search in technology table
techPriv: TechnologyPrivate = technology.technologyPrivate;
[found, x] _ RefTab.Fetch[techPriv.objectRegisterTab, objectType];
};
IF NOT found THEN { -- search in global table
[found, x] _ RefTab.Fetch[nilTechnologyPrivate.objectRegisterTab, objectType];
};
IF found THEN TRUSTED {p _ LOOPHOLE[x]};
RETURN [p]
END; 

DefaultDrawMe: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation,
pr: CD.DrawRef] =
BEGIN
IF aptr.ob.p.quickDrawMe#DefaultQuickDrawMe THEN 
aptr.ob.p.quickDrawMe[aptr, pos, orient, pr]
ELSE pr.drawRect[CDOrient.RectAt[pos, aptr.ob.size, orient], CD.highLightShade, pr]
END; 

DefaultDrawChild: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation,
pr: CD.DrawRef] =
BEGIN
aptr.ob.p.drawMe[aptr, pos, orient, pr]
END; 

DefaultQuickDrawMe: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation,
pr: CD.DrawRef] =
BEGIN
IF aptr.ob.p.drawMe#DefaultDrawMe THEN aptr.ob.p.drawMe[aptr, pos, orient, pr]
ELSE pr.drawRect[CDOrient.RectAt[pos, aptr.ob.size, orient], CD.highLightShade, pr]
END; 

OutlineObjectProc: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation,
pr: CD.DrawRef] =
BEGIN
pr.outLineProc[CDOrient.RectAt[pos, aptr.ob.size, orient], pr]
END; 

DefaultHitInside: PROC [aptr: CD.ApplicationPtr, hitRect: CD.DesignRect] RETURNS [BOOL] =
BEGIN
RETURN [CDInline.Intersect[CDApplications.ARectO[aptr], hitRect]]
END; 

DefaultRectProc: PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] =
{RETURN [CDInline.RectAt[[0, 0], ob.size]]};

DefaultDescribe: PROC [me: CD.ObPtr] RETURNS [Rope.ROPE] =
BEGIN
IF me.p.inDirectory THEN {
n: Rope.ROPE = CDDirectory.Name[me];
IF ~Rope.IsEmpty[n] THEN RETURN [Rope.Cat[Atom.GetPName[me.p.objectType], " ", n]] 
};
RETURN [Atom.GetPName[me.p.objectType]]
END;

DefaultDrawComment: PROC [r: CD.DesignRect, comment: Rope.ROPE, pr: CD.DrawRef] =
BEGIN
END;

lastLevel: CD.Level _ 3;

InitiateLevel: PROC [lev: CD.Level, technology: CD.Technology_NIL, uniqueKey: ATOM] =
BEGIN
techPriv: TechnologyPrivate;
levels[lev].technology _ technology;
levels[lev].uniqueKey _ uniqueKey;
IF technology=NIL THEN techPriv _ nilTechnologyPrivate
ELSE {
techPriv _ technology.technologyPrivate;
technology.usedLevels _ CONS[lev, technology.usedLevels]
};
[] _ RefTab.Insert[techPriv.levelKeyTab, uniqueKey, levels[lev]];
END;

NewLevel: PUBLIC ENTRY PROC [technology: CD.Technology_NIL, uniqueKey: ATOM] RETURNS [CD.Level] =
BEGIN
ENABLE UNWIND => NULL;
IF uniqueKey=NIL OR uniqueKey=$NIL THEN 
RETURN WITH ERROR Error[callingError, "bad uniqueKey"]; -- avoid problems with NIL as ATOM; any IO routine might use $NIL instead
IF lastLevel>=CD.levelNumber-1 THEN 
RETURN WITH ERROR Error[noResource, "too many levels have been requested; (probaly too many different technologies are used)"];
lastLevel _ lastLevel+1;
InitiateLevel[lastLevel, technology, uniqueKey];
RETURN [lastLevel]
END;


DrawToContext: PUBLIC PROC[pr: CD.DrawRef, proc: CD.ContextDraw, level: CD.Level] =
BEGIN
IF pr.deviceContext#NIL AND pr.contextFilter#NIL AND pr.contextFilter[level].doit THEN { 
mark: Graphics.Mark ~ pr.deviceContext.Save[];
[] _ pr.deviceContext.SetPaintMode[pr.contextFilter[level].paintMode];
pr.deviceContext.SetColor[pr.contextFilter[level].color];
pr.deviceContext.ClipBox[[xmin: pr.worldClip.x1, ymin: pr.worldClip.y1, xmax: pr.worldClip.x2, ymax: pr.worldClip.y2]];
proc[pr.deviceContext ! UNWIND => {pr.deviceContext.Restore[mark]; GOTO return}];
pr.deviceContext.Restore[mark]
}
EXITS
return => NULL;
END;

FetchLevel: PUBLIC PROC [t: CD.Technology, uniqueKey: ATOM] RETURNS [CD.Level] =
BEGIN
found: BOOL_FALSE;
l: CD.Level _ CD.combined;
x: REF;
IF t#NIL THEN {
techPriv: TechnologyPrivate = t.technologyPrivate;
[found: found, val: x] _ RefTab.Fetch[techPriv.levelKeyTab, uniqueKey];
};
IF ~found THEN {
[found: found, val: x] _ RefTab.Fetch[nilTechnologyPrivate.levelKeyTab, uniqueKey];
};
IF found THEN l _ NARROW[x, CDPrivate.LevelRef].number;
RETURN [l]
END;

LevelTechnology: PUBLIC PROC [l: CD.Level] RETURNS [CD.Technology] =
BEGIN
RETURN [levels[l].technology];
END;

LevelKey: PUBLIC PROC [l: CD.Level] RETURNS [ATOM] =
BEGIN
RETURN [levels[l].uniqueKey];
END;

NewNullDeviceDrawRef: PUBLIC PROC [design: CD.Design, deviceContext: Graphics.Context] RETURNS [CD.DrawRef] =
BEGIN
p: CD.DrawRef ~ NEW[CD.DrawInformation];
p.worldClip _ CDInline.universe;
p.minimalSize _ 0;
p.scaleHint _ 0.0;
p.drawRect _ DrawRectWithGraphics;
p.drawComment _ DefaultDrawComment;
p.drawChild _ DefaultDrawChild;
p.outLineProc _ EmptyOutLineProc;
p.saveRect _ SaveByDraw;
p.stopFlag _ NEW[BOOLEAN _ FALSE]; 
p.deviceContext _ deviceContext;
p.devicePrivate _ NIL; 
p.setGround _ DefaultSetGround;
p.design _ design;
RETURN [p]
END;

EmptyOutLineProc: PROC[r: CD.Rect, pr: CD.DrawRef] = {};
SaveByDraw: PROC [r: CD.Rect, l: CD.Level, pr: CD.DrawRef] = {pr.drawRect[r, l, pr]};
DefaultSetGround: PROC [pr: CD.DrawRef, pushedOut: BOOL] = {};

DrawRectWithGraphics: PROC [r: CD.Rect, l: CD.Level, pr: CD.DrawRef] = 
BEGIN
DrawRectInContext: PROC [context: Graphics.Context] = {
context.DrawBox[Graphics.Box[xmin: r.x1, xmax: r.x2, ymin: r.y1, ymax: r.y2]];
};
DrawToContext[pr, DrawRectInContext, l]
END;

RegisterTechnology: PUBLIC PROC [key: ATOM, name: Rope.ROPE] RETURNS [CD.Technology] =
BEGIN
t: CD.Technology ~ permanent.NEW[CD.TechnologyRec];
IF ~RefTab.Insert[technologyRegistration, key, t] THEN RETURN[NIL];
t.key _ key;
t.name _ name;
t.usedLevels _ NIL;
t.technologyPrivate _ permanent.NEW[TechnologyPrivateRep _
[RefTab.Create[], RefTab.Create[]]];
[] _ CDEvents.ProcessEvent[ev: registerTechEvent, design: NIL, x: t];
RETURN[t]
END;

FetchTechnology: PUBLIC PROC [key: ATOM] RETURNS [CD.Technology] =
BEGIN
x: REF;
found: BOOL;
tech: CD.Technology _ NIL;
[found: found, val: x] _ RefTab.Fetch[technologyRegistration, key];
IF found THEN tech _ NARROW[x];  
RETURN[tech]
END;

BreakProc: PROC [msg: Rope.ROPE, what: REF] = {SIGNAL DebugCall[what]};

Debug: PUBLIC PROC [msg: Rope.ROPE_NIL, what: REF_NIL, mayProceed: BOOL_TRUE] = 
BEGIN 
n: INT_0;
IF msg=NIL THEN msg_"Unknown error";
IF mayProceed THEN {
DO
TerminalIO.WriteRope[msg];
TerminalIO.WriteRope["\nif you don't know what to do,\n"]; 
TerminalIO.WriteRope["   then mouse-click on proceed,\n"];
TerminalIO.WriteRope["   save your design onto a new file,\n"];
TerminalIO.WriteRope["   and restart chipndale\n"];
n _ TerminalIO.RequestSelection[
label: "Debug options",
choice: LIST["proceed", "signal and proceed", "signal in main process"]];
SELECT n FROM
1 => {TerminalIO.WriteRope["proceed\n"]; EXIT};
2 => {TRUSTED {Process.Detach[FORK BreakProc[msg, what]]}; EXIT};
3 => {BreakProc[msg, what]; EXIT};
ENDCASE => TerminalIO.WriteRope["skipped\n"];
ENDLOOP;
}
ELSE {
TerminalIO.WriteRope[msg];
ERROR DebugCall[what]
}; 
END;
IF registerTechEvent=NIL THEN ERROR;  
FOR l: CD.Level IN CD.Level DO
levels[l] _ permanent.NEW[CDPrivate.LevelRec];
levels[l].number _ l;
levels[l].globalUniqueKey _ levels[l];
ENDLOOP;
InitiateLevel[CD.combined, NIL, $combined];
InitiateLevel[CD.highLightShade, NIL, $highLightShade];
InitiateLevel[CD.highLightError, NIL, $highLightError];
InitiateLevel[CD.backGround, NIL, $backGround];
END. 


TCDImpl.mesa   (part of Chipndale)
Copyright c 1983, 1984 by Xerox Corporation.  All rights reserved.
Christian Jacobi   June 24, 1983 5:07 pm 
last edited Christian Jacobi   October 24, 1984 6:26:52 pm PDT
--assume everithing gets correct even if all references are lost, 
--don't care about memory area, hint only
--also initializes procedures with default values 
--still check if it might be global
--global register it used per technology
--may find it but have NIL value: then is technologydependant
--sorry XXXX IF found THEN p _ NARROW[x];
TooSimpleDrawToContext: PUBLIC PROC[pr: CD.DrawRef, proc: CD.ContextDraw] =
--calls proc which may use context;
--on recursive calls the context may or may not include previous transformations
BEGIN
IF pr.deviceContext=NIL THEN RETURN;
proc[Graphics.CopyContext[pr.deviceContext]]
END;
--calls proc which may use context; mode and color are set to level's need
--call is suppressed if level does not need drawing; this is default.
--on recursive calls, the context may or may not include previous transformations
--Returns NIL if key is already in use
--This must be the only way to create data of type TechnologyRec
--not ENTRY since RefTab.Insert does necessary monitoring and CDEvents.ProcessEvent
--is dangerous
--Returns NIL if key is not registered
-- -- -- -- -- -- -- -- --

-- -- -- -- -- -- -- -- --
�Ê
£˜š
œ!™!Jšœ
Ïm
œ7™BJš
œ)™)Jš
œ>™>—J˜š
Ïk	˜	Jš
œ˜Jšžœ
˜Jš
œ
˜
J˜J˜J˜	J˜	J˜	J˜	J˜J˜Jšœžœžœ˜ J˜J˜—J˜šÏbœžœ
žœ
˜Jšžœ{˜‚
Jšžœ
žœ˜Jšžœ
žœ˜—Jš
ž˜J˜Jš
œžœ
žœžœ1žœžœžœ
˜^Jš	œžœ
žœžœžœ
˜+šœžœ#˜2Jš
œB™BJš
œ)™)—J˜šœžœ
žœ
žœ
žœžœ˜:Jš	œ
žœ
žœ
žœžœ˜5—J˜J˜`J˜Jšœ6Ïc˜NJ˜Jšœžœžœ˜3šœžœ
žœžœ˜,Jšœ ˜7Jšœ ˜*J˜J˜J˜—šœ*žœ˜DJšœ$ 3˜WJš
œ˜Jš
œ˜—J˜J˜šÏnœžœ
žœžœžœžœ˜RJšžœžœ˜Jš
œ2™2Jš
ž˜Jšœžœ
˜Jšœžœžœ
žœ˜6J˜J˜Jš
œ˜J˜J˜#J˜%J˜J˜Jšœžœ
˜Jšœžœ
˜Jš
œ˜Jšžœžœ
žœL˜bš
ž˜J˜;J˜;Jšœžœ
˜Jšœžœ
˜š
œS˜SJš
œ#™#—Jš	žœžœžœ
žœž˜(šžœ
˜šœGžœ˜MJš
œ(™(—Jšœ8 ˜NJš
ž
˜
—Jšž
œ
˜—Jš
žœ
žœžœ
žœžœ˜Jšžœ˜
Jšžœ
˜J˜—š¡œžœ
žœžœžœžœ˜OJšžœžœ˜Jš
ž˜Jšœžœ
˜Jšœžœ
žœ
˜Jšœžœ
žœ
˜šžœžœ
žœ
 ˜6J˜;J˜BJš
œ˜—šžœ
žœžœ
 ˜-Jš
œN˜NJš
œ=™=Jš
œ˜—Jš
œ)™)Jšžœžœ
žœžœ˜(Jšžœ˜
Jšžœ˜J˜—š
¡
œžœžœžœžœ
˜]Jšœžœ˜Jš
ž˜šžœ*žœ
˜1Jš
œ,˜,—Jšžœ9žœ˜SJšžœ˜J˜—š
¡œžœžœžœžœ
˜`Jšœžœ˜Jš
ž˜Jš
œ'˜'Jšžœ˜J˜—š
¡œžœžœžœžœ
˜bJšœžœ˜Jš
ž˜Jšžœ žœ(˜NJšžœ9žœ˜SJšžœ˜J˜—š¡œžœ žœžœ
˜aJšœžœ˜Jš
ž˜Jš
œ>˜>Jšžœ˜J˜—š¡œžœžœžœ
žœžœ˜YJš
ž˜Jšžœ;˜AJšžœ˜J˜—š
¡œžœžœžœžœ˜>Jšœ
žœ%˜,J˜—š
¡œžœžœžœžœ˜:Jš
ž˜šžœžœ˜Jšœžœ˜$Jšžœžœ
žœ4˜SJš
œ˜—Jšžœ!˜'Jšžœ
˜—J˜š
¡œžœžœžœžœ˜QJš
ž˜Jšžœ
˜—J˜Jšœžœ˜J˜š¡
œžœžœžœžœ
žœ˜UJš
ž˜Jš
œ˜Jš
œ$˜$Jš
œ"˜"Jšžœžœ
žœ ˜6šžœ˜J˜(Jšœžœ˜8J˜—Jš
œA˜AJšžœ
˜—J˜š¡œžœ
žœ
žœžœžœ
žœžœžœ	˜aJš
ž˜Jšžœ
žœžœ
˜šžœžœ
žœžœ
˜(Jšžœ
žœ
žœ' I˜�
—šžœžœžœ
˜$Jšžœ
žœ
žœn˜—J˜Jš
œ0˜0Jšžœ˜Jšžœ
˜J˜—š
¡œžœ
žœžœžœ™KJš
œ#™#Jš
œP™PJš
ž™Jšžœžœ
žœ
žœ
™$Jš
œ,™,Jšžœ
™—J˜š¡
œžœ
žœžœžœžœ	˜SJš
œJ™JJš
œE™EJš
œQ™QJš
ž˜šžœžœ
žœžœ
žœžœ˜YJš
œ.˜.Jš
œF˜FJš
œ9˜9Jš
œw˜wJšœžœ%žœ
˜QJš
œ˜J˜
—š
ž˜Jšœ
žœ
˜—Jšžœ
˜—J˜š¡
œžœ
žœžœžœžœžœ	˜PJš
ž˜Jšœž
œ
˜Jšœžœ	žœ
˜Jšœžœ
˜šžœžœ
žœ˜J˜2J˜GJš
œ˜—šžœžœ˜Jš
œS˜SJ˜—Jšžœžœžœ˜7Jšžœ˜
Jšžœ
˜J˜—š¡œžœ
žœžœ˜DJš
ž˜Jšžœ˜Jšžœ
˜—J˜š¡œžœ
žœžœžœžœ˜4Jš
ž˜Jšžœ˜Jšžœ
˜—J˜š¡œžœ
žœ
žœ*žœžœ˜mJš
ž˜Jšœžœžœ
žœ˜(J˜ J˜Jš
œ˜Jš
œ"˜"Jš
œ#˜#Jš
œ˜J˜!J˜Jšœ
žœ
žœžœ˜#Jš
œ ˜ Jšœžœ˜Jš
œ˜J˜Jšžœ˜
šžœ
˜J˜——Jš¡œžœžœžœ˜8Jš
¡
œžœžœ
žœžœ$˜UJš¡œžœžœžœ˜>J˜š
¡œžœžœ
žœžœ˜GJš
ž˜š¡œžœ ˜7Jš
œN˜NJš
œ˜—Jš
œ'˜'Jšžœ
˜—J˜š¡œžœ
žœžœ
žœžœžœ˜VJš
œ&™&š
œ@™@Jš
œS™SJš
œ™—Jš
ž˜Jšœžœžœ
žœ˜3Jšžœ0žœ
žœ
žœ˜CJ˜J˜Jšœžœ
˜šœ žœ˜:Jš
œ$˜$—Jšœ:žœ˜EJšžœ˜	Jšžœ
˜J˜—š¡œžœ
žœžœžœžœ˜BJš
œ&™&Jš
ž˜Jšœžœ
˜Jšœžœ
˜Jšœžœ
žœ
˜J˜CJšžœžœžœ˜!Jšžœ˜Jšžœ
˜—J˜Jš
œ™Jš
¡	œžœžœžœžœ˜GJ˜š¡œžœ
žœžœ
žœžœ
žœžœ
žœ˜PJšžœ
˜Jšœžœ˜	Jšžœžœ
žœ˜$šžœžœ˜š
ž˜Jš
œ˜Jš
œ;˜;Jš
œ:˜:Jš
œ?˜?Jš
œ3˜3š
œ ˜ J˜Jšœžœ=˜I—šžœž˜
Jšœ)žœ˜/Jšœžœžœžœ˜AJšœžœ˜"Jšžœ&˜-—Jšžœ
˜—J˜
—šžœ˜Jš
œ˜Jšžœ˜Jš
œ˜—Jšžœ
˜—J™Jš
œ™Jšžœžœ
žœ
žœ˜&š	žœžœžœ
žœž˜Jšœžœ˜.Jš
œ˜Jš
œ&˜&Jšžœ
˜—Jšœžœžœ
˜+Jšœžœžœ˜7Jšœžœžœ˜7Jšœžœ
žœ˜/Jšžœ˜J˜J˜—…—&X9O