DIRECTORY CD, CDBasics, CDCells, CDDefaultProcs, CDDirectory, CDProperties, PWObjects, Rope; PWObjectsImpl: CEDAR PROGRAM IMPORTS CD, CDBasics, CDCells, CDDefaultProcs, CDDirectory, CDProperties, 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; }; 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]; objectClass.directoryProcs _ CDDirectory.InstallDirectoryProcs[objectClass, dp]; }; [] _ CDProperties.RegisterAndInstall[$PWObjectsAbutCache, [makeCopy: CDProperties.DontCopy], $PWObjects]; END. ـPWObjectsImpl.mesa Copyright c 1983, 1984, 1985 by Xerox Corporation. All rights reversed. Created by Bertrand Serlet, February 3, 1985 12:49:51 pm PST Last edited by Bertrand Serlet, March 25, 1986 11:28:20 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 Indirect Lazy Implementors goodie Initialization Abuts Accelerator (Cache mechanism for the expansion) ‌ت—کڑœ™Jڑœ دmœ=™HJڑœ<™