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, June 11, 1985 10:26:11 am PDT
DIRECTORY
CD,
CDPrivate,
CDDefaultProcs,
CDEvents,
CDBasics,
Imager,
RefTab,
Rope,
SafeStorage;
CDImpl:
CEDAR
MONITOR
IMPORTS CDDefaultProcs, CDEvents, RefTab, SafeStorage
EXPORTS CD, CDPrivate
SHARES CDPrivate =
BEGIN
Error: PUBLIC ERROR[ec: CD.ErrorCode ← programmingError, explanation: Rope.ROPE ← NIL] = 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[]
]];
RegisterObjectClass:
PUBLIC
PROC [objectType:
ATOM, technology:
CD.Technology←
NIL]
RETURNS [REF CD.ObjectClass] =
--also initializes procedures with default values
BEGIN
done: BOOL;
class: REF CD.ObjectClass = permanent.NEW[CD.ObjectClass];
class.technology ← technology;
class.objectType ← objectType;
class.further ← RefTab.Create[];
class.drawMe ← CDDefaultProcs.DrawMe;
class.quickDrawMe ← CDDefaultProcs.QuickDrawMe;
class.showMeSelected ← CDDefaultProcs.ShowMeSelected;
class.hitInside ← CDDefaultProcs.HitInside;
class.interestRect ← CDDefaultProcs.InterestRect;
class.oldInsideRect ← DefaultOldInsideRect;
class.inDirectory ← FALSE;
class.wireTyped ← FALSE;
class.describe ← CDDefaultProcs.Describe;
class.describeInst ← CDDefaultProcs.DescribeInstance;
class.origin ← CDDefaultProcs.Origin;
IF technology=NIL THEN done ← RefTab.Insert[nilTechnologyPrivate.objectRegisterTab, objectType, class]
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, class]; -- technology register
}
};
IF NOT done THEN RETURN [NIL];
RETURN [class]
END;
FetchObjectClass:
PUBLIC
PROC [objectType:
REF, technology:
CD.Technology←
NIL]
RETURNS [REF CD.ObjectClass] =
BEGIN
x: REF;
class: REF CD.ObjectClass ← 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
};
IF found THEN class ← NARROW[x];
RETURN [class]
END;
DefaultOldInsideRect:
PROC [ob:
CD.Object]
RETURNS [
CD.Rect] =
BEGIN
RETURN [ob.class.interestRect[ob]]
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; (probably too many different technologies are used)"];
lastLayer ← lastLayer+1;
InitiateLayer[lastLayer, technology, uniqueKey];
RETURN [lastLayer]
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;
CreateDrawRef:
PUBLIC
PROC [design:
CD.Design, deviceContext: Imager.Context]
RETURNS [
CD.DrawRef] =
BEGIN
class: CD.DrawRef = NEW[CD.DrawInformation];
class.interestClip ← CDBasics.universe;
class.minimalSize ← 0;
class.scaleHint ← 0.0;
class.drawRect ← CDDefaultProcs.DrawRect;
class.drawComment ← CDDefaultProcs.DrawComment;
class.drawChild ← CDDefaultProcs.DrawChild;
class.drawOutLine ← CDDefaultProcs.DrawOutLine;
class.stopFlag ← NEW[BOOL ← FALSE];
class.drawContext ← CDDefaultProcs.DrawContext;
class.deviceContext ← deviceContext;
class.devicePrivate ← NIL;
class.design ← design;
class.setGround ← CDDefaultProcs.SetGround;
RETURN [class]
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 TechnologyRep
--not ENTRY since RefTab.Insert does necessary monitoring and CDEvents.ProcessEvent
--is dangerous
BEGIN
t: CD.Technology = permanent.NEW[CD.TechnologyRep];
IF ~RefTab.Insert[technologyRegistration, key, t]
THEN {
Error[doubleRegistration, "technology exist already"];
};
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;
EnumerateTechnologies:
PUBLIC
PROC [proc: CD.TechnologyEnumerator]
RETURNS [quit:
BOOL] =
BEGIN
Action: RefTab.EachPairAction = {
quit ← proc[NARROW[val]]
};
quit ← RefTab.Pairs[technologyRegistration, Action];
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.