CDDirectoryImpl.mesa (part of ChipNDale)
Copyright © 1983, 1985 by Xerox Corporation. All rights reserved.
by Christian Jacobi, June 24, 1983 5:00 pm
last edited Christian Jacobi, June 11, 1985 3:53:24 pm PDT
DIRECTORY
CD,
CDInstances,
CDCallSpecific,
CDCells,
CDDirectory,
CDEvents,
CDBasics,
CDOrient,
CDOps,
CDProperties,
CDRects,
CDValue,
IO,
Rope,
SymTab,
TerminalIO;
CDDirectoryImpl: CEDAR MONITOR
IMPORTS CD, CDInstances, CDDirectory, CDCells, CDEvents, CDBasics, CDOps, CDOrient, CDProperties, CDRects, CDValue, IO, Rope, SymTab, TerminalIO
EXPORTS CDDirectory
SHARES CD, CDCells =
BEGIN
--all object which contain other objects are supposed to be in the directory;
--which is necessary for enumeration and for repositioning
EachEntryAction: TYPE = PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL];
Fetch: PUBLIC PROC [design: CD.Design, name: Rope.ROPE]
RETURNS [found: BOOL, object: CD.Object←NIL] =
--search for object in directory
BEGIN
x: SymTab.Val;
[found, x] ← SymTab.Fetch[design.cellDirectory, name];
IF found THEN object ← NARROW[x, CD.Object];
END;
Remove: PUBLIC PROC [design: CD.Design, name: Rope.ROPE, expectObject: CD.Object←NIL] RETURNS [done: BOOL�LSE] =
--if expectObject#NIL removes name only, iff named object=expectObject
--if removed objects are still used, they are neither enumerated correctly anymore,
--nor repositioned if internal objects change
BEGIN
object: CD.Object;
found: BOOL;
[found, object] ← Fetch[design, name];
IF found THEN {
IF expectObject=NIL OR object=expectObject THEN {
IF CDProperties.GetPropFromObject[from: object, prop: ownerKey]#design THEN
ERROR CD.Error[callingError, "Removed object not in design"];
done ← SymTab.Delete[design.cellDirectory, name];
IF done THEN {
CDProperties.PutPropOnObject[onto: object, prop: ownerKey, val: NIL];
IncludeEtAll[object, NIL, name]
}
}
}
END;
IncludeEtAll: PROC[object: CD.Object, design: CD.Design, name: Rope.ROPE] =
BEGIN
IF object.class.inDirectory THEN {
includeEtAll: CDDirectory.IncludeEtAllProc = CDDirectory.ObToDirectoryProcs[object].includeEtAll;
IF includeEtAll#NIL THEN includeEtAll[object, design, name];
}
END;
SetName: PROC[me: CD.Object, r: Rope.ROPE] = INLINE {
IF me.class.inDirectory THEN CDDirectory.ObToDirectoryProcs[me].setName[me, r]
};
Include: PUBLIC PROC [design: CD.Design, object: CD.Object,
alternateName: Rope.ROPENIL, fiddleName: BOOLTRUE] RETURNS [done: BOOL] =
--it is an ERROR to include an object into several design's
BEGIN
try: INT ← 0;
IF CDProperties.GetPropFromObject[from: object, prop: ownerKey]#NIL THEN
ERROR CD.Error[callingError, "Included object already in a design"];
IF alternateName.IsEmpty[] THEN alternateName ← CDDirectory.Name[object];
IF alternateName.IsEmpty[] THEN alternateName ← "-noname-";
DO
IF SymTab.Insert[design.cellDirectory, alternateName, object] THEN {
SetName[object, alternateName];
CDProperties.PutPropOnObject[onto: object, prop: ownerKey, val: design];
IncludeEtAll[object, design, alternateName];
RETURN [done ← TRUE]
};
IF object = Fetch[design, alternateName].object THEN {
TerminalIO.WriteRope["object included twice; debugging is appropriate\n"];
};
IF ~fiddleName THEN RETURN [done ← FALSE];
alternateName ← FiddleName[alternateName, design];
try ← try+1;
IF try<5 THEN alternateName ← FiddleName[alternateName, design]
ELSE {
alternateName ← Rope.Concat[alternateName, IO.PutFR1["@%g@0", IO.int[globalCount]]];
try ← 0;
}
ENDLOOP;
END;
globalCount: INTLOOPHOLE[nameKey, INT] MOD 9999 / 8;
--some value which might differ next time ChipNDale is started
FiddleName: PROC [name: Rope.ROPE, design: CD.Design] RETURNS [Rope.ROPE] =
BEGIN
modifier: INT ← CDValue.FetchInt[design, $CDxNextInt] MOD 10000000000B;
leng: INT ← name.Length[];
WHILE leng>0 DO
leng ← leng-1;
IF name.Fetch[leng]='@ THEN {
name ← name.Substr[0, leng];
EXIT
}
ENDLOOP;
name ← Rope.Concat[name, IO.PutFR1["@%g", IO.int[modifier]]];
globalCount ← globalCount MOD 10000000B + 1;
CDValue.StoreInt[design, $CDxNextInt, modifier+1];
RETURN [name];
END;
Rename: PUBLIC PROC [design: CD.Design, object: CD.Object,
newName: Rope.ROPENIL, fiddleName: BOOLFALSE] RETURNS [done: BOOLFALSE] =
BEGIN
oldName: Rope.ROPE = CDDirectory.Name[object];
removed: BOOL = Remove[design, oldName, object];
IF removed THEN {
back: BOOL ← Include[design, object, newName, fiddleName];
IF back THEN RETURN [done ← TRUE];
back ← Include[design, object, oldName, TRUE];
IF NOT back THEN ERROR CD.Error[programmingError, "rename removed an object"]
}
END;
Enumerate: PUBLIC PROC [design: CD.Design, action: EachEntryAction] RETURNS [quit: BOOL] =
--enumerates objects currently in directory in unspecified order
--objects inserted/deleted during enumeration may or may not be seen
--applies action to each object until action returns TRUE or no more objects
--returns quit: TRUE if some action returns TRUE
BEGIN
EachPairAction: SymTab.EachPairAction ~ {
quit ← action[name: key, ob: NARROW[val, CD.Object]]
};
quit ← SymTab.Pairs[design.cellDirectory, EachPairAction]
END;
InstallDirectoryProcs: PUBLIC PROC [type: REF CD.ObjectClass] RETURNS [REF CDDirectory.DirectoryProcs] =
BEGIN
dp: REF CDDirectory.DirectoryProcs ~ NEW[CDDirectory.DirectoryProcs];
IF type.directoryProcs#NIL OR type.inDirectory THEN
ERROR CD.Error[ec: doubleRegistration, explanation: "object type includes already directory"];
type.directoryProcs ← dp;
type.inDirectory ← TRUE;
dp.enumerateChildObjects ← DefaultEnumerate;
dp.replaceDirectChilds ← DefaultReplaceDirectChilds;
dp.another ← DefaultAnother;
dp.name ← DefaultName;
dp.setName ← DefaultSetName;
RETURN [dp]
END;
DefaultAnother: CDDirectory.AnotherProc =
--crazy another proc which makes a copy of the object-definition
BEGIN
newOb: CD.Object = NEW[CD.ObjectRep←me^];
newOb.properties ← CDProperties.CopyProps[me.properties];
[] ← Include[to, newOb];
RETURN [newOb]
END;
DefaultReplaceDirectChilds: CDDirectory.ReplaceDChildsProc =
BEGIN
ERROR
END;
DefaultEnumerate: PROC [me: CD.Object, p: CDDirectory.EnumerateObjectsProc, x: REF] =
BEGIN
END;
DefaultSetName: PROC [me: CD.Object, r: Rope.ROPE] =
BEGIN
CDProperties.PutPropOnObject[onto: me, prop: nameKey, val: r]
END;
DefaultName: PROC [me: CD.Object] RETURNS [Rope.ROPE] =
BEGIN
WITH CDProperties.GetPropFromObject[from: me, prop: nameKey] SELECT FROM
r: Rope.ROPE => RETURN [r];
ENDCASE => RETURN ["-no name"]
END;
-- -- -- -- -- -- -- -- -- -- -- --
Another: PUBLIC PROC [me: CD.Object, from, to: CD.Design] RETURNS [CD.Object] =
--CAUTION: goes only one level deep; caller MUST go down the hierachy and
--replace children if from#to; name might change due to conflicts
BEGIN
IF me.class.inDirectory THEN
RETURN [CDDirectory.ObToDirectoryProcs[me].another[me, from, to]]
ELSE RETURN [me]
END;
Expand: PUBLIC PROC [me: CD.Object, from, to: CD.Design] RETURNS [new: CD.Object ←NIL] =
--May succeed or not, returns NIL if no success;
--returned object is of expand-simpler object class (half ordered); but
--  it will generate exactly the same mask.
--When "me" later changes, this has no influence on result;
--Each call delivers a new copy of result
--goes only one level deep; caller MUST go down the hierachy and
--replace children if from#to; name might change due to conflicts
BEGIN
IF me.class.inDirectory THEN {
expand: CDDirectory.AnotherProc = CDDirectory.ObToDirectoryProcs[me].expand;
IF expand#NIL THEN new ← expand[me, from, to];
}
END;
ExpandHard: PUBLIC PROC [me: CD.Object, from, to: CD.Design] RETURNS [CD.Object] =
BEGIN
new: CD.Object ← Expand[me, from, to];
IF new=NIL THEN {
new ← ExpandByDraw[me, from, to];
};
RETURN [new]
END;
ExpandRec: TYPE = RECORD [
cell: CD.Object,
cellPtr: CD.CellPtr,
hasContext: BOOLFALSE
];
ExpandByDraw: PUBLIC PROC [me: CD.Object, from, to: CD.Design] RETURNS [CD.Object] =
--me should not propagate
BEGIN
dummyApPtr: CD.Instance = NEW[CD.InstanceRep];
expandRef: REF ExpandRec = NEW[ExpandRec];
expandPr: CD.DrawRef = CD.CreateDrawRef[from];
expandPr.interestClip ← CDBasics.universe;
expandPr.drawRect ← ExpandBareRect;
expandPr.drawChild ← ExpandChild;
expandPr.drawContext ← ExpandContext;
expandPr.devicePrivate ← expandRef;
dummyApPtr^.ob ← me;
expandRef.cell ← CDCells.CreateEmptyCell[];
expandRef.cellPtr ← NARROW[expandRef.cell.specificRef];
me.class.drawMe[inst: dummyApPtr, pos: [0, 0], orient: 0, pr: expandPr];
IF expandRef.cellPtr.contents#NIL AND ~expandRef.hasContext THEN {
name: Rope.ROPE ← CDDirectory.Name[me];
IF Rope.IsEmpty[name] THEN name ← CDOps.Info[me];
expandRef.cellPtr.name ← Rope.Concat["!", name];
expandRef.cellPtr.ir ← CDInstances.BoundingRectI[expandRef.cellPtr.contents];
expandRef.cell.size ← me.size; --we dont reposition! size might have been bad and we want to get exactly the same size back
expandRef.cellPtr.dIr ← CD.InterestRect[me];
expandRef.cellPtr.useDIr ← FALSE;
--CopyOrigin[from: me, to: expandRef.cell]; skipped, because is probably not important
IF to#NIL THEN [] ← Include[design: to, object: expandRef.cell, fiddleName: TRUE];
RETURN [expandRef.cell]
};
RETURN [NIL]
END;
ExpandBareRect: PROC [r: CD.Rect, l: CD.Layer, pr: CD.DrawRef] =
BEGIN
expandRef: REF ExpandRec = NARROW[pr.devicePrivate];
ob: CD.Object = CDRects.CreateBareRect[size: CDBasics.SizeOfRect[r], l: l];
inst: CD.Instance ← NEW[CD.InstanceRep←[ob: ob, location: CDBasics.BaseOfRect[r], selected: FALSE]];
expandRef.cellPtr.contents ← CONS[inst, expandRef.cellPtr.contents];
END;
ExpandChild: PROC [inst: CD.Instance, pos: CD.Position, orient: CD.Orientation, pr: REF CD.DrawInformation] -- CD.DrawProc -- =
BEGIN
--make an instance
expandRef: REF ExpandRec = NARROW[pr.devicePrivate];
newInst: CD.Instance = NEW[CD.InstanceRep←[
ob: inst.ob,
location: pos,
orientation: orient,
selected: FALSE,
properties: CDProperties.CopyProps[inst.properties]
]];
expandRef.cellPtr.contents ← CONS[newInst, expandRef.cellPtr.contents];
END;
ExpandContext: PROC [pr: CD.DrawRef, proc: CD.DrawContextLayerProc, ob: CD.Object, pos: CD.Position, orient: CD.Orientation, layer: CD.Layer] =
BEGIN
expandRef: REF ExpandRec = NARROW[pr.devicePrivate];
expandRef.hasContext ← TRUE;
pr.stopFlag^ ← TRUE;
END;
-- -- -- -- -- -- -- -- -- -- -- --
RepositionList: TYPE = LIST OF CD.Object;
changeEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterChange];
ReplaceObject: PUBLIC PROC [design: CD.Design,
old: CD.Object,
new: CD.Object,
off: CD.Position←[0, 0]
] =
--all over in the design replace old by new
--may be delayed
BEGIN
repRef: REF CDDirectory.ReplaceRec ← NEW[CDDirectory.ReplaceRec←[
old: old,
oldSize: old.size,
newSize: new.size,
new: new,
off: off
]];
IF design=NIL THEN ERROR;
FOR plist: LIST OF CD.PushRec ← design.actual, plist.rest WHILE plist#NIL DO
IF plist.first.mightReplace#NIL AND plist.first.mightReplace.ob=old THEN
TerminalIO.WriteRope["** Tries to replace pushed in cell; does not work\n"];
ENDLOOP;
ReplaceAllChilds[design, repRef]
END;
RepositionObject: PUBLIC PROC [design: CD.Design,
ob: CD.Object,
oldSize: CD.Position,
baseOff: CD.Position←[0, 0]
] =
--all over in the design tries to reposition ob;
--may be delayed
BEGIN
repRef: REF CDDirectory.ReplaceRec ← NEW[CDDirectory.ReplaceRec←[
old: ob,
oldSize: oldSize,
newSize: ob.size,
new: ob,
off: baseOff
]];
[] ← CDEvents.ProcessEvent[
ev: repositionEvent,
design: design,
x: NEW[CDDirectory.ReplaceRec ← repRef^], --copy for safety
listenToDont: FALSE
];
IF design#NIL THEN ReplaceAllChilds[design, repRef]
END;
ReplaceAllChilds: PROC [design: CD.Design, repRef: REF CDDirectory.ReplaceRec] =
--design#NIL
BEGIN
ref: REF CDDirectory.ReplaceList ← NARROW[
CDValue.Fetch[boundTo: design, key: repositioningListKey, propagation: design]
];
IF ref#NIL THEN { -- we are inside replace process, remember object
IF ref^=NIL THEN ref^ ← LIST[repRef]
ELSE {
FOR l: CDDirectory.ReplaceList ← ref^, l.rest DO
IF l.first.old=repRef.old THEN
--impossible; call me to debug this
ERROR;
IF l.rest=NIL THEN {l.rest ← LIST[repRef]; EXIT}
ENDLOOP;
};
RETURN
};
-- we are not inside reposition process, start one
ref ← NEW[CDDirectory.ReplaceList←LIST[repRef]];
CDValue.Store[boundTo: design, key: repositioningListKey, value: ref];
WHILE ref^#NIL DO
repList: CDDirectory.ReplaceList ← ref^;
ref^ ← NIL;
DoReplaceAllChilds[design, repList];
ENDLOOP;
CDValue.Store[boundTo: design, key: repositioningListKey, value: NIL];
CDOps.DelayedRedraw[design];
END;
DoReplaceDirectChild: PUBLIC CDDirectory.ReplaceDChildsProc =
BEGIN
IF me.class.inDirectory THEN
changed ← CDDirectory.ObToDirectoryProcs[me].replaceDirectChilds[me, design, replace];
IF changed THEN PropagateChange[me, design];
END;
DoReplaceAllChilds: PUBLIC PROC [design: CD.Design, repList: CDDirectory.ReplaceList] =
BEGIN
ReplaceForOne: CDDirectory.EachEntryAction =
-- PROC [name: Rope.ROPE, ob: CD.Object] RETURNS [quit: BOOL�LSE] --
BEGIN
[] ← DoReplaceDirectChild[me: ob, design: design, replace: repList];
END;
FOR list: CDDirectory.ReplaceList ← repList, list.rest WHILE list#NIL DO
list.first.newSize ← list.first.new.size;
ENDLOOP;
[] ← CDDirectory.Enumerate[design, ReplaceForOne];
FOR plist: LIST OF CD.PushRec ← design.actual, plist.rest WHILE plist#NIL DO
inst: CD.Instance ← plist.first.mightReplace;
CDProperties.PutPropOnObject[plist.first.dummyCell.ob, $Owner, design]; --HACK XXX XXX
FOR rlist: CDDirectory.ReplaceList ← repList, rlist.rest WHILE rlist#NIL DO
rep: REF CDDirectory.ReplaceRec = rlist.first;
IF inst#NIL AND inst.ob=rep.old THEN {
realPos: CD.Position = CDOrient.MapPoint[
pointInCell: rep.off,
cellSize: rep.oldSize,
cellInstOrient: inst.orientation,
cellInstPos: inst.location
];
fakePos: CD.Position = CDOrient.MapPoint[
pointInCell: [0, 0],
cellSize: rep.newSize,
cellInstOrient: inst.orientation,
cellInstPos: [0, 0]
];
inst.location ← CDBasics.SubPoints[realPos, fakePos];
}
ENDLOOP;
[] ← CDCells.ReplaceDirectChildForDummyCells[plist.first.dummyCell.ob, repList];
ENDLOOP;
END;
PropagateChange: PUBLIC PROC [ob: CD.Object, design: CD.Design] =
-- processes an CDEvent $AfterChange
BEGIN
[] ← CDEvents.ProcessEvent[changeEvent, design, ob];
END;
repositionEventKey: ATOM = $reposition;
repositionEvent: CDEvents.EventRegistration = CDEvents.RegisterEventType[repositionEventKey];
repositioningListKey: ATOM = $RepositioningList;
ownerKey: ATOM = $Owner; --HACK XXX: property is also used by cdcellsimpl
nameKey: REF ATOM = NEW[ATOM ← $Name]; -- make it non accessible, non write on file
[] ← CDProperties.RegisterProperty[ownerKey];
CDProperties.InstallProcs[prop: ownerKey, new: CDProperties.PropertyProcsRec[exclusive: TRUE]];
CDProperties.InstallProcs[prop: nameKey, new: CDProperties.PropertyProcsRec[exclusive: TRUE]];
CDValue.EnregisterKey[repositioningListKey];
END.