CDImpl.mesa (part of ChipNDale)
Copyright © 1983, 1987 by Xerox Corporation. All rights reserved.
Created by: Christian Jacobi, June 24, 1983 5:07 pm
Last Edited by: Christian Jacobi, March 30, 1987 11:35:53 am PST
DIRECTORY
Atom,
Basics,
CD,
CDBasics,
CDDefaultProcs,
CDDirectory,
CDEvents,
CDLayers,
CDPrivate,
CDProperties,
Imager,
IO,
PrincOps,
RefTab,
Rope,
SafeStorage;
CDImpl:
CEDAR
MONITOR
IMPORTS Atom, Basics, CD, CDDefaultProcs, CDDirectory, CDEvents, CDLayers, CDProperties, IO, RefTab, Rope, SafeStorage
EXPORTS CD, CDPrivate
SHARES CDLayers, CDPrivate =
BEGIN
Error: PUBLIC ERROR[ec: CD.ErrorCode ← programming, 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];
pureTechRegistration: RefTab.Ref = RefTab.Create[]; -- contains technologies
allTechRegistration: RefTab.Ref = RefTab.Create[];
--all real technology keys are in stored in both RefTab's
--the convert technology keys are stored only in allTechRegistration
--This allows enumeration to return each technology just once, independent of convert names
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, inherit:
REF←
NIL]
RETURNS [
CD.ObjectClass] = {
done: BOOL;
c: CD.ObjectClass = permanent.NEW[CD.ObjectClassRec𡤌lass];
c.properties ← CD.InitPropRef[];
WITH inherit
SELECT
FROM
oc: CD.ObjectClass => c.parent ← oc;
a:
ATOM => {
oc: CD.ObjectClass ← FetchObjectClass[a, c.technology];
IF oc=NIL THEN ERROR CD.Error[missingRegistration];
c.parent ← oc;
};
ENDCASE => IF inherit#NIL THEN ERROR CD.Error[calling];
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.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 ~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];
--may find it but have NIL value: then is technologydependant
};
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] = {
--Helps conversion when layers are renamed
ENABLE UNWIND => NULL;
techPriv: PrivateTRef;
IF uniqueKey=NIL OR uniqueKey=$NIL THEN RETURN WITH ERROR Error[calling, "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[calling, "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�ultProcs.DrawChild;
IF dr.drawChildSel=NIL THEN dr.drawChildSel�ultProcs.DrawChildSel;
IF dr.drawRect=NIL THEN dr.drawRect�ultProcs.DrawRect;
IF dr.drawOutLine=NIL THEN dr.drawOutLine�ultProcs.ContextOutLine;
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;
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
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[allTechRegistration, key, t]
THEN {
Error[doubleRegistration, "technology exist already"];
};
[] ← RefTab.Insert[pureTechRegistration, key, t];
[] ← CDEvents.ProcessEvent[eventRegistration: registerTechEvent, design: NIL, x: t];
RETURN[t]
};
DesignName:
PUBLIC
PROC [design:
CD.Design←
NIL]
RETURNS [r: Rope.
ROPE] = {
IF design=NIL THEN RETURN ["NIL design"]
ELSE {
r ← design.name;
IF Rope.IsEmpty[r]
THEN
TRUSTED {
r ← IO.PutFR["no name [%g]", [cardinal[LOOPHOLE[design, CARD]]]]
};
}
};
Describe:
PUBLIC
PROC [ob:
CD.Object, readOnlyInstProps:
CD.PropList←
NIL, design:
CD.Design, verbosity:
NAT𡤀]
RETURNS [r: Rope.
ROPE←
NIL] = {
Cat:
PROC [x: Rope.
ROPE] = {
IF r=NIL THEN r ← x ELSE r ← Rope.Cat[r, " ", x]
};
name: Rope.ROPE ← NIL; addr: Rope.ROPE ← NIL;
IF ob=NIL THEN RETURN ["nil object"];
IF design#NIL THEN name ← CDDirectory.Name[ob, design];
IF name#NIL THEN r ← Rope.Cat["""", name, """"]
ELSE
IF verbosity>0
AND ob.class#
NIL
AND ob.class.composed
THEN
r ← addr ← IO.PutFR["[%g]", [cardinal[LOOPHOLE[ob]]]];
IF ob.class=NIL THEN {Cat["bad object"]; RETURN};
IF ob.class.describe#NIL THEN Cat[ob.class.describe[ob, readOnlyInstProps, verbosity]];
IF Rope.IsEmpty[r]
THEN
SELECT
TRUE
FROM
ob.class.description#NIL => r ← ob.class.description;
ob.class.objectType#NIL => r ← Atom.GetPName[ob.class.objectType];
ENDCASE => r ← "object has bad class";
IF verbosity>0
THEN {
hint: Rope.ROPE ← NIL;
WITH CDProperties.GetObjectProp[ob, $Describe]
SELECT
FROM
n: Rope.ROPE => hint ← n;
a: ATOM => hint ← Atom.GetPName[a];
ENDCASE => NULL;
IF hint#NIL AND ~Rope.Equal[hint, name] THEN Cat[Rope.Cat["[hint: ", hint, "]"]];
IF ~ob.class.describesSignal
THEN
WITH CDProperties.GetListProp[readOnlyInstProps, $SignalName]
SELECT
FROM
n: Rope.ROPE => Cat[n];
a: ATOM => Cat[Atom.GetPName[a]];
ENDCASE => NULL;
IF addr=
NIL
THEN
IF verbosity>2
OR ~ob.class.composed
THEN
IF verbosity>3
OR ob.class.composed
THEN
r ← IO.PutFR["%g [%g]", [rope[r]], [cardinal[LOOPHOLE[ob]]]];
};
};
ConvertTechnologyKey:
PUBLIC
PROC [technology:
CD.Technology, oldKey:
ATOM] = {
IF technology=NIL THEN Error[calling];
IF ~RefTab.Insert[allTechRegistration, oldKey, technology]
THEN {
Error[doubleRegistration, "technology key exist already"];
};
};
FetchTechnology:
PUBLIC
PROC [key:
ATOM]
RETURNS [tech:
CD.Technology] = {
RETURN [NARROW[RefTab.Fetch[allTechRegistration, key].val]]
};
EnumerateTechnologies:
PUBLIC
PROC [proc: CD.TechnologyEnumerator]
RETURNS [quit:
BOOL] = {
Action: RefTab.EachPairAction = {
quit ← proc[NARROW[val]]
};
quit ← RefTab.Pairs[pureTechRegistration, 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];
};
GetGrid:
PUBLIC PROC [design:
CD.Design, hint:
REF←
NIL]
RETURNS [g:
CD.Number𡤁] = {
IF getGrid#NIL THEN g ← getGrid[design, hint];
};
getGrid: PROC [design: CD.Design, hint: REF←NIL] RETURNS [CD.Number] ← DefaultGetGrid;
DefaultGetGrid:
PROC [design:
CD.Design, hint:
REF←
NIL]
RETURNS [
CD.Number] = {
RETURN [design.technology.lambda]
};
InstallGetGrid:
PUBLIC
PROC [g:
PROC [design:
CD.Design, hint:
REF←
NIL]
RETURNS [
CD.Number]] = {
IF g#NIL THEN getGrid ← g;
};
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.bbox.x2-ob.bbox.x1) MOD 100B)*1000B];
h ← Basics.BITXOR[h, ((ob.bbox.y2-ob.bbox.y1) MOD 1000B)*100B];
h ← Basics.BITXOR[h, ob.layer];
};
ENDCASE => h ← Munch[x];
};
Equal:
PUBLIC PROC[x, y:
REF]
RETURNS [
BOOL] = {
ob1: CD.Object = NARROW[x];
ob2: CD.Object = NARROW[y];
RETURN [
ob1.class=ob2.class AND ob1.bbox=ob2.bbox AND ob1.layer=ob2.layer AND
CD.InterestRect[ob1]=CD.InterestRect[ob2]
]
};
blueLayer, redLayer, greenLayer, yellowLayer, grayLayer: 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];
CDLayers.MakeSuppressIR[CD.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];
grayLayer ← NewLayer[NIL, $gray];
END.