PWObjectsImpl.mesa
Copyright © 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
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;
Abuts
Abut classes
abutXClass: PUBLIC CD.ObjectClass ← RegisterClass[$AbutX, ExpandAbut, EnumerateChildObjectsAbut, ReplaceDirectChildsAbut];
abutYClass: PUBLIC CD.ObjectClass ← RegisterClass[$AbutY, ExpandAbut, EnumerateChildObjectsAbut, ReplaceDirectChildsAbut];
Creating a new Abut object.
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;
};
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
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];
};
Getting subobjects from an Abut.
NARROW error if not an Abut
GetAbutSubObjects: PUBLIC PROC [abut: CD.Object] RETURNS [subObjects: LIST OF CD.Object] = {
subObjects ← NARROW [abut.specificRef];
};
DirectoryProcs applicable to Abuts
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;
For solving coordinate system problems
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;
};
Indirect
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];
};
Lazy
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];
};
Implementors goodie
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];
};
Initialization
Abuts Accelerator (Cache mechanism for the expansion)
[] ← CDProperties.RegisterAndInstall[$PWObjectsAbutCache, [makeCopy: CDProperties.DontCopy], $PWObjects];
END.