<> <> <> <> <> DIRECTORY CD, CDApplications, CDCallSpecific, CDCells, CDDirectory, CDEnvironment, CDEvents, CDBasics, CDOrient, CDOps, CDProperties, CDRects, CDValue, IO, Rope, SymTab, TerminalIO; CDDirectoryImpl: CEDAR MONITOR IMPORTS CD, CDApplications, CDDirectory, CDCells, CDEnvironment, 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.ObPtr] RETURNS [quit: BOOL]; Fetch: PUBLIC PROC [design: CD.Design, name: Rope.ROPE] RETURNS [found: BOOL, object: CD.ObPtr_NIL] = <<--search for object in directory>> BEGIN x: SymTab.Val; [found, x] _ SymTab.Fetch[design.cellDirectory, name]; IF found THEN object _ NARROW[x, CD.ObPtr]; END; <<>> Remove: PUBLIC PROC [design: CD.Design, name: Rope.ROPE, expectObject: CD.ObPtr_NIL] RETURNS [done: BOOL_FALSE] = <<--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.ObPtr; 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.ObPtr, design: CD.Design, name: Rope.ROPE] = BEGIN IF object.p.inDirectory THEN { includeEtAll: CDDirectory.IncludeEtAllProc = CDDirectory.ObToDirectoryProcs[object].includeEtAll; IF includeEtAll#NIL THEN includeEtAll[object, design, name]; } END; SetName: PROC[me: CD.ObPtr, r: Rope.ROPE] = INLINE { IF me.p.inDirectory THEN CDDirectory.ObToDirectoryProcs[me].setName[me, r] }; Include: PUBLIC PROC [design: CD.Design, object: CD.ObPtr, alternateName: Rope.ROPE_NIL, fiddleName: BOOL_TRUE] 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.PutFR["@%g@0", IO.int[globalCount]]]; try _ 0; } ENDLOOP; END; globalCount: INT _ LOOPHOLE[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.PutFR["@%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.ObPtr, newName: Rope.ROPE _ NIL, fiddleName: BOOL_FALSE] RETURNS [done: BOOL _ FALSE] = 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.ObPtr]] }; quit _ SymTab.Pairs[design.cellDirectory, EachPairAction] END; InstallDirectoryProcs: PUBLIC PROC [type: REF CD.ObjectProcs] 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.ObPtr = NEW[CD.ObjectDefinition_me^]; newOb.properties _ CDProperties.CopyProps[me.properties]; [] _ Include[to, newOb]; RETURN [newOb] END; DefaultReplaceDirectChilds: CDDirectory.ReplaceDChildsProc = BEGIN ERROR END; DefaultEnumerate: PROC [me: CD.ObPtr, p: CDDirectory.EnumerateObjectsProc, x: REF] = BEGIN END; DefaultSetName: PROC [me: CD.ObPtr, r: Rope.ROPE] = BEGIN CDProperties.PutPropOnObject[onto: me, prop: nameKey, val: r] END; DefaultName: PROC [me: CD.ObPtr] 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.ObPtr, from, to: CD.Design] RETURNS [CD.ObPtr] = <<--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.p.inDirectory THEN RETURN [CDDirectory.ObToDirectoryProcs[me].another[me, from, to]] ELSE RETURN [me] END; Expand: PUBLIC PROC [me: CD.ObPtr, from, to: CD.Design] RETURNS [new: CD.ObPtr _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.p.inDirectory AND ~CDEnvironment.Propagates[me]THEN { expand: CDDirectory.AnotherProc = CDDirectory.ObToDirectoryProcs[me].expand; IF expand#NIL THEN new _ expand[me, from, to]; } END; ExpandHard: PUBLIC PROC [me: CD.ObPtr, from, to: CD.Design] RETURNS [CD.ObPtr] = BEGIN new: CD.ObPtr _ Expand[me, from, to]; IF new=NIL THEN { IF me.p.inDirectory AND CDEnvironment.Propagates[me] THEN RETURN [NIL]; <<--non cells: we don't have the environment here>> <<--cells: they don't really dependent on environment, but simply propagate;>> <<--however, it's not worth the effort>> new _ ExpandByDraw[me, from, to]; }; RETURN [new] END; ExpandRec: TYPE = RECORD [ cell: CD.ObPtr, cellPtr: CD.CellPtr, hasContext: BOOL _ FALSE ]; ExpandByDraw: PUBLIC PROC [me: CD.ObPtr, from, to: CD.Design] RETURNS [CD.ObPtr] = <<--me should not propagate>> BEGIN dummyApPtr: CD.ApplicationPtr = NEW[CD.Application]; expandRef: REF ExpandRec = NEW[ExpandRec]; expandPr: CD.DrawRef = CD.CreateDrawRef[from]; expandPr.interestClip _ CDBasics.universe; expandPr.drawRect _ ExpandBareRect; expandPr.saveRect _ ExpandSaveRect; expandPr.drawChild _ ExpandChild; expandPr.drawContext _ ExpandContext; expandPr.devicePrivate _ expandRef; dummyApPtr^.ob _ me; expandRef.cell _ CDCells.CreateEmptyCell[]; expandRef.cellPtr _ NARROW[expandRef.cell.specificRef]; me.p.drawMe[aptr: 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 _ CDApplications.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.DesignRect, l: CD.Layer, pr: CD.DrawRef] = BEGIN expandRef: REF ExpandRec = NARROW[pr.devicePrivate]; ob: CD.ObPtr = CDRects.CreateBareRect[size: CDBasics.SizeOfRect[r], l: l]; app: CD.ApplicationPtr _ NEW[CD.Application_[ob: ob, location: CDBasics.BaseOfRect[r], selected: FALSE]]; expandRef.cellPtr.contents _ CONS[app, expandRef.cellPtr.contents]; END; ExpandSaveRect: PROC [r: CD.DesignRect, l: CD.Layer, pr: CD.DrawRef] = BEGIN expandRef: REF ExpandRec = NARROW[pr.devicePrivate]; ob: CD.ObPtr = CDRects.CreateSaveRect[size: CDBasics.SizeOfRect[r], l: l]; app: CD.ApplicationPtr _ NEW[CD.Application_[ob: ob, location: CDBasics.BaseOfRect[r], selected: FALSE]]; expandRef.cellPtr.contents _ CONS[app, expandRef.cellPtr.contents]; END; ExpandChild: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: REF CD.DrawInformation] -- CD.DrawProc -- = BEGIN IF aptr.ob.p.inDirectory AND CDEnvironment.Propagates[aptr.ob] THEN { <<--expand recursive>> aptr.ob.p.drawMe[aptr, pos, orient, pr] } ELSE { <<--make an application>> expandRef: REF ExpandRec = NARROW[pr.devicePrivate]; app: CD.ApplicationPtr = NEW[CD.Application_[ ob: aptr.ob, location: pos, orientation: orient, selected: FALSE, properties: CDProperties.CopyProps[aptr.properties] ]]; expandRef.cellPtr.contents _ CONS[app, expandRef.cellPtr.contents]; } END; ExpandContext: PROC [pr: CD.DrawRef, proc: CD.DrawContextLayerProc, ob: CD.ObPtr, pos: CD.DesignPosition, 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.ObPtr; changeEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$AfterChange]; ReplaceObject: PUBLIC PROC [design: CD.Design, old: CD.ObPtr, new: CD.ObPtr, off: CD.DesignPosition_[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.ObPtr, oldSize: CD.DesignPosition, baseOff: CD.DesignPosition_[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.p.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.ObPtr] RETURNS [quit: BOOL_FALSE] -- >> 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 app: CD.ApplicationPtr _ 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 app#NIL AND app.ob=rep.old THEN { realPos: CD.DesignPosition = CDOrient.MapPoint[ pointInCell: rep.off, cellSize: rep.oldSize, cellInstOrient: app.orientation, cellInstPos: app.location ]; fakePos: CD.DesignPosition = CDOrient.MapPoint[ pointInCell: [0, 0], cellSize: rep.newSize, cellInstOrient: app.orientation, cellInstPos: [0, 0] ]; app.location _ CDBasics.SubPoints[realPos, fakePos]; } ENDLOOP; [] _ CDCells.ReplaceDirectChildForDummyCells[plist.first.dummyCell.ob, repList]; ENDLOOP; END; PropagateChange: PUBLIC PROC [ob: CD.ObPtr, 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.