
<<PWObjectsImpl.mesa>>
<<Copyright © 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 >>

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;
<<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;
};
<<Routing Cells>>
    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];
        };
<<Indirect>>
indirectClass: PUBLIC CD.ObjectClass _ RegisterClass[$Indirect, ExpandIndirect];
<<In the future, add an IR proc, and maybe a Draw Proc?>>

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];
        IF objectClass=NIL THEN objectClass _ CD.FetchObjectClass[objectType];
        objectClass.directoryProcs _ CDDirectory.InstallDirectoryProcs[objectClass, dp ! CD.Error => CONTINUE];
        };
<<Initialization>>
<<Abuts Accelerator (Cache mechanism for the expansion)>>
[] _ CDProperties.RegisterAndInstall[$PWObjectsAbutCache, [makeCopy: CDProperties.DontCopy], $PWObjects];

END.