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, December 30, 1985 10:13:43 am PST
DIRECTORY
Atom,
CD,
CDPrivate,
CDDefaultProcs,
CDEvents,
CDBasics,
Imager,
RefTab,
Rope,
SafeStorage;
CDImpl:
CEDAR
MONITOR
IMPORTS Atom, CD, 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;
class.properties ← CD.InitPropRef[];
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 ERROR Error[doubleRegistration];
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 [class:
CD.DrawRef] =
BEGIN
class ←
NEW[
CD.DrawInformation ← [
interestClip: CDBasics.universe,
minimalSize: 0,
scaleHint: 0.0,
drawChild: CDDefaultProcs.DrawChild,
drawRect: CDDefaultProcs.DrawRect,
drawOutLine: CDDefaultProcs.DrawOutLine,
drawContext: CDDefaultProcs.DrawContext,
drawComment: CDDefaultProcs.DrawComment,
stopFlag: NEW[BOOL ← FALSE],
priorityChecker: CDDefaultProcs.IgnorePriority,
setGround: CDDefaultProcs.IgnoreGround,
deviceContext: deviceContext,
properties: CD.InitPropRef[],
design: design
]];
RegisterTechnology:
PUBLIC
PROC [key:
ATOM, name: Rope.
ROPE, lambda:
CD.Number]
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←[
properties: CD.InitPropRef[],
key: key,
name: IF name#NIL THEN name ELSE Atom.GetPName[key],
lambda: lambda,
usedLayers: NIL,
technologyPrivate: permanent.NEW[TechnologyPrivateRep ← [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 ←
NIL] =
--Returns NIL if key is not registered
BEGIN
x: REF; found: BOOL;
[found: found, val: x] ← RefTab.Fetch[technologyRegistration, key];
IF found THEN tech ← NARROW[x];
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 ← [
properties: CD.InitPropRef[],
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.