CDImpl.mesa (part of ChipNDale)
Copyright © 1983, 1985 by Xerox Corporation. All rights reserved.
Christian Jacobi, June 24, 1983 5:07 pm
last edited Christian Jacobi, May 7, 1985 12:45:59 pm PDT
DIRECTORY
Atom,
CD,
CDPrivate,
CDApplications,
CDConvertLayers,
CDDirectory,
CDEvents,
CDBasics,
CDOrient,
Graphics,
Process,
RefTab,
Rope USING [Cat, IsEmpty, ROPE],
SafeStorage,
TerminalIO;
CDImpl: CEDAR MONITOR
IMPORTS Atom, CD, CDApplications, CDDirectory, CDEvents, CDBasics, CDOrient, Graphics, Process, RefTab, Rope, SafeStorage, TerminalIO
EXPORTS CD, CDPrivate, CDConvertLayers
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
layers: PUBLIC REF ARRAY CD.Layer OF CDPrivate.LayerRef =
permanent.NEW[ARRAY CD.Layer OF CDPrivate.LayerRef];
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
layerKeyTab: RefTab.Ref -- contains Layers
];
nilTechnologyPrivate: TechnologyPrivate = NEW[TechnologyPrivateRep←[
objectRegisterTab: RefTab.Create[], --for technology dependant objects it contains NIL
layerKeyTab: 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.interestRect ← DefaultInterestRect;
p.oldInsideRect ← DefaultOldInsideRect;
p.inDirectory ← FALSE;
p.wireTyped ← FALSE;
p.describe ← DefaultDescribe;
p.describeApp ← DefaultDescribeApp;
p.origin ← DefaultOrigin;
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 {
ob1: CD.ObPtr = CDDirectory.ExpandHard[aptr.ob, pr.design, NIL];
IF ob1#NIL THEN {
app: CD.ApplicationPtr = NEW[CD.Application←[ob: ob1, properties: aptr.properties, location: pos, selected: FALSE]];
ob1.p.drawMe[app, pos, orient, pr];
app.ob ← NIL;
app.properties ← NIL;
}
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]
ob1: CD.ObPtr = CDDirectory.ExpandHard[aptr.ob, pr.design, NIL];
IF ob1#NIL THEN {
app: CD.ApplicationPtr = NEW[CD.Application←[ob: ob1, properties: aptr.properties, location: pos, selected: FALSE]];
ob1.p.quickDrawMe[app, pos, orient, pr];
app.ob ← NIL;
app.properties ← NIL;
}
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.MapRect[
itemInCell: CD.InterestRect[aptr.ob],
cellSize: aptr.ob.size,
cellInstOrient: orient,
cellInstPos: pos
],
pr
]
END;
DefaultHitInside: PROC [aptr: CD.ApplicationPtr, hitRect: CD.DesignRect] RETURNS [BOOL] =
BEGIN
RETURN [
CDBasics.Intersect[hitRect, CDApplications.ARectO[aptr]] AND
CDBasics.Intersect[hitRect,
CDOrient.MapRect[
itemInCell: CD.InterestRect[aptr.ob],
cellSize: aptr.ob.size,
cellInstOrient: aptr.orientation,
cellInstPos: aptr.location
]]
]
END;
DefaultDefaultsInterestRecProc: PROC [ob: CD.ObPtr] RETURNS [BOOL] =
BEGIN
RETURN [TRUE]
END;
DefaultInterestRect: PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] =
BEGIN
RETURN [CDBasics.RectAt[[0, 0], ob.size]]
END;
DefaultOrigin: PROC [ob: CD.ObPtr] RETURNS [CD.DesignPosition] =
BEGIN
RETURN [CDBasics.BaseOfRect[ob.p.interestRect[ob]]]
END;
DefaultOldInsideRect: PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] =
BEGIN
RETURN [ob.p.interestRect[ob]]
END;
DefaultDescribeApp: PROC [app: CD.ApplicationPtr] RETURNS [Rope.ROPE] =
BEGIN
RETURN [app.ob.p.describe[app.ob]]
END;
DefaultDescribe: PROC [me: CD.ObPtr] RETURNS [Rope.ROPE] =
BEGIN
Desc: PROC [p: REF READONLY CD.ObjectProcs] RETURNS [Rope.ROPE] =
INLINE BEGIN
RETURN [
IF p.description=NIL THEN Atom.GetPName[p.objectType]
ELSE p.description
]
END;
IF me.p.inDirectory THEN {
n: Rope.ROPE = CDDirectory.Name[me];
IF ~Rope.IsEmpty[n] THEN RETURN [Rope.Cat[Desc[me.p], " ", n]]
};
RETURN [Desc[me.p]]
END;
DefaultDrawComment: PROC [r: CD.DesignRect, comment: Rope.ROPE, pr: CD.DrawRef] =
BEGIN
END;
lastLayer: CD.Layer ← 3;
InitiateLayer: PROC [lev: CD.Layer, technology: CD.Technology←NIL, uniqueKey: ATOM] =
BEGIN
techPriv: TechnologyPrivate;
layers[lev].technology ← technology;
layers[lev].uniqueKey ← uniqueKey;
IF technology=NIL THEN techPriv ← nilTechnologyPrivate
ELSE {
techPriv ← technology.technologyPrivate;
technology.usedLayers ← CONS[lev, technology.usedLayers]
};
[] ← RefTab.Insert[techPriv.layerKeyTab, uniqueKey, layers[lev]];
END;
ConvertLayer: PUBLIC ENTRY PROC [technology: CD.Technology, uniqueKey: ATOM, into: CD.Layer] =
--Helps conversion when layers are renamed
BEGIN
ENABLE UNWIND => NULL;
techPriv: TechnologyPrivate;
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 technology=NIL THEN techPriv ← nilTechnologyPrivate
ELSE techPriv ← technology.technologyPrivate;
[] ← RefTab.Insert[techPriv.layerKeyTab, uniqueKey, layers[into]];
END;
NewLayer: PUBLIC ENTRY PROC [technology: CD.Technology←NIL, uniqueKey: ATOM] RETURNS [CD.Layer] =
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 lastLayer>=CD.layerNum-1 THEN
RETURN WITH ERROR Error[noResource, "too many layers have been requested; (probaly too many different technologies are used)"];
lastLayer ← lastLayer+1;
InitiateLayer[lastLayer, technology, uniqueKey];
RETURN [lastLayer]
END;
DefaultDrawContext: PROC [pr: CD.DrawRef, proc: CD.DrawContextLayerProc, ob: CD.ObPtr, pos: CD.DesignPosition, orient: CD.Orientation, layer: CD.Layer] =
--calls proc which may use context; mode and color are set to layer's need
--call is suppressed if layer 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[layer].doit THEN {
mark: Graphics.Mark = pr.deviceContext.Save[];
[] ← pr.deviceContext.SetPaintMode[pr.contextFilter[layer].paintMode];
pr.deviceContext.SetColor[pr.contextFilter[layer].color];
--pr.deviceContext.ClipBox[[xmin: pr.interestClip.x1, ymin: pr.interestClip.y1, xmax: pr.interestClip.x2, ymax: pr.interestClip.y2]];
IF ob#NIL THEN {
pr.deviceContext.Translate[pos.x, pos.y];
CDOrient.OrientateContext[pr.deviceContext, ob.size, orient];
};
proc[pr.deviceContext, ob, layer !
UNWIND => {
pr.deviceContext.Restore[mark];
GOTO return
}
];
pr.deviceContext.Restore[mark]
}
EXITS
return => NULL;
END;
FetchLayer: PUBLIC PROC [t: CD.Technology, uniqueKey: ATOM] RETURNS [CD.Layer] =
BEGIN
found: BOOL�LSE;
l: CD.Layer ← CD.highLightError;
x: REF;
IF t#NIL THEN {
techPriv: TechnologyPrivate = t.technologyPrivate;
[found: found, val: x] ← RefTab.Fetch[techPriv.layerKeyTab, uniqueKey];
};
IF ~found THEN {
[found: found, val: x] ← RefTab.Fetch[nilTechnologyPrivate.layerKeyTab, uniqueKey];
};
IF found THEN l ← NARROW[x, CDPrivate.LayerRef].number;
RETURN [l]
END;
LayerTechnology: PUBLIC PROC [l: CD.Layer] RETURNS [CD.Technology] =
BEGIN
RETURN [layers[l].technology];
END;
LayerKey: PUBLIC PROC [l: CD.Layer] RETURNS [ATOM] =
BEGIN
RETURN [layers[l].uniqueKey];
END;
nestingDepht: CARDINAL ← 400;
CreateDrawRef: PUBLIC PROC [design: CD.Design, deviceContext: Graphics.Context] RETURNS [CD.DrawRef] =
BEGIN
p: CD.DrawRef ~ NEW[CD.DrawInformation];
p.interestClip ← CDBasics.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[BOOL ← FALSE];
p.drawContext ← DefaultDrawContext;
p.deviceContext ← deviceContext;
p.devicePrivate ← NIL;
p.setGround ← DefaultSetGround;
p.design ← design;
p.nesting ← NEW[CD.Nesting[nestingDepht]];
p.nestDepth ← 0;
RETURN [p]
END;
EmptyOutLineProc: PROC[r: CD.Rect, pr: CD.DrawRef] = {};
SaveByDraw: PROC [r: CD.Rect, l: CD.Layer, pr: CD.DrawRef] = {pr.drawRect[r, l, pr]};
DefaultSetGround: PROC [pr: CD.DrawRef, pushedOut: BOOL] = {};
DrawRectWithGraphics: PROC [r: CD.Rect, l: CD.Layer, pr: CD.DrawRef] =
BEGIN
DrawRectInContext: PROC [context: Graphics.Context, ob: CD.ObPtr, layer: CD.Layer] = {
context.DrawBox[Graphics.Box[xmin: r.x1, xmax: r.x2, ymin: r.y1, ymax: r.y2]];
};
pr.drawContext[pr, DrawRectInContext, NIL, [0, 0], 0, 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.usedLayers ← 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;
FOR l: CD.Layer IN CD.Layer DO
layers[l] ← permanent.NEW[CDPrivate.LayerRec];
layers[l].number ← l;
layers[l].globalUniqueKey ← layers[l];
ENDLOOP;
InitiateLayer[CD.combined, NIL, $combined];
InitiateLayer[CD.highLightShade, NIL, $highLightShade];
InitiateLayer[CD.highLightError, NIL, $highLightError];
InitiateLayer[CD.backGround, NIL, $backGround];
END.