DIRECTORY CD, CDBasics, CDCells, CDDefaultProcs, CDDirectory, CDProperties, GList, HashTable, PWObjects, Rope; PWObjectsImpl: CEDAR PROGRAM IMPORTS CD, CDBasics, CDCells, CDDefaultProcs, CDDirectory, CDProperties, GList, HashTable, Rope EXPORTS PWObjects SHARES CDDirectory = BEGIN OPEN PWObjects; abutXClass: PUBLIC CD.ObjectClass _ RegisterClass[$AbutX, ExpandAbut, EnumerateChildObjectsAbut, ReplaceDirectChildsAbut]; abutYClass: PUBLIC CD.ObjectClass _ RegisterClass[$AbutY, ExpandAbut, EnumerateChildObjectsAbut, ReplaceDirectChildsAbut]; CreateNewAbutX: PUBLIC CreateAbutProc = { newAbut _ NEW [CD.ObjectRep _ [class: abutXClass, specificRef: subObjects]]; newAbut.size _ ExpandAbut[newAbut, NIL, NIL].new.size; }; CreateNewAbutY: PUBLIC CreateAbutProc = { newAbut _ NEW [CD.ObjectRep _ [class: abutYClass, specificRef: subObjects]]; newAbut.size _ ExpandAbut[newAbut, NIL, NIL].new.size; }; ExpandAbut: CDDirectory.ExpandProc = { pos: CD.Position _ [0, 0]; equivalentCell: CD.Object; IF into=NIL THEN { ref: REF _ CDProperties.GetObjectProp[me, $AbutCache]; IF ref#NIL THEN RETURN [NARROW [ref]]; }; equivalentCell _ CDCells.CreateEmptyCell[]; FOR list: LIST OF CD.Object _ GetAbutSubObjects[me], list.rest WHILE list#NIL DO [] _ CDCells.IncludeOb[design: NIL, cell: equivalentCell, ob: list.first, position: pos, cellCSystem: originCoords, obCSystem: interrestCoords, mode: dontPropagate]; SELECT me.class FROM abutXClass => pos.x _ pos.x + CDBasics.SizeOfRect[CD.InterestRect[list.first]].x; abutYClass => pos.y _ pos.y + CDBasics.SizeOfRect[CD.InterestRect[list.first]].y; ENDCASE => ERROR; ENDLOOP; [] _ CDCells.RepositionCell[equivalentCell, NIL]; IF into#NIL THEN [] _ CDDirectory.Include[into, equivalentCell, Rope.Cat[CDDirectory.Name[equivalentCell], "-AbutEquivalent"]] ELSE CDProperties.PutObjectProp[me, $AbutCache, equivalentCell]; RETURN [equivalentCell]; }; GetAbutSubObjects: PUBLIC PROC [abut: CD.Object] RETURNS [subObjects: LIST OF CD.Object] = { subObjects _ NARROW [abut.specificRef]; }; EnumerateChildObjectsAbut: CDDirectory.EnumerateChildObjectsProc -- [me: CD.Object, p: CDDirectory.EnumerateObjectsProc, x: REF ANY] -- = { ref: REF _ CDProperties.GetObjectProp[me, $AbutCache]; IF ref#NIL THEN p[NARROW [ref], x]; FOR w: LIST OF CD.Object _ GetAbutSubObjects[me], w.rest WHILE w#NIL DO p[w.first, x] ENDLOOP; }; ReplaceDirectChildsAbut: CDDirectory.ReplaceDChildsProc -- [me: CD.Object, design: CD.Design, replace: CDDirectory.ReplaceList] RETURNS [changed: BOOL _ FALSE] -- = BEGIN oldSize: CD.Position _ me.size; subObjects: LIST OF CD.Object _ GetAbutSubObjects[me]; FOR w: LIST OF CD.Object _ subObjects, w.rest WHILE w#NIL DO FOR l: CDDirectory.ReplaceList _ replace, l.rest WHILE l#NIL DO IF l.first.old=w.first THEN {changed _ TRUE; EXIT}; ENDLOOP; IF changed THEN EXIT; ENDLOOP; IF ~changed THEN RETURN; CDProperties.PutObjectProp[me, $AbutCache, NIL]; me.size _ CDDirectory.Expand[me, NIL, NIL].new.size; changed _ oldSize = me.size; CDDirectory.RepositionObject[design, me, oldSize]; END; GetLocationOfFirstInstance: PUBLIC PROC [abut: CD.Object] RETURNS [location: CD.Position _ [0, 0]] = { pos: CD.Position _ [0, 0]; FOR list: LIST OF CD.Object _ GetAbutSubObjects[abut], list.rest WHILE list#NIL DO ir: CD.Rect _ CD.InterestRect[list.first]; location _ CDBasics.MaxPoint[ location, CDBasics.SubPoints[CDBasics.BaseOfRect[ir], pos] ]; SELECT abut.class FROM abutXClass => pos.x _ pos.x + CDBasics.SizeOfRect[ir].x; abutYClass => pos.y _ pos.y + CDBasics.SizeOfRect[ir].y; ENDCASE => ERROR; ENDLOOP; }; routingClass: PUBLIC CD.ObjectClass _ RegisterClass[$Routing, ExpandRouting]; ExpandRouting: CDDirectory.ExpandProc = { routingSpecific: RoutingSpecific = NARROW [me.specificRef]; new _ CDCells.CreateEmptyCell[]; FOR i: NAT IN [0 .. routingSpecific.size) DO node: Node _ routingSpecific[i]; FOR j: NAT IN [0 .. node.size) DO instance: CD.Instance _ CDCells.IncludeOb[design: NIL, cell: new, ob: node[j].object, position: node[j].position, cellCSystem: originCoords, obCSystem: interrestCoords, mode: dontPropagate].newInst; CDProperties.CopyProps[node.properties, instance]; ENDLOOP; ENDLOOP; CDCells.SetInterestRect[new, routingSpecific.ir]; [] _ CDCells.RepositionCell[new, NIL]; }; CreateRouting: PUBLIC PROC [ir: CD.Rect, nodes: LIST OF Node] RETURNS [routing: CD.Object] = { size: NAT = NAT [GList.Length[nodes]]; routingSpecific: RoutingSpecific = NEW [RoutingRep[size]]; FOR i: NAT IN [0 .. size) DO routingSpecific[i] _ nodes.first; nodes _ nodes.rest ENDLOOP; routingSpecific.ir _ ir; routing _ NEW [CD.ObjectRep _ [class: routingClass, size: [0, 0], specificRef: routingSpecific]]; routing.size _ ExpandRouting[routing, NIL, NIL].new.size; }; CreateNode: PUBLIC PROC [geometry: LIST OF PlacedObject, properties: CD.PropList _ NIL] RETURNS [node: Node] = { size: NAT _ 0; FOR list: LIST OF PlacedObject _ geometry, list.rest WHILE list#NIL DO size _ size + 1 ENDLOOP; node _ NEW [NodeRep[size]]; node.properties _ properties; FOR i: NAT IN [0 .. size) DO node[i] _ geometry.first; geometry _ geometry.rest ENDLOOP; }; CreateNodes: PUBLIC PROC [table: HashTable.Table] RETURNS [nodes: LIST OF Node _ NIL] = { EachPair: HashTable.EachPairAction = { name: Rope.ROPE = NARROW [key]; geometry: REF LIST OF PlacedObject = NARROW [value]; node: Node = CreateNode[geometry^, LIST [[key: $InstanceName, val: name]]]; nodes _ CONS [node, nodes]; }; [] _ HashTable.Pairs[table, EachPair]; }; indirectClass: PUBLIC CD.ObjectClass _ RegisterClass[$Indirect, ExpandIndirect]; CreateIndirect: PUBLIC PROC [sourceObject: CD.Object] RETURNS [indirectObject: CD.Object] = { IF sourceObject=NIL THEN RETURN [NIL]; indirectObject _ NEW [CD.ObjectRep _ [class: indirectClass, size: sourceObject.size, specificRef: sourceObject]]; IF CDDirectory.Name[sourceObject]#NIL THEN NARROW [indirectObject.class.directoryProcs, REF CDDirectory.DirectoryProcs].setName[indirectObject, Rope.Cat["Indirect-", CDDirectory.Name[sourceObject]]]; }; ExpandIndirect: CDDirectory.ExpandProc = { object: CD.Object _ NARROW [me.specificRef]; RETURN [object]; }; lazyClass: PUBLIC CD.ObjectClass _ RegisterClass[$Lazy, ExpandLazy]; LazyData: TYPE = REF LazyDataRec; LazyDataRec: TYPE = RECORD [info: REF, createProc: REF CreateProc]; CreateLazy: PUBLIC PROC [info: REF, createProc: CreateProc] RETURNS [newLazy: CD.Object] = { newLazy _ NEW [CD.ObjectRep _ [class: lazyClass, specificRef: NEW [LazyDataRec _ [info: info, createProc: NEW [CreateProc _ createProc]]]]]; newLazy.size _ ExpandLazy[newLazy, NIL, NIL].new.size; }; ExpandLazy: CDDirectory.ExpandProc = { lazyData: LazyData _ NARROW [me.specificRef]; expandedObj: CD.Object _ lazyData.createProc[lazyData.info]; IF into#NIL THEN [] _ CDDirectory.Include[into, expandedObj, Rope.Cat[CDDirectory.Name[expandedObj], "-LazyEquivalent"]]; RETURN [expandedObj]; }; RegisterClass: PUBLIC PROC [objectType: ATOM, expand: CDDirectory.ExpandProc, enumerateChildObjects: CDDirectory.EnumerateChildObjectsProc _ NIL, replaceDirectChilds: CDDirectory.ReplaceDChildsProc _ NIL] RETURNS [objectClass: CD.ObjectClass] = { dp: CDDirectory.DirectoryProcs _ [expand: expand]; objectClassRec: CD.ObjectClassRec _ []; objectClassRec.showMeSelected _ CDDefaultProcs.ShowMeSelectedWithExpand; objectClassRec.interestRect _ CDDefaultProcs.InterestRectWithExpand; objectClassRec.directoryProcs _ NIL; objectClassRec.inDirectory _ FALSE; IF enumerateChildObjects#NIL THEN dp.enumerateChildObjects _ enumerateChildObjects; IF replaceDirectChilds#NIL THEN dp.replaceDirectChilds _ replaceDirectChilds; objectClass _ CD.RegisterObjectClass[objectType, objectClassRec ! CD.Error => CONTINUE]; IF objectClass=NIL THEN objectClass _ CD.FetchObjectClass[objectType]; objectClass.directoryProcs _ CDDirectory.InstallDirectoryProcs[objectClass, dp ! CD.Error => CONTINUE]; }; [] _ CDProperties.RegisterAndInstall[$PWObjectsAbutCache, [makeCopy: CDProperties.DontCopy], $PWObjects]; END. $PWObjectsImpl.mesa Copyright c 1984, 1985, 1986 by Xerox Corporation. All rights reversed. Created by Bertrand Serlet, February 3, 1985 12:49:51 pm PST Last edited by Bertrand Serlet, December 7, 1986 10:13:27 pm PST Abuts Abut classes Creating a new Abut object. Expanding Abuts into cells Takes an abut and returns the cell which is equivalent to this abut. Cell resulting always belongs to the from design if me belongs to the from design. It is included in the to design if to#NIL Getting subobjects from an Abut. NARROW error if not an Abut DirectoryProcs applicable to Abuts For solving coordinate system problems Routing Cells Indirect In the future, add an IR proc, and maybe a Draw Proc? Lazy Implementors goodie Initialization Abuts Accelerator (Cache mechanism for the expansion) ‌ت عکڑœ™Jڑœ دmœ=™HJڑœ<™