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

CDImpl: CEDAR MONITOR 
IMPORTS Atom, CDApplications, CDEvents, CDInline, CDOrient, Graphics, Process, RefTab, 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

globObjectTypeTable: RefTab.Ref ~ RefTab.Create[];  -- contains object types

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


TechnologyPrivate: TYPE = REF TechnologyPrivateRep;

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 _ DrawMe;
p.showMeSelected _ OutlineObjectProc;
p.hitInside _ DefaultHitInside;
p.insideRect _ DefaultRectProc;
p.hasChildren _ FALSE;
p.wireTyped _ FALSE;
p.match _ NIL;
p.describe _ DefaultDescribe;
IF technology=NIL THEN done _ RefTab.Insert[globObjectTypeTable, objectType, p]
ELSE {
techPriv: TechnologyPrivate = technology.technologyPrivate;
objectRegisterTab: RefTab.Ref = techPriv.objectRegisterTab;
globFound: BOOL;
x: REF;
[globFound, x] _ RefTab.Fetch[globObjectTypeTable, objectType]; 
IF globFound AND x#NIL THEN done _ FALSE
ELSE { 
[] _ RefTab.Insert[globObjectTypeTable, 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 READONLY 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[globObjectTypeTable, objectType];
};
IF found THEN TRUSTED {p _ LOOPHOLE[x]};
RETURN [p]
END; 

DrawMe: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation,
pr: CD.DrawRef] =
BEGIN
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] =
{RETURN [CDInline.Intersect[CDApplications.ApplicationRect[aptr], hitRect]]}; 

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

DefaultDescribe: PROC [me: CD.ObPtr] RETURNS [Rope.ROPE] =
{RETURN [Atom.GetPName[me.p.objectType]]};


lastLevel: CD.Level _ 3;

InitiateLevel: PROC [lev: CD.Level, technology: CD.Technology_NIL, uniqueKey: ATOM] =
BEGIN
levels[lev] _ permanent.NEW[CDPrivate.LevelRec];
levels[lev].technology _ technology;
levels[lev].uniqueKey _ uniqueKey;
IF technology#NIL THEN {
techPriv: TechnologyPrivate ~ technology.technologyPrivate;
levRef: REF CD.Level ~ permanent.NEW[CD.Level_lev];
[] _ RefTab.Insert[techPriv.levelKeyTab, uniqueKey, levRef];
technology.usedLevels _ CONS[lev, technology.usedLevels]
};
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 ~ Graphics.Save[pr.deviceContext];
[] _ Graphics.SetPaintMode[pr.deviceContext, pr.contextFilter[level].paintMode];
Graphics.SetColor[pr.deviceContext, pr.contextFilter[level].color];
proc[pr.deviceContext ! UNWIND => {Graphics.Restore[pr.deviceContext, mark]; GOTO return}];
Graphics.Restore[pr.deviceContext, mark]
}
EXITS
return => NULL;
END;

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

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

LevelKey: PUBLIC PROC [l: CD.Level] RETURNS [ATOM] =
BEGIN
IF levels[l]=NIL THEN RETURN [$NIL];
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.outLineProc _ EmptyOutLineProc;
p.saveRect _ SaveByDraw;
p.stopFlag _ NEW[BOOLEAN _ FALSE]; 
p.deviceContext _ deviceContext;
p.devicePrivate _ NIL; 
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]};

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;  
InitiateLevel[CD.combined, NIL, $combined];
InitiateLevel[CD.highLightShade, NIL, $highLightShade];
InitiateLevel[CD.highLightError, NIL, $highLightError];
END. 


nCDImpl.mesa   (part of Chipndale)
by Christian Jacobi   June 24, 1983 5:07 pm 
last edited Christian Jacobi   February 1, 1984 11:33 am
--assume everithing gets correct even if all references are lost, 
--don't care about memory area, hint only
--for global objects it contains the entry; 
--for technology dependant objects it contains NIL
--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š
œ!™!Jš
œ,™,Jš
œ8™8J˜š
Ïk	˜	Jš
œ˜Jš�œ
˜Jš
œ
˜
J˜J˜	J˜	J˜	J˜	J˜J˜Jšœ�œ�œ˜J˜J˜—J˜šÏbœ�œ
�œ
˜Jš�œh˜oJš�œ
�œ˜Jš�œ
�œ˜—Jš
�˜J˜Jš
œ�œ
�œ�œ1�œ�œ�œ
˜^Jš	œ�œ
�œ�œ�œ
˜+šœ�œ#˜2Jš
œB™BJš
œ)™)—J˜šœ�œ
�œ
�œ
�œ�œ˜:Jš	œ
�œ
�œ
�œ�œ˜5—J˜J˜`J˜Jšœ6Ïc˜NJ˜šœ4Ÿ˜LJš
œ,™,Jš
œ2™2J˜—šœ�œ
�œ�œ˜,JšœŸ˜7JšœŸ˜*J˜J˜J˜—Jšœ�œ�œ˜3J˜šÏnœ�œ
�œ�œ�œ�œ˜RJš�œ�œ˜Jš
œ2™2Jš
�˜Jšœ�œ
˜Jšœ�œ�œ
�œ˜6J˜J˜Jš
œ˜J˜J˜%J˜J˜Jšœ�œ
˜Jšœ�œ
˜Jšœ
�
œ�˜Jš
œ˜Jš�œ�œ
�œ9˜Oš
�˜J˜;J˜;Jšœ�œ
˜Jšœ�œ
˜˜@Jš
œ#™#—Jš	�œ�œ�œ
�œ�˜(š�œ
˜šœ4�œ˜:Jš
œ(™(—Jšœ8Ÿ˜NJš
�
˜
—Jš�
œ
˜—Jš
�œ
�œ�œ
�œ�œ˜Jš�œ˜
Jš�œ
˜J˜—š œ�œ
�œ�œ�œ�œ˜OJš�œ�œ˜'Jš
�˜Jšœ�œ
˜Jšœ�œ
�œ
˜Jšœ�œ
�œ
˜š�œ�œ
�œ
Ÿ˜6J˜;J˜BJš
œ˜—š�œ
�œ�œ
Ÿ˜-J˜;Jš
œ=™=Jš
œ˜—Jš
œ)™)Jš�œ�œ
�œ�œ˜(Jš�œ˜
Jš�œ˜J˜—š
 œ�œ�œ�œ�œ
˜VJšœ�œ˜Jš
�˜Jšœ8�œ˜NJš�œ˜J˜—š œ�œ �œ�œ
˜aJšœ�œ˜Jš
�˜Jš
œ>˜>Jš�œ˜J˜—š œ�œ�œ�œ
�œ�œ˜YJšœ
�œG˜NJ˜—š
 œ�œ�œ�œ�œ˜>Jšœ
�œ%˜,J˜—š
 œ�œ�œ�œ�œ˜:Jšœ
�œ#˜*—J˜J˜Jšœ�œ˜J˜š 
œ�œ�œ�œ�œ
�œ˜UJš
�˜Jšœ�œ˜0Jš
œ$˜$Jš
œ"˜"š�œ�œ
�œ˜J˜;Jš	œ�œ
�œ�œ
�œ˜3J˜<Jšœ�œ˜8Jš
œ˜—Jš�œ
˜—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š
œ6˜6Jš
œP˜PJš
œC˜CJšœ�œ/�œ
˜[Jš
œ(˜(J˜
—š
�˜Jšœ
�œ
˜—Jš�œ
˜—J˜š 
œ�œ
�œ�œ�œ�œ�œ	˜PJš
�˜Jšœ�œ	�œ
˜š�œ�œ
�œ˜J˜2Jšœ�œ
˜Jšœ�œ
˜J˜GJš
�œ�œ�œ�œ
�œ	˜+Jš
œ˜—Jš�œ˜
Jš�œ
˜J˜—š œ�œ
�œ�œ˜DJš
�˜Jš
�œ�œ
�œ
�œ�œ˜#Jš�œ˜Jš�œ
˜—J˜š œ�œ
�œ�œ�œ�œ˜4Jš
�˜Jš�œ�œ
�œ
�œ˜$Jš�œ˜Jš�œ
˜—J˜š œ�œ
�œ
�œ*�œ�œ˜mJš
�˜Jšœ�œ�œ
�œ˜(J˜ J˜Jš
œ˜Jš
œ"˜"J˜!J˜Jšœ
�œ
�œ�œ˜#Jš
œ ˜ Jšœ�œ˜J˜Jš�œ˜
š�œ
˜J˜——Jš œ�œ�œ�œ˜8Jš
 
œ�œ�œ
�œ�œ$˜UJ˜š
 œ�œ�œ
�œ�œ˜GJš
�˜š œ�œ ˜7Jš
œN˜NJš
œ˜—Jš
œ'˜'Jš�œ
˜—J˜š œ�œ
�œ�œ
�œ�œ�œ˜VJš
œ&™&š
œ@™@Jš
œS™SJš
œ™—Jš
�˜Jšœ�œ�œ
�œ˜3Jš�œ0�œ
�œ
�œ˜CJ˜
J˜Jšœ
�œ
˜šœ �œ˜9Jš
œ$˜$—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šœ�œ�œ˜7Jšœ�œ�œ˜7Jš�œ˜J˜J˜—…— n1ü