[Cyan]<DATools6.0>PW22>PWObjectsImpl.mesa!1

PWObjectsImpl.mesa

Created by Bertrand Serlet, February 3, 1985 12:49:51 pm PST

Last edited by Bertrand Serlet, November 8, 1985 11:34:29 am 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 REF CD.ObjectClass ← RegisterClass[$AbutX, ExpandAbut, EnumerateChildObjectsAbut, ReplaceDirectChildsAbut];

abutYClass: PUBLIC REF 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].size;

};

CreateNewAbutY: PUBLIC CreateAbutProc = {

newAbut ← NEW [CD.ObjectRep ← [class: abutYClass, specificRef: subObjects]];

newAbut.size ← ExpandAbut[newAbut, NIL, NIL].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.AnotherProc -- [me: CD.Object, from: CD.Design, to: CD.Design] RETURNS [CD.Object] -- = {

pos: CD.Position ← [0, 0];

equivalentCell: CD.Object;

IF to=NIL THEN {

ref: REF ← CDProperties.GetPropFromObject[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 to#NIL

THEN [] ← CDDirectory.Include[to, equivalentCell, Rope.Cat[CDDirectory.Name[equivalentCell], "-AbutEquivalent"]]

ELSE CDProperties.PutPropOnObject[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.GetPropFromObject[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.PutPropOnObject[me, $AbutCache, NIL];

me.size ← CDDirectory.Expand[me, NIL, NIL].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 REF 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.AnotherProc -- [me: CD.Object, from: CD.Design, to: CD.Design] RETURNS [CD.Object] -- = {

object: CD.Object ← NARROW [me.specificRef];

RETURN [object];

};

Lazy

lazyClass: PUBLIC REF 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].size;

};

ExpandLazy: CDDirectory.AnotherProc -- [me: CD.Object, from: CD.Design, to: CD.Design] RETURNS [CD.Object] -- = {

lazyData: LazyData ← NARROW [me.specificRef];

expandedObj: CD.Object ← lazyData.createProc[lazyData.info];

IF to#NIL

THEN [] ← CDDirectory.Include[to, expandedObj, Rope.Cat[CDDirectory.Name[expandedObj], "-LazyEquivalent"]];

RETURN [expandedObj];

};

Implementors goodie

RegisterClass: PUBLIC PROC [objectType: ATOM, expand: CDDirectory.AnotherProc, enumerateChildObjects: CDDirectory.EnumerateChildObjectsProc ← NIL, replaceDirectChilds: CDDirectory.ReplaceDChildsProc ← NIL] RETURNS [objectClass: REF CD.ObjectClass] = {

dp: REF CDDirectory.DirectoryProcs;

objectClass ← CD.FetchObjectClass[objectType];

IF objectClass=NIL THEN objectClass ← CD.RegisterObjectClass[objectType];

objectClass.showMeSelected ← CDDefaultProcs.ShowMeSelectedWithExpand;

objectClass.interestRect ← CDDefaultProcs.InterestRectWithExpand;

objectClass.directoryProcs ← NIL; objectClass.inDirectory ← FALSE;

dp ← CDDirectory.InstallDirectoryProcs[objectClass];

IF enumerateChildObjects#NIL THEN dp.enumerateChildObjects ← enumerateChildObjects;

IF replaceDirectChilds#NIL THEN dp.replaceDirectChilds ← replaceDirectChilds;

dp.expand ← expand;

};

Initialization

Abuts Accelerator (Cache mechanism for the expansion)

[] ← CDProperties.RegisterAndInstall[$PWObjectsAbutCache, [makeCopy: CDProperties.DontCopy], $PWObjects];

[] ← CDProperties.RegisterProperty[$PWObjectsAbutCache, $PWObjects];

CDProperties.InstallProcs[$PWObjectsAbutCache, [makeCopy: CDProperties.DontCopy]];

END.