CDImpl.mesa (part of Chipndale)
by Christian Jacobi June 24, 1983 5:07 pm
last edited Christian Jacobi February 1, 1984 11:33 am
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[];
--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
globObjectTypeTable: RefTab.Ref ~ RefTab.Create[];
-- contains object types
--for global objects it contains the entry;
--for technology dependant objects it contains NIL
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] =
--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 ← 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];
--still check if it might be global
IF globFound AND x#NIL THEN done ← FALSE
ELSE {
[] ← RefTab.Insert[globObjectTypeTable, 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 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];
--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;
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;
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]
}
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]
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.