DIRECTORY
Atom,
Basics,
CD,
CDBasics,
CDDefaultProcs,
CDEvents,
CDLayers, 
CDPrivate,
Imager,
PrincOps,
RefTab,
Rope,
SafeStorage;

CDImpl: CEDAR MONITOR 
IMPORTS Atom, Basics, CD, CDDefaultProcs, CDEvents, CDLayers, RefTab, SafeStorage 
EXPORTS CD, CDPrivate
SHARES CDLayers, CDPrivate = 
BEGIN

Error: PUBLIC ERROR[ec: CD.ErrorCode _ programmingError, explanation: Rope.ROPE _ NIL] = CODE;
permanent: ZONE = SafeStorage.GetPermanentZone[]; 

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] = {
done: BOOL;
c: CD.ObjectClass = permanent.NEW[CD.ObjectClassRec_class];
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]; 
IF globFound AND x#NIL THEN done _ FALSE
ELSE { 
[] _ RefTab.Insert[nilTechnologyPrivate.objectRegisterTab, objectType, NIL]; 
done _ RefTab.Insert[objectRegisterTab, objectType, c]; -- technology register
}
};
IF NOT done THEN ERROR Error[doubleRegistration];
RETURN [c]
};

FetchObjectClass: PUBLIC PROC [objectType: REF, technology: CD.Technology_NIL] 
RETURNS [CD.ObjectClass] = {
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];
};
IF found THEN class _ NARROW[x];
RETURN [class]
}; 

lastLayer: CD.Layer _ 6;

InitiateLayer: PROC [layer: CD.Layer, technology: CD.Technology_NIL, uniqueKey: ATOM] = {
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]];
};

ConvertLayer: PUBLIC ENTRY PROC [technology: CD.Technology, uniqueKey: ATOM, into: CD.Layer] = {
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]];
};

NewLayer: PUBLIC ENTRY PROC [technology: CD.Technology_NIL, uniqueKey: ATOM] RETURNS [CD.Layer] = {
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 requested; (probably too many different technologies used)"];
lastLayer _ lastLayer+1;
InitiateLayer[lastLayer, technology, uniqueKey];
RETURN [lastLayer]
};

FetchLayer: PUBLIC PROC [t: CD.Technology, uniqueKey: ATOM] RETURNS [CD.Layer] = {
found: BOOL_FALSE;
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;
RETURN [l]
};

LayerTechnology: PUBLIC PROC [l: CD.Layer] RETURNS [CD.Technology] = {
RETURN [layers[l].technology];
};

LayerKey: PUBLIC PROC [l: CD.Layer] RETURNS [ATOM] = {
RETURN [layers[l].uniqueKey];
};

CreateDrawRef: PUBLIC PROC [inf: CD.DrawInformation] RETURNS [dr: CD.DrawRef] = {
dr _ NEW[CD.DrawInformation _ inf];
dr.properties _ NEW[CD.PropList_NIL];
IF dr.drawChild=NIL THEN dr.drawChild_CDDefaultProcs.DrawChild;
IF dr.drawRect=NIL THEN dr.drawRect_CDDefaultProcs.DrawRect;
IF dr.drawOutLine=NIL THEN dr.drawOutLine_CDDefaultProcs.DrawOutLine;
IF dr.drawContext=NIL THEN dr.drawContext_CDDefaultProcs.DrawContext;
IF dr.drawComment=NIL THEN dr.drawComment_CDDefaultProcs.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;
};

RegisterTechnology: PUBLIC PROC [key: ATOM, name: Rope.ROPE, lambda: CD.Number] RETURNS [CD.Technology] = {
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]
};

FetchTechnology: PUBLIC PROC [key: ATOM] RETURNS [tech: CD.Technology] = {
RETURN [NARROW[RefTab.Fetch[technologyRegistration, key].val]]
};

EnumerateTechnologies: PUBLIC PROC [proc: CD.TechnologyEnumerator] RETURNS [quit: BOOL] = {
Action: RefTab.EachPairAction = {
quit _ proc[NARROW[val]]
};
quit _ RefTab.Pairs[technologyRegistration, Action];
};

DEnumProc: TYPE = PROC [p: CDPrivate.DesignEnumerator] RETURNS [BOOL];
dEnumerators: LIST OF DEnumProc_NIL;

EnumDesigns: PUBLIC PROC [p: CDPrivate.DesignEnumerator] RETURNS [quit: BOOL_FALSE] = {
seen: RefTab.Ref _ RefTab.Create[5];
Inner: CDPrivate.DesignEnumerator = {
IF RefTab.Insert[seen, design, design] THEN quit _ p[design]
};
FOR el: LIST OF DEnumProc _ dEnumerators, el.rest WHILE el#NIL AND ~quit DO
quit _ el.first[Inner];
ENDLOOP;
};

InstallDesignEnumerator: PUBLIC ENTRY PROC [enum: DEnumProc] = {
IF enum#NIL THEN dEnumerators _ CONS[enum, dEnumerators];
};

Hash: PUBLIC PROC[x: REF] RETURNS [h: CARDINAL] = {
Munch: PROC [REF] RETURNS [CARDINAL] = TRUSTED MACHINE CODE {
PrincOps.zXOR;
};
WITH x SELECT FROM
ob: CD.Object => {
h _ Munch[ob.class];
h _ Basics.BITXOR[h, (ob.size.x MOD 100B)*1000B];
h _ Basics.BITXOR[h, (ob.size.y MOD 1000B)*100B];
h _ Basics.BITXOR[h, ob.layer];
};
ENDCASE => h _ Munch[x];
};

blueLayer, redLayer, greenLayer, yellowLayer: CD.Layer;

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];

blueLayer _ NewLayer[NIL, $blue];
redLayer _ NewLayer[NIL, $red];
greenLayer _ NewLayer[NIL, $green];
yellowLayer _ NewLayer[NIL, $yellow];
END. 

”///cd23/CDImpl.mesa   (part of ChipNDale)
Copyright c 1983, 1986 by Xerox Corporation.  All rights reserved.
Created by: Christian Jacobi, June 24, 1983 5:07 pm 
gbb April 4, 1986 9:30:55 am PST
Last Edited by: Christian Jacobi, September 4, 1986 11:35:38 am PDT
--assume everithing gets correct even if all references are lost, 
--don't care about memory area, hint only
--still check if it might be global
--global register it used per technology
--may find it but have NIL value: then is technologydependant
--Helps conversion when layers are renamed
--not ENTRY since RefTab.Insert does necessary monitoring and CDEvents.ProcessEvent
--is dangerous

Κν˜
codeš
œ)™)Kšœ
Οm
œ7™BKš
œ4™4K™ K™C—K˜š
Οk	˜	Kš
œ˜Kšœž
˜Kšžœ
˜K˜	K˜K˜	Kš
œ
˜
Kš
œ
˜
Kš
œ˜Kš
œ	˜	Kš
œ˜Kš
œ˜K˜—K˜šΟnœžœ
žœ
˜Kšžœžœ:˜RKšžœ
žœ˜Kšžœ˜—Kš
ž˜K˜Kš
œžœ
žœžœ1žœžœžœ
˜^šœžœ#˜2Kš
œB™BKš
œ)™)—K˜šœžœ
žœ
žœ
žœžœ˜:Kš	œ
žœ
žœ
žœžœ˜5—K˜K˜`K˜Kšœ6Οc˜NK˜Kšœ
žœžœ
˜$šœ
žœ
žœžœ˜#Kšœ ˜7Kšœ ˜*K˜K˜K˜—šœ$žœ˜7Kšœ$ 3˜WKš
œ˜Kš
œ˜—K˜K˜šŸœžœ
žœžœžœžœ˜jKšœžœ
˜Kšœžœžœ
žœ˜;Kš
œ ˜ Kšžœžœ
žœ˜1Kšžœ
žœ
žœ"˜6Kšžœžœ
žœ,˜EKšžœžœ
žœ2˜NKšžœ
žœ
žœ(˜?Kšžœžœ
žœ.˜HKšžœžœ
žœ&˜<Kšžœžœ
žœ2˜LKšžœ
žœ
žœ"˜6šžœžœ
žœ
˜Kš
œK˜K—š
ž˜Kš
œ,˜,K˜;Kšœžœ
˜Kšœžœ
˜š
œS˜SKš
œ#™#—Kš	žœžœžœ
žœž˜(šžœ
˜šœGžœ˜MKš
œ(™(—Kšœ8 ˜NKš
ž
˜
—Kšž
œ
˜—Kšžœ
žœžœ
žœ˜1Kšžœ˜
Kšž
œ
˜K˜—šŸœžœ
žœžœžœžœ˜OKšžœžœ˜Kšœžœ
˜Kšœžœžœ
˜Kšœžœ
žœ
˜šžœžœ
žœ
 ˜6Kš
œ*˜*K˜BKš
œ˜—šžœ
žœžœ
 ˜-Kš
œN˜NKš
œ=™=Kš
œ˜—Kšžœžœ	žœ˜ Kšžœ˜Kš
œ˜K˜—Kšœžœ˜K˜šŸ
œžœ	žœžœžœ
žœ˜YKš
œ˜Kš
œ&˜&Kš
œ$˜$Kš
œ˜Kšžœžœ
žœ ˜6šžœ˜K˜Kšœžœ˜:K˜—Kš
œC˜CKš
œ˜—K˜šŸœžœ
žœ
žœžœžœžœ˜`Kš
œ*™*Kšžœ
žœžœ
˜Kš
œ˜Kšžœžœ
žœžœ
žœ
žœ
žœ' I˜©
Kšžœžœ
žœ ˜6Kšžœ˜"Kš
œB˜BKš
œ˜—K˜šŸœžœ
žœ
žœžœžœ
žœžœžœ˜cKšžœ
žœžœ
˜šžœžœ
žœžœ
˜(Kšžœ
žœ
žœ'˜8Kš
 I˜I—šžœžœžœ
˜!Kšžœ
žœ
žœa˜r—K˜Kš
œ0˜0Kšžœ˜Kš
œ˜—K˜šŸ
œžœ
žœžœžœžœžœ˜RKšœžœ
žœ
˜Kšœžœ	žœ˜Kšœžœ
˜šžœžœ
žœ˜Kš
œ!˜!Kš
œG˜GKš
œ˜—šžœžœ˜Kš
œS˜SK˜—Kšžœžœžœ˜7Kšžœ˜
Kš
œ˜K˜—šŸœžœ
žœžœ˜FKšžœ˜Kš
œ˜—K˜šŸœžœ
žœžœžœžœ˜6Kšžœ˜Kš
œ˜—K˜šŸ
œžœ
žœžœžœžœ
˜QKšœžœ
žœ˜#Kšœžœ
žœ
žœ˜%Kšžœžœ
žœ'˜?Kšžœ
žœ
žœ%˜<Kšžœžœ
žœ+˜EKšžœžœ
žœ+˜EKšžœžœ
žœ+˜EKšžœ
žœ
žœ
žœ
žœ
žœ˜4Kšžœžœ
žœ4˜RKšžœžœ
žœ,˜Dš
œ˜K˜——šŸœžœ
žœžœ
žœžœ	žœžœ˜kKš
œS™SKš
œ™šœžœžœ
žœ˜3Kšœžœ˜K˜	Kš	œžœžœ
žœžœ˜4Kš
œ˜Kšœžœ
˜Kšœžœ2˜GKš
œ˜—šžœ0žœ˜8Kš
œ6˜6K˜—Kšœ:žœ˜EKšžœ˜	Kš
œ˜K˜—šŸœžœ
žœžœžœžœ˜JKšžœžœ0˜>Kš
œ˜—K˜š
Ÿœžœ
žœ!žœžœ˜[šΟbœ˜!Kšœžœ˜K˜—Kš
œ4˜4Kš
œ˜—K˜Jš	œžœžœ!žœžœ˜FJšœžœ
žœžœ
˜$J˜šŸœžœ
žœ!žœžœ
žœ˜WJš
œ$˜$šŸœ ˜%Jšžœ%žœ˜<J˜—š
žœžœ
žœ#žœžœ
žœž˜KJš
œ˜Jšžœ
˜—Jš
œ˜—J˜šŸœžœ
žœ
žœ˜@Jšžœžœ
žœžœ˜9Jš
œ˜—J˜šŸœžœ
žœžœžœžœ˜3šŸœžœžœžœžœžœ
žœ
žœ˜=Kš
œ˜Kš
œ˜—šžœžœ
ž˜šœžœ˜Kš
œ˜Kšœžœžœ˜1Kšœžœžœ˜1Kšœžœ˜K˜—Kšžœ˜—Kš
œ˜—K˜Kšœ.žœ˜7K˜Kšžœžœ
žœ
žœ˜&š	žœžœžœ
žœž˜šœžœ˜0Kšœžœ˜Kš
œ	˜	Kš
œ˜—Kš
œ&˜&Kšžœ
˜—šœžœ
žœ˜/Kšœžœ
˜%—Kšœžœ
žœ˜/Kšœžœ
žœ˜/šœžœžœ˜4Kšœžœ˜*—šœžœžœ˜.Kšœžœ˜'—šœžœžœ˜2Kšœžœ˜)—Kšœžœžœ˜.K˜Kšœžœ	˜!Kšœžœ˜Kšœžœ
˜#Kšœžœ˜%Kšžœ˜K˜K™—…—!Œ0