CDImpl.mesa (part of Chipndale)
Copyright © 1983 by Xerox Corporation. All rights reserved.
Christian Jacobi June 24, 1983 5:07 pm
last edited Christian Jacobi July 20, 1984 11:39:23 am PDT
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[];
--assume everithing gets correct even if all references are lost,
--don't care about memory area, hint only
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] =
--also initializes procedures with default values
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.hasChildren ← FALSE;
p.wireTyped ← FALSE;
p.match ← NIL;
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];
--still check if it might be global
IF globFound AND x#NIL THEN done ← FALSE
ELSE {
[] ← RefTab.Insert[nilTechnologyPrivate.objectRegisterTab, objectType, NIL];
--global register it used per technology
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];
--may find it but have NIL value: then is technologydependant
};
--sorry XXXX IF found THEN p ← NARROW[x];
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.hasChildren 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;
lastLevel: CD.Level ← 3;
InitiateLevel: PROC [lev: CD.Level, technology: CD.Technology←NIL, uniqueKey: ATOM] =
BEGIN
levRef: REF CD.Level ~ permanent.NEW[CD.Level←lev];
techPriv: TechnologyPrivate;
levels[lev] ← permanent.NEW[CDPrivate.LevelRec];
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, levRef];
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;
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;
DrawToContext: PUBLIC PROC[pr: CD.DrawRef, proc: CD.ContextDraw, level: CD.Level] =
--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
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
found: BOOL�LSE;
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, 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.drawChild ← DefaultDrawChild;
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] =
--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
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] =
--Returns NIL if key is not registered
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𡤀
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.