DIRECTORY CD, CDCallSpecific, CDDirectory, CDInline, CDOrient, CDProperties, CDValue, IO, Rope, SymTab, TerminalIO; CDDirectoryImpl: CEDAR MONITOR IMPORTS CD, CDDirectory, CDInline, CDOrient, CDProperties, CDValue, IO, Rope, SymTab, TerminalIO EXPORTS CDDirectory SHARES CD = BEGIN 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] = 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] = 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]; } } END; SetName: PROC[me: CD.ObPtr, r: Rope.ROPE] ~ INLINE { IF me.p.hasChildren 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] = BEGIN name: Rope.ROPE _ CDDirectory.Name[object]; IF CDProperties.GetPropFromObject[from: object, prop: ownerKey]#NIL THEN ERROR CD.Error[callingError, "Included object already in a design"]; IF alternateName#NIL THEN name _ alternateName; IF name=NIL THEN name _ "-noname-"; DO IF SymTab.Insert[design.cellDirectory, name, object] THEN { SetName[object, name]; CDProperties.PutPropOnObject[onto: object, prop: ownerKey, val: design]; done _ TRUE; RETURN }; IF object = Fetch[design, name].object THEN { TerminalIO.WriteRope["object included twice in directory; debugging chipndale might be appropriate\n"]; }; IF NOT fiddleName THEN { done _ FALSE; RETURN }; name _ Rope.Concat[name, IO.PutFR[format: "@%g", v1: IO.int[LOOPHOLE[object, INT]/4 MOD 991]]] ENDLOOP; END; Rename: PUBLIC PROC [design: CD.Design, object: CD.ObPtr, newName: Rope.ROPE _ NIL] 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, FALSE]; 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] = 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.hasChildren THEN ERROR CD.Error[ec: doubleRegistration, explanation: "object type includes already directory"]; type.directoryProcs _ dp; type.hasChildren _ TRUE; dp.adjustItself _ DefaultAdjustItself; dp.repositionElements _ DefaultRepositionElements; dp.computeBounds _ DefaultComputeBounds; dp.enumerateChildObjects _ DefaultEnumerate; dp.key _ DefaultKey; dp.name _ DefaultName; dp.setName _ DefaultSetName; dp.setKey _ DefaultSetName; RETURN [dp] END; DefaultAdjustItself: CDDirectory.AdjustItselfProc -- PROC [objToReposition: CD.ObPtr, newBound: CD.DesignRect] -- = BEGIN END; DefaultRepositionElements: CDDirectory.RepositionElementsProc -- PROC [me: CD.ObPtr, objToReposition: CD.ObPtr, oldSize: CD.DesignPosition, newBound: CD.DesignRect, design: CD.Design] -- = BEGIN END; DefaultComputeBounds: PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] = BEGIN RETURN [CDInline.RectAt[[0,0], ob.size]] END; DefaultEnumerate: PROC [me: CD.ObPtr, p: CDDirectory.EnumerateObjectsProc, x: REF] = BEGIN END; DefaultSetName: PROC [me: CD.ObPtr, r: Rope.ROPE] = BEGIN END; DefaultName: PROC [me: CD.ObPtr] RETURNS [Rope.ROPE] = BEGIN RETURN [" no name"] END; DefaultKey: PROC [me: CD.ObPtr] RETURNS [Rope.ROPE] = BEGIN RETURN [NIL] END; -- -- -- -- -- -- -- -- -- -- -- -- ComputedBounds: PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] = INLINE BEGIN RETURN [ IF ob.p.hasChildren THEN CDDirectory.ObToDirectoryProcs[ob].computeBounds[ob] ELSE DefaultComputeBounds[ob] ] END; RepositionList: TYPE = LIST OF CD.ObPtr; RepositionAnObject: PUBLIC PROC [design: CD.Design, objToReposition: CD.ObPtr] = BEGIN IF CDProperties.GetPropFromObject[from: objToReposition, prop: ownerKey]#design THEN ERROR CD.Error[callingError, "object not in design"]; IF design=NIL THEN RepositionObjectOnDesign[NIL, objToReposition] ELSE { x: REF _ CDValue.Fetch[boundTo: design, key: $RepositioningList, propagation: design]; ref: REF RepositionList; IF x#NIL THEN { -- we are inside reposition process, remember object ref _ NARROW[x]; FOR l: RepositionList _ ref^, l.rest DO IF l.first=objToReposition THEN EXIT; IF l.rest=NIL THEN {l.rest _ LIST[objToReposition]; EXIT} ENDLOOP; RETURN }; ref _ NEW[RepositionList_LIST[objToReposition]]; CDValue.Store[boundTo: design, key: $RepositioningList, value: ref]; WHILE ref^#NIL DO RepositionObjectOnDesign[design, ref^.first]; ref^ _ ref^.rest ENDLOOP; CDValue.Store[boundTo: design, key: $RepositioningList, value: NIL]; }; END; RepositionObjectOnDesign: PROC [design: CD.Design, objToReposition: CD.ObPtr] = BEGIN oldSize: CD.DesignPosition = objToReposition.size; newBound: CD.DesignRect _ ComputedBounds[objToReposition]; AdjustItself: PROC [objToReposition: CD.ObPtr, newBound: CD.DesignRect] = INLINE BEGIN IF objToReposition.p.hasChildren THEN { objToReposition.size _ CDInline.SizeOfRect[newBound]; CDDirectory.ObToDirectoryProcs[objToReposition].adjustItself[objToReposition, newBound]; }; END; EachEntryReposition: SymTab.EachPairAction --[key: Key, val: Val] RETURNS [quit: BOOLEAN] -- = BEGIN ob: CD.ObPtr = NARROW[val]; quit _ FALSE; IF ob#objToReposition THEN -- this one is already in progress! IF ob.p.hasChildren THEN CDDirectory.ObToDirectoryProcs[ob].repositionElements[ob, objToReposition, oldSize, newBound, design] END; RepositionAllOthers: PROC [] = INLINE BEGIN FOR l: LIST OF CD.PushRec _ design.actual, l.rest WHILE l#NIL DO RepositionApplicationList[l.first.specific.contents]; RepositionApplication[l.first.mightReplace] ENDLOOP; IF SymTab.Pairs[design.cellDirectory, EachEntryReposition] THEN ERROR; END; RepositionApplicationList: PROC [list: CD.ApplicationList] = INLINE BEGIN FOR w: CD.ApplicationList _ list, w.rest WHILE w#NIL DO --IF w.first.ob=objToReposition THEN-- RepositionApplication[w.first]; ENDLOOP; END; RepositionApplication: PROC [aptr: CD.ApplicationPtr] = INLINE BEGIN IF aptr#NIL AND aptr.ob=objToReposition THEN BEGIN aptr.location _ CDOrient.MapPosition[ itemInCell: newBound, cellSize: oldSize, cellInstOrient: aptr.orientation, cellInstPos: aptr.location]; END END; IF CDInline.RectAt[[0, 0], oldSize] # newBound THEN { IF design#NIL THEN RepositionAllOthers[]; AdjustItself[objToReposition, newBound]; }; END; ownerKey: ATOM ~ $Owner; [] _ CDProperties.RegisterProperty[ownerKey]; END. ZCDDirectoryImpl.mesa (part of Chipndale) by Christian Jacobi June 24, 1983 5:00 pm last edited Christian Jacobi February 16, 1984 12:44 pm --all object which contain other objects are supposed to be in the directory; --which is necessary for enumeration and for repositioning --search for object in directory --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 --it is an ERROR to include an object into several design's --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 --returns bounds in coordinate system of ob itself --returns bounds in coordinate system of ob itself --objToReposition.size must be old, not yet repositioned size; --(the actual reposition process may bepostboned until an started --reposition is finished; the started reposition should not be interferred --with objToReposition changing size.) --the size will be recomputed and corrected before return -- we are not inside reposition process, start one --this procedure called from RepositionAnObject only --objToReposition must have old, uncorrected size --newBound is expected to be in coordinate system of objToReposition itself --uses global "parameters": oldSize, newBound, objToReposition, design --relative globals used: oldSize, newBound, objToReposition, design --reposition all of the actual design --reposition all cells --which may cause a Reposition of the some other cells recursively --the recursion stops iff the data structures do not contain recursive cells --repositions all applications which call objToReposition --oldSize: size of the original rePositionList.first --objToReposition object needing reposition --newBound: bound of new objToReposition in coords of old rePositionList.first --(oldSize, newBound used by dynamic inner proc) --objToReposition.size is NOT used --repositions an application if it calls objToReposition --oldSize: size of the original objToReposition --objToReposition object needing reposition --newBound: bound of new objToReposition in coords of old objToReposition -- RepositionObjectOnDesign Ê ?˜Jšœ*™*Jšœ,™,Jšœ9™9J˜šÏk ˜ Jšœ˜J˜J˜ J˜ J˜ J˜ J˜Jšœ˜Jšœ˜Jšœ˜Jšœ ˜ J˜—šÏbœœœ˜Jšœœ:œ˜`Jšœ ˜Jšœœ˜ —Jš˜J˜J™MJ™:J˜J˜JšÏnœœœ œœœœ˜Sš Ÿœœœ œœ˜8Jšœ œ œœ˜-Jšœ ™ Jš˜J˜J˜6Jšœœ œœ˜+Jšœ˜—J™šŸœ œ œœœœœ œ˜qJšœF™FJ™SJ™-Jš˜Jšœœ˜Jšœœ˜ Jšœ&˜&šœœ˜šœœœœ˜1šœE˜KJšœœ5˜=—Jšœ1˜1JšœœAœ˜RJ˜—Jšœ˜—Jšœ˜—š Ÿœœœœœ˜4Jšœœ2˜JJ˜J˜—š Ÿœœœ œœ˜;Jš œœœœœœœ˜KJšœ;™;Jš˜Jšœ œ˜+šœ>œ˜HJšœœ<˜D—Jšœœœ˜/Jšœœœ˜#š˜šœ3œ˜;Jšœ˜JšœH˜HJšœœ˜ Jš˜Jšœ˜—šœ%œ˜-J˜gJ˜—šœœ œ˜Jšœœ˜Jš˜Jšœ˜—šœ˜Jš œœœ œœ˜E—Jšœ˜—Jšœ˜—š Ÿœœœ œœ˜:Jš œœœœœœ˜8Jš˜Jšœœ˜.Jšœ œ#˜0šœ œ˜Jšœœ$œ˜5Jšœœœœ˜"Jšœ(œ˜.Jš œœœœœ4˜MJ˜—Jšœ˜—š Ÿ œœœ œ"œœ˜ZJšœ@™@JšœD™DJšœL™LJšœ0™0Jš˜šžœ˜)Jšœœœ˜3Jšœ˜—Jšœ9˜9Jšœ˜J˜—š Ÿœœœœœœ˜hJš˜Jšœœœ˜Ešœœœ˜4JšœœV˜^—Jšœ˜Jšœ˜Jšœ&˜&Jšœ2˜2Jšœ(˜(Jšœ,˜,Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜ Jšœ˜—J˜šžœ˜2JšÏc?œ˜AJš˜Jšœ˜—J˜šžœ$˜=Jš |œ˜Jš˜Jšœ˜—J˜š Ÿœœœœœ˜CJšœ2™2Jš˜Jšœ"˜(Jšœ˜—J˜šŸœœœ0œ˜UJš˜Jšœ˜—J˜šŸœœœœ˜3Jš˜Jšœ˜—J˜š Ÿ œœœœœ˜6Jš˜Jšœ ˜Jšœ˜—J˜š Ÿ œœœœœ˜5Jš˜Jšœœ˜ Jšœ˜—J˜JšŸ#˜#J˜š Ÿœœœœœ˜DJšœ3™3Jš˜šœ˜Jšœœ5˜MJšœ˜J˜—Jšœ˜—J™Jš œœœœœ˜)š Ÿœœœ œœ ˜PJšœ=Ÿ™>Jšœ³™³J™9Jšœ˜šœN˜TJšœœ-˜5—Jšœœœœ˜Ašœ˜JšœœP˜VJšœœ˜šœœœ 4˜EJšœœ˜šœ"˜'Jšœœœ˜%Jš œœœ œœ˜9Jšœ˜—Jš˜J˜—Jšœ2™2Jšœœœ˜0JšœD˜Dšœœ˜Jšœ-˜-Jšœ˜Jšœ˜—Jšœ?œ˜DJ˜—Jšœ˜J˜—šŸœœ œœ ˜OJšœ4™4Jšœ1™1Jš˜Jšœ œ'˜2Jšœ œ.˜:J˜š Ÿ œœœœ˜PJšœK™KJš˜šœœ˜'J˜5JšœX˜XJ˜—Jšœ˜J˜—šžœ˜+Jš 1œ˜3JšœF™FJš˜Jšœœ œ˜Jšœœ˜ šœœ #˜>šœœ˜Jšœe˜e——Jšœ˜J˜—šŸœœ˜%JšœC™CJš˜Jšœ%™%š œœœœ!œœ˜@J˜5J˜+Jšœ˜—Jšœ™JšœB™BJšœL™LJšœ9œœ˜FJšœ˜—J˜šŸœœœ˜CJšœ9™9Jšœ5™5Jšœ+™+JšœN™NJšœ0™0Jšœ"™"Jš˜š œœ œœ˜7Jš &œ ˜FJšœ˜—Jšœ˜J˜—šŸœœœ˜7Jšœ8™8Jšœ0™0Jšœ+™+JšœI™IJšœ˜ šœœœ˜,Jš˜šœ%˜%Jšœ˜Jšœ˜J˜!J˜—Jš˜—Jšœ˜—J˜Jšœ™šœ-œ˜5Jšœœœ˜)Jšœ(˜(J˜—Jšœ˜—J˜Jšœ œ ˜Jšœ-˜-Jšœ˜J˜—…—à1y