CDImpl.mesa (part of ChipNDale)
Copyright © 1983, 1986 by Xerox Corporation. All rights reserved.
Christian Jacobi, June 24, 1983 5:07 pm
last edited Christian Jacobi, March 25, 1986 2:18:06 pm PST
gbb April 4, 1986 9:30:55 am PST
DIRECTORY
Atom,
CD,
CDBasics,
CDDefaultProcs,
CDEvents,
CDLayers,
CDPrivate,
Imager,
List,
RefTab,
Rope,
SafeStorage;
CDImpl: CEDAR MONITOR
IMPORTS Atom, CD, CDDefaultProcs, CDEvents, CDLayers, List, RefTab, SafeStorage
EXPORTS CD, CDPrivate
SHARES CDLayers, CDPrivate =
BEGIN
Error: PUBLIC ERROR[ec: CD.ErrorCode ← programmingError, explanation: Rope.ROPE ← NIL] = CODE;
callMaintainerOrMessageHimTheStackAndProceed: SIGNAL = 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
PrivateTRef: TYPE = REF PrivateTRep;
PrivateTRep: PUBLIC TYPE = RECORD [
objectRegisterTab: RefTab.Ref, -- contains object types
layerKeyTab: RefTab.Ref -- contains Layers
];
nilTechnologyPrivate: PrivateTRef = NEW[PrivateTRep ← [
objectRegisterTab: RefTab.Create[], --for technology dependant objects it contains NIL
layerKeyTab: RefTab.Create[]
]];
RegisterObjectClass: PUBLIC PROC [objectType: ATOM, class: CD.ObjectClassRec] RETURNS [CD.ObjectClass] =
BEGIN
done: BOOL;
c: CD.ObjectClass = permanent.NEW[CD.ObjectClassRec𡤌lass];
c.properties ← CD.InitPropRef[];
IF objectType#NIL THEN c.objectType ← objectType;
IF c.drawMe=NIL THEN c.drawMe ← CDDefaultProcs.DrawMe;
IF c.quickDrawMe=NIL THEN c.quickDrawMe ← CDDefaultProcs.QuickDrawMe;
IF c.showMeSelected=NIL THEN c.showMeSelected ← CDDefaultProcs.ShowMeSelected;
IF c.hitInside=NIL THEN c.hitInside ← CDDefaultProcs.HitInside;
IF c.interestRect=NIL THEN c.interestRect ← CDDefaultProcs.InterestRect;
IF c.describe=NIL THEN c.describe ← CDDefaultProcs.Describe;
IF c.describeInst=NIL THEN c.describeInst ← CDDefaultProcs.DescribeInstance;
IF c.origin=NIL THEN c.origin ← CDDefaultProcs.Origin;
IF c.technology=NIL THEN
done ← RefTab.Insert[nilTechnologyPrivate.objectRegisterTab, objectType, c]
ELSE {
techPriv: PrivateTRef = c.technology.cdPriv;
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, c]; -- technology register
}
};
IF NOT done THEN ERROR Error[doubleRegistration];
RETURN [c]
END;
FetchObjectClass: PUBLIC PROC [objectType: REF, technology: CD.Technology←NIL]
RETURNS [CD.ObjectClass] =
BEGIN
x: REF;
class: CD.ObjectClass ← NIL;
found: BOOL ← FALSE;
IF technology#NIL THEN { -- search in technology table
techPriv: PrivateTRef = technology.cdPriv;
[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;
lastLayer: CD.Layer ← 6;
InitiateLayer: PROC [layer: CD.Layer, technology: CD.Technology←NIL, uniqueKey: ATOM] =
BEGIN
techPriv: PrivateTRef;
layers[layer].technology ← technology;
layers[layer].uniqueKey ← uniqueKey;
CDLayers.MakePaint[layer];
IF technology=NIL THEN techPriv ← nilTechnologyPrivate
ELSE {
techPriv ← technology.cdPriv;
technology.usedLayers ← CONS[layer, technology.usedLayers]
};
[] ← RefTab.Insert[techPriv.layerKeyTab, uniqueKey, layers[layer]];
END;
ConvertLayer: PUBLIC ENTRY PROC [technology: CD.Technology, uniqueKey: ATOM, into: CD.Layer] =
--Helps conversion when layers are renamed
BEGIN
ENABLE UNWIND => NULL;
techPriv: PrivateTRef;
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.cdPriv;
[] ← 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.errorLayer;
x: REF;
IF t#NIL THEN {
techPriv: PrivateTRef = t.cdPriv;
[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
ELSE callMaintainerOrMessageHimTheStackAndProceed;
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 [inf: CD.DrawInformation] RETURNS [dr: CD.DrawRef] =
BEGIN
dr ← NEW[CD.DrawInformation ← inf];
dr.properties ← NEW[CD.PropList←NIL];
IF dr.drawChild=NIL THEN dr.drawChild�ultProcs.DrawChild;
IF dr.drawRect=NIL THEN dr.drawRect�ultProcs.DrawRect;
IF dr.drawOutLine=NIL THEN dr.drawOutLine�ultProcs.DrawOutLine;
IF dr.drawContext=NIL THEN dr.drawContext�ultProcs.DrawContext;
IF dr.drawComment=NIL THEN dr.drawComment�ultProcs.DrawComment;
IF dr.stopFlag=NIL THEN dr.stopFlag←NEW[BOOL←FALSE];
IF dr.priorityChecker=NIL THEN dr.priorityChecker ← CDDefaultProcs.IgnorePriority;
IF dr.setGround=NIL THEN dr.setGround ← CDDefaultProcs.IgnoreGround;
END;
RegisterTechnology: PUBLIC PROC [key: ATOM, name: Rope.ROPE, lambda: CD.Number] RETURNS [CD.Technology] =
--not ENTRY since RefTab.Insert does necessary monitoring and CDEvents.ProcessEvent
--is dangerous
BEGIN
t: CD.Technology = permanent.NEW[CD.TechnologyRep←[
properties: CD.InitPropRef[],
key: key,
name: IF name#NIL THEN name ELSE Atom.GetPName[key],
lambda: lambda,
usedLayers: NIL,
cdPriv: permanent.NEW[PrivateTRep ← [RefTab.Create[], RefTab.Create[]]]
]];
IF ~RefTab.Insert[technologyRegistration, key, t] THEN {
Error[doubleRegistration, "technology exist already"];
};
[] ← CDEvents.ProcessEvent[ev: registerTechEvent, design: NIL, x: t];
RETURN[t]
END;
FetchTechnology: PUBLIC PROC [key: ATOM] RETURNS [tech: CD.Technology] =
BEGIN
RETURN [NARROW[RefTab.Fetch[technologyRegistration, key].val]]
END;
EnumerateTechnologies: PUBLIC PROC [proc: CD.TechnologyEnumerator] RETURNS [quit: BOOL] =
BEGIN
Action: RefTab.EachPairAction = {
quit ← proc[NARROW[val]]
};
quit ← RefTab.Pairs[technologyRegistration, Action];
END;
DEnumProc: TYPE = PROC [p: CDPrivate.DesignEnumerator] RETURNS [BOOL];
dEnumerators: LIST OF DEnumProc←NIL;
EnumDesigns: PUBLIC PROC [p: CDPrivate.DesignEnumerator] RETURNS [quit: BOOL←FALSE] =
BEGIN
dList: LIST OF CD.Design ← NIL;
Inner: CDPrivate.DesignEnumerator = TRUSTED {
IF ~List.Memb[design, LOOPHOLE[dList]] THEN {
dList ← CONS[design, dList];
quit ← p[design];
};
};
FOR el: LIST OF DEnumProc ← dEnumerators, el.rest WHILE el#NIL AND ~quit DO
quit ← el.first[Inner];
ENDLOOP;
END;
InstallDesignEnumerator: PUBLIC ENTRY PROC [enum: DEnumProc] =
BEGIN
IF enum#NIL THEN dEnumerators ← CONS[enum, dEnumerators];
END;
IF registerTechEvent=NIL THEN ERROR;
FOR l: CD.Layer IN CD.Layer DO
layers[l] ← permanent.NEW[CDPrivate.LayerRec ← [
properties: CD.InitPropRef[],
number: l
]];
layers[l].globalUniqueKey ← layers[l];
ENDLOOP;
InitiateLayer[CD.undefLayer, NIL, $undefLayer];
CDLayers.MakeAbstract[CD.undefLayer];
InitiateLayer[CD.shadeLayer, NIL, $shadeLayer];
InitiateLayer[CD.errorLayer, NIL, $errorLayer];
InitiateLayer[CD.backgroundLayer, NIL, $backGround];
CDLayers.MakeAbstract[CD.backgroundLayer];
InitiateLayer[CD.outlineLayer, NIL, $outline];
CDLayers.MakeAbstract[CD.outlineLayer];
InitiateLayer[CD.selectionLayer, NIL, $selection];
CDLayers.MakeAbstract[CD.selectionLayer];
InitiateLayer[CD.commentLayer, NIL, $comment];
END.
gbb April 4, 1986 9:29:02 am PST
Added a signal for the case a client tries to fetch a non-existant layer.
changes to: callMaintainerOrMessageHimTheStackAndProceed: new signal, FetchLayer: now handles miss of layer.