
<<PWImpl.mesa>>
<<Copyright Ó 1985, 1987 by Xerox Corporation.  All rights reserved.>>
<<Created by: Monier, June 24, 1985 4:30:52 pm PDT>>
    <<Louis Monier August 22, 1985 12:39:11 pm PDT>>
    <<Bertrand Serlet April 24, 1988 10:49:33 pm PDT>>
    <<Don Curry September 11, 1987 6:53:38 pm PDT>>
    <<Jean-Marc Frailong November 3, 1987 2:29:38 pm PST>>

DIRECTORY
Ascii, BasicTime,
CD, CDBasics, CDCells, CDCommandOps, CDDebug, CDDefaultProcs, CDDirectory, CDEnvironment, CDEvents, CDGenerate, CDInstances, CDIO, 
CDOps, CDOpsExtras, CDPrivate, CDProperties, CDSequencer,
GList, IO,
PW,
RefTab, Rope, RopeList,
TerminalIO, TokenIO;

PWImpl: CEDAR PROGRAM
IMPORTS Ascii, BasicTime, CD, CDBasics, CDCells, CDCommandOps, CDDebug, CDDefaultProcs, CDDirectory, CDEnvironment, CDEvents, 
CDGenerate, CDInstances, CDIO, CDOps, CDOpsExtras, CDPrivate, CDProperties, CDSequencer, GList, IO, RefTab, Rope, RopeList, 
TerminalIO, TokenIO
EXPORTS PW
SHARES CDDirectory =
BEGIN OPEN PW;
<<Abuts>>
abutXClass: PUBLIC CD.ObjectClass _ CD.RegisterObjectClass[$AbutX, [
    quickDrawMe: QuickDrawAbut,
    drawMe: DrawAbut,
    internalRead: ReadAbutX,
    internalWrite: WriteAbut,
interestRect: AbutInterestRect
]];
<<>>
abutYClass: PUBLIC CD.ObjectClass _ CD.RegisterObjectClass[$AbutY, [
    quickDrawMe: QuickDrawAbut,
    drawMe: DrawAbut,
    internalRead: ReadAbutY,
    internalWrite: WriteAbut,
interestRect: AbutInterestRect
]];

AbutSpecific: TYPE = REF AbutSpecificRec;
AbutSpecificRec: TYPE = RECORD [
ir: CD.Rect,         -- for algorithmic efficiency
subObjects: SEQUENCE size: NAT OF CD.Object
];

CreateNewAbutX: PUBLIC CreateAbutProc = {
abutSpecific: AbutSpecific _ NEW [AbutSpecificRec[GList.Length[subObjects]]];
new: CD.Object;
FOR i: NAT IN [0 .. abutSpecific.size) DO
abutSpecific[i] _ subObjects.first; subObjects _ subObjects.rest;
ENDLOOP;
IF abutSpecific.size#0 THEN {
iry: INT = CD.InterestSize[abutSpecific[0]].y;
FOR i: NAT IN [1 .. abutSpecific.size) DO
IF CD.InterestSize[abutSpecific[i]].y#iry THEN ERROR; -- incompatible y dimension for an abutX
ENDLOOP;
};
newAbut _ NEW [CD.ObjectRep _ [class: abutXClass, specific: abutSpecific, properties: props]];
new _ ExpandAbut[newAbut].new;
newAbut.bbox _ new.bbox;
abutSpecific.ir _ CD.InterestRect[new];
SetName[newAbut, name];
};

CreateNewAbutY: PUBLIC CreateAbutProc = {
abutSpecific: AbutSpecific _ NEW [AbutSpecificRec[GList.Length[subObjects]]];
new: CD.Object;
FOR i: NAT IN [0 .. abutSpecific.size) DO
abutSpecific[i] _ subObjects.first; subObjects _ subObjects.rest;
ENDLOOP;
IF abutSpecific.size#0 THEN {
irx: INT = CD.InterestSize[abutSpecific[0]].x;
FOR i: NAT IN [1 .. abutSpecific.size) DO
IF CD.InterestSize[abutSpecific[i]].x#irx THEN ERROR; -- incompatible x dimension for an abutY
ENDLOOP;
};
newAbut _ NEW [CD.ObjectRep _ [class: abutYClass, specific: abutSpecific, properties: props]];
new _ ExpandAbut[newAbut].new;
newAbut.bbox _ new.bbox;
abutSpecific.ir _ CD.InterestRect[new];
SetName[newAbut, name];
};

    EnumerateSubObjects: PUBLIC PROC [abut: CD.Object, eachSubObject: EachSubObjectProc] RETURNS [quit: BOOL _ FALSE] = {
    abutSpecific: AbutSpecific = NARROW [abut.specific];
        pos: CD.Position _ [0, 0];
    FOR i: NAT IN [0 .. abutSpecific.size) DO
    quit _ eachSubObject[abutSpecific[i], pos];
    IF quit THEN RETURN;
    SELECT abut.class FROM
    abutXClass     => pos.x _ pos.x + CD.InterestSize[abutSpecific[i]].x;
    abutYClass     => pos.y _ pos.y + CD.InterestSize[abutSpecific[i]].y;
    ENDCASE     => ERROR;
    ENDLOOP;
        };

    CountSubObjects: PUBLIC PROC [abut: CD.Object] RETURNS [size: NAT] = {
    abutSpecific: AbutSpecific = NARROW [abut.specific];
    size _ abutSpecific.size;
    };

<<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 = {
    EachSubObject: EachSubObjectProc = {
        instances _ CONS [CDInstances.NewInst[subObject, [CDBasics.SubPoints[pos, CD.InterestBase[subObject]]]], instances];
        };
    instances: LIST OF CD.Instance;
[] _ EnumerateSubObjects[me, EachSubObject];
new _ CreateCell[instances: instances, name: Name[me]]; 
IF into#NIL THEN [] _ CDDirectory.Include[into, new, Name[me]];
};

    DrawAbut: CD.DrawProc ~ {
        mapClip: CD.Rect _ CDBasics.DeMapRect[pr.interestClip, trans].itemInCell; 
            <<clipping boundary in object coordinates>>
        EachSubObject: EachSubObjectProc ~ {
            pos _ CDBasics.SubPoints[pos, CD.InterestBase[subObject]];
            IF CDBasics.Intersect[mapClip, CDBasics.MoveRect[subObject.bbox, pos]]
                THEN pr.drawChild[pr, subObject, [off: CDBasics.MapPoint[pos, trans], orient: trans.orient]];
            quit _ pr.stopFlag^;
            };
    [] _ EnumerateSubObjects[ob, EachSubObject];
        };

    abutSimplification: REAL _ 100.0; -- average size below which things get simplified

    QuickDrawAbut: CD.DrawProc ~ {
        mapClip: CD.Rect _ CDBasics.DeMapRect[pr.interestClip, trans].itemInCell; 
            <<clipping boundary in object coordinates>>
        EachSubObject: EachSubObjectProc ~ {
            pos _ CDBasics.SubPoints[pos, CD.InterestBase[subObject]];
            IF CDBasics.Intersect[mapClip, CDBasics.MoveRect[subObject.bbox, pos]]
                THEN subObject.class.quickDrawMe[pr, subObject, [off: CDBasics.MapPoint[pos, trans], orient: trans.orient]];
            quit _ pr.stopFlag^;
            };
        IF DrawObjectOutline[pr, ob, trans, abutSimplification] THEN RETURN; -- object outlined
    [] _ EnumerateSubObjects[ob, EachSubObject];
        };

EnumerateChildObjectsAbut: CDDirectory.EnumerateChildObjectsProc = {
    EachSubObject: EachSubObjectProc = {quit _ proc[subObject, data]};
quit _ EnumerateSubObjects[me, EachSubObject];
};

ReplaceDirectChildsAbut: CDDirectory.ReplaceDChildsProc = {
bbox: CD.Rect _ me.bbox;
abutSpecific: AbutSpecific = NARROW [me.specific];
FOR i: NAT IN [0 .. abutSpecific.size) DO
element: CD.Object = abutSpecific[i];
FOR l: CDDirectory.ReplaceList _ replace, l.rest WHILE l#NIL DO
IF l.first.old=element THEN {
IF l.first.trans#[] THEN ERROR;
IF (IF me.class=abutXClass THEN CD.InterestSize[element].y#CD.InterestSize[l.first.new].y ELSE 
CD.InterestSize[element].x#CD.InterestSize[l.first.new].x) THEN ERROR;
changed _ TRUE;
abutSpecific[i] _ l.first.new;
};
ENDLOOP;
ENDLOOP;
IF NOT changed THEN RETURN;
me.bbox _ ExpandAbut[me].new.bbox;
changed _ bbox = me.bbox;
CDDirectory.PropagateResize[design, me];
};

AbutInterestRect: CD.RectProc = {
abutSpecific: AbutSpecific = NARROW [ob.specific];
RETURN [abutSpecific.ir];
};

    WriteAbut: CD.InternalWriteProc = {
    data: AbutSpecific = NARROW [ob.specific];
        CDIO.WriteRect[h, ob.bbox]; 
        TokenIO.WriteInt[h, data.size];
        CDIO.WriteRect[h, data.ir]; 
        FOR x: NAT IN [0 .. data.size) DO CDIO.WriteObject[h, data[x]] ENDLOOP;
        };

    ReadAbutX: CD.InternalReadProc = {
        bbox: CD.Rect _ CDIO.ReadRect[h]; 
        size: NAT _ TokenIO.ReadInt[h];
        data: AbutSpecific _ NEW [AbutSpecificRec[size]];
        ob: CD.Object _ NEW [CD.ObjectRep _ [class: abutXClass, specific: data, bbox: bbox]];
        data.ir _ CDIO.ReadRect[h];
        FOR x: NAT IN [0 .. size) DO data[x] _ CDIO.ReadObject[h] ENDLOOP;
        RETURN [ob];
        };

    ReadAbutY: CD.InternalReadProc = {
        bbox: CD.Rect _ CDIO.ReadRect[h]; 
        size: NAT _ TokenIO.ReadInt[h];
        data: AbutSpecific _ NEW [AbutSpecificRec[size]];
        ob: CD.Object _ NEW [CD.ObjectRep _ [class: abutYClass, specific: data, bbox: bbox]];
        data.ir _ CDIO.ReadRect[h];
        FOR x: NAT IN [0 .. size) DO data[x] _ CDIO.ReadObject[h] ENDLOOP;
        RETURN [ob];
        };
<<Abuts: Sugared>>
AbutX: PUBLIC PROC [t1, t2, t3, t4, t5, t6: CD.Object _ NIL] RETURNS [obj: CD.Object] = {
RETURN [AbutListX[LIST[t1, t2, t3, t4, t5, t6]]];
};

AbutY: PUBLIC PROC [t1, t2, t3, t4, t5, t6: CD.Object _ NIL] RETURNS [obj: CD.Object] = {
RETURN [AbutListY[LIST[t1, t2, t3, t4, t5, t6]]];
};

AbutListX: PUBLIC PROC [objects: LIST OF CD.Object, name: Rope.ROPE _ NIL, props: CD.PropList _ NIL] RETURNS [obj: CD.Object] = {
newObjects: LIST OF CD.Object _ NIL;
WHILE objects#NIL DO
IF objects.first#NIL THEN newObjects _ CONS [objects.first, newObjects];
objects _ objects.rest;
ENDLOOP;
IF newObjects=NIL THEN RETURN [NIL];
obj _ CreateNewAbutX[NARROW [GList.Reverse[newObjects]], name, props];
};

AbutListY: PUBLIC PROC [objects: LIST OF CD.Object, name: Rope.ROPE _ NIL, props: CD.PropList _ NIL] RETURNS [obj: CD.Object] = {
newObjects: LIST OF CD.Object _ NIL;
WHILE objects#NIL DO
IF objects.first#NIL THEN newObjects _ CONS [objects.first, newObjects];
objects _ objects.rest;
ENDLOOP;
IF newObjects=NIL THEN RETURN [NIL];
obj _ CreateNewAbutY[NARROW [GList.Reverse[newObjects]], name, props];
};

MapFunction: PUBLIC PROC [function: PROC [INT, INT] RETURNS [CD.Object], lx: INT _ 0, ux: INT, ly: INT _ 0, uy: INT] RETURNS 
[CD.Object] = {
rows: LIST OF CD.Object _ NIL;
FOR y: INT DECREASING IN [ly .. uy) DO
row: LIST OF CD.Object _ NIL;
FOR x: INT DECREASING IN [lx .. ux) DO row _ CONS [function[x, y], row] ENDLOOP;
rows _ CONS [AbutListX[row], rows];
ENDLOOP;
RETURN [AbutListY[rows]];
};

ArrayX: PUBLIC PROC [obj: CD.Object, nx: INT _ 1] RETURNS [CD.Object] = {
row: LIST OF CD.Object _ NIL;
FOR x: INT IN [0 .. nx) DO row _ CONS [obj, row] ENDLOOP;
RETURN [AbutListX[row]];
};

ArrayY: PUBLIC PROC [obj: CD.Object, ny: INT _ 1] RETURNS [CD.Object] = {
row: LIST OF CD.Object _ NIL;
FOR x: INT IN [0 .. ny) DO row _ CONS [obj, row] ENDLOOP;
RETURN [AbutListY[row]];
};

Array: PUBLIC PROC [obj: CD.Object, nx, ny: INT _ 1] RETURNS [new: CD.Object] = {
RETURN [ArrayY[ArrayX[obj, nx], ny]];
};
<<Rotations>>
rotationClass: PUBLIC CD.ObjectClass _ RegisterClass[objectType: $Rotation, expand: ExpandRotation, enumerateChildObjects: 
EnumerateChildObjectsRotation, replaceDirectChilds: ReplaceDirectChildsRotation, interestRect: RotationInterestRect];

CreateRotation: PUBLIC PROC [obj: CD.Object, orientation: CD.Orientation, name: Rope.ROPE _ NIL, props: CD.PropList _ NIL] RETURNS 
[rotation: CD.Object] = {
trans: CD.Transformation = [[0, 0], orientation];
IF obj=NIL THEN RETURN [NIL];
rotation _ NEW [CD.ObjectRep _ [
class: rotationClass, 
bbox: CDBasics.MapRect[obj.bbox, trans], 
specific: NEW [RotationSpecificRec _ [ir: CDBasics.MapRect[CD.InterestRect[obj], trans], obj: obj, orientation: orientation]],
properties: props
]];
SetName[rotation, name];
};

ExpandRotation: CDDirectory.ExpandProc = {
specific: RotationSpecific _ NARROW [me.specific];
new _ CreateCell[
instances: LIST [CDInstances.NewInst[specific.obj, [[0, 0], specific.orientation]]], 
name: Name[me]
];
};

EnumerateChildObjectsRotation: CDDirectory.EnumerateChildObjectsProc = {
specific: RotationSpecific _ NARROW [me.specific];
quit _ proc[specific.obj, data];
};

ReplaceDirectChildsRotation: CDDirectory.ReplaceDChildsProc = {
specific: RotationSpecific _ NARROW [me.specific];
bbox: CD.Rect _ me.bbox;
FOR l: CDDirectory.ReplaceList _ replace, l.rest WHILE l#NIL DO
IF l.first.old=specific.obj THEN {
IF l.first.trans#[] THEN ERROR;
changed _ TRUE; specific.obj _ l.first.new; 
};
ENDLOOP;
IF ~changed THEN RETURN;
me.bbox _ CDBasics.MapRect[specific.obj.bbox, [[0, 0], specific.orientation]];
changed _ bbox = me.bbox;
CDDirectory.PropagateResize[design, me];
};

RotationInterestRect: CD.RectProc = {
specific: RotationSpecific _ NARROW [ob.specific];
RETURN [specific.ir];
};
<<Indirect>>
indirectClass: PUBLIC CD.ObjectClass _ RegisterClass[objectType: $Indirect, expand: ExpandIndirect, enumerateChildObjects: 
EnumerateChildObjectsIndirect, replaceDirectChilds: ReplaceDirectChildsIndirect];
<<In the future, add an IR proc, and maybe a Draw Proc?>>

CreateIndirect: PUBLIC PROC [sourceObject: CD.Object, name: Rope.ROPE _ NIL, props: CD.PropList _ NIL] RETURNS [indirectObject: 
CD.Object] = {
IF sourceObject=NIL THEN RETURN [NIL];
indirectObject _ NEW [CD.ObjectRep _ [class: indirectClass, bbox: sourceObject.bbox, specific: sourceObject, properties: props]];
SetName[indirectObject, name];
};

ExpandIndirect: CDDirectory.ExpandProc = {new _ NARROW [me.specific]};

EnumerateChildObjectsIndirect: CDDirectory.EnumerateChildObjectsProc = {
quit _ proc[NARROW [me.specific], data];
};

ReplaceDirectChildsIndirect: CDDirectory.ReplaceDChildsProc = {
indirect: CD.Object = NARROW [me.specific];
bbox: CD.Rect _ me.bbox;
FOR l: CDDirectory.ReplaceList _ replace, l.rest WHILE l#NIL DO
IF l.first.old=indirect THEN {
IF l.first.trans#[] THEN ERROR;
changed _ TRUE; me.specific _ l.first.new; 
};
ENDLOOP;
IF ~changed THEN RETURN;
me.bbox _ indirect.bbox;
changed _ bbox = me.bbox;
CDDirectory.PropagateResize[design, me];
};
<<Lazy>>
lazyClass: PUBLIC CD.ObjectClass _ RegisterClass[objectType: $Lazy, expand: ExpandLazy, interestRect: LazyIR];

LazyData: TYPE = REF LazyDataRec;
LazyDataRec: TYPE = RECORD [info: REF, createProc: CreateProc, ir: CD.Rect];

CreateLazy: PUBLIC PROC [info: REF, createProc: CreateProc, bbox, ir: CD.Rect, name: Rope.ROPE _ NIL, props: CD.PropList _ NIL] 
RETURNS [newLazy: CD.Object] = {
newLazy _ NEW [CD.ObjectRep _ [
class: lazyClass, 
specific: NEW [LazyDataRec _ [info: info, createProc: createProc, ir: ir]], 
properties: props
]];
newLazy.bbox _ bbox;
SetName[newLazy, name];
};

LazyIR: CD.RectProc = {lazyData: LazyData _ NARROW [ob.specific]; RETURN [lazyData.ir]};

ExpandLazy: CDDirectory.ExpandProc = {
lazyData: LazyData _ NARROW [me.specific];
new _ lazyData.createProc[lazyData.info];
IF CD.InterestRect[new]#lazyData.ir OR new.bbox#me.bbox THEN ERROR;
IF into#NIL THEN [] _ CDDirectory.Include[into, new, Name[me]];
};
<<Tilings>>
    tilingClass: PUBLIC CD.ObjectClass _ CD.RegisterObjectClass[$Tiling, [
        quickDrawMe: QuickDrawTiling,
        drawMe: DrawTiling,
        internalRead: ReadTiling,
        internalWrite: WriteTiling,
        interestRect: TilingInterestRect,
        description: "tiling object"
        ]];

    TilingData: TYPE = REF TilingDataRec;
    TilingDataRec: TYPE = RECORD [
        ir: CD.Rect,                -- interest rect
        c: SEQUENCE sizeY: NAT OF TileLines        -- tiles
        ];
    <<Implementation detail: we could have one sequence instead of a sequence of sequence, it would be simpler.  But it would allow 
    only a limited number of tiles, while this raises the limit.  Once Cedar changes, this can be changed!>>
    TileLines: TYPE = REF TileLinesRec;
    TileLinesRec: TYPE = RECORD [c: SEQUENCE sizeX: NAT OF CD.Object];

    CreateTiling: PUBLIC PROC [sizeX, sizeY: NAT, tiles: PROC [x, y: NAT] RETURNS [CD.Object], name: Rope.ROPE _ NIL, props: 
    CD.PropList _ NIL] RETURNS [tiling: CD.Object] = {
    new: CD.Object;
        data: TilingData _ NEW [TilingDataRec[sizeY]];
        <<Checking all right>>
        IF sizeX=0 OR sizeY=0 THEN ERROR;
        FOR y: NAT IN [0 .. sizeY) DO
        height: INT _ CD.InterestSize[tiles[0, y]].y;
            FOR x: NAT IN [1 .. sizeX) DO
            IF CD.InterestSize[tiles[x, y]].y#height THEN ERROR; -- constraint of same height within a row not respected!
                ENDLOOP;
            ENDLOOP;
        FOR x: NAT IN [0 .. sizeX) DO
        width: INT _ CD.InterestSize[tiles[x, 0]].x;
            FOR y: NAT IN [1 .. sizeY) DO
            IF CD.InterestSize[tiles[x, y]].x#width THEN ERROR; -- constraint of same width within a column not respected!
                ENDLOOP;
            ENDLOOP;
        <<Building the array!>>
        FOR y: NAT IN [0 .. sizeY) DO
            line: TileLines _ NEW [TileLinesRec[sizeX]];
            FOR x: NAT IN [0 .. sizeX) DO
                line[x] _ tiles[x, y];
                ENDLOOP;
            data[y] _ line;
            ENDLOOP;
    tiling _ NEW [CD.ObjectRep _ [class: tilingClass, specific: data, properties: props]];
    new _ ExpandTiling[tiling].new;
    tiling.bbox _ new.bbox;
    data.ir _ CD.InterestRect[new];
    SetName[tiling, name];
        };

    EnumerateTiles: PUBLIC PROC [tiling: CD.Object, eachTile: EachTileProc] RETURNS [quit: BOOL _ FALSE] = {
    data: TilingData = NARROW [tiling.specific];
        pos: CD.Position _ [0, 0];
        FOR y: NAT IN [0 .. data.sizeY) DO
            line: TileLines _ data[y];
            pos.x _ 0;
            FOR x: NAT IN [0 .. line.sizeX) DO
            quit _ eachTile[x, y, line[x], pos];
            IF quit THEN RETURN;
            pos.x _ pos.x + CD.InterestSize[line[x]].x;
                ENDLOOP;
        pos.y _ pos.y + CD.InterestSize[line[0]].y;
            ENDLOOP;
        };

    GetTilingSize: PUBLIC PROC [tiling: CD.Object] RETURNS [sizeX, sizeY: NAT] = {
    data: TilingData = NARROW [tiling.specific];
    sizeY _ data.sizeY;
    sizeX _ data[0].sizeX;
        };
    GetTile: PUBLIC PROC [tiling: CD.Object, x, y: NAT] RETURNS [tile: CD.Object] = {
    data: TilingData = NARROW [tiling.specific];
        tile _ data[y][x];
        };

ExpandTiling: CDDirectory.ExpandProc = {
    EachTile: EachTileProc = {
        instances _ CONS [CDInstances.NewInst[tile, [CDBasics.SubPoints[pos, CD.InterestBase[tile]]]], instances];
        };
    instances: LIST OF CD.Instance;
[] _ EnumerateTiles[me, EachTile];
new _ CreateCell[instances: instances, name: Name[me]]; 
IF into#NIL THEN [] _ CDDirectory.Include[into, new, Name[me]];
};

    DrawTiling: CD.DrawProc = {
        mapClip: CD.Rect _ CDBasics.DeMapRect[pr.interestClip, trans].itemInCell; 
            <<clipping boundary in object coordinates>>
        EachTile: EachTileProc = {
            pos _ CDBasics.SubPoints[pos, CDBasics.BaseOfRect[CD.InterestRect[tile]]];
            IF CDBasics.Intersect[mapClip, CDBasics.MoveRect[tile.bbox, pos]] 
                THEN pr.drawChild[pr, tile, [off: CDBasics.MapPoint[pos, trans], orient: trans.orient]];
            quit _ pr.stopFlag^;
            };
    [] _ EnumerateTiles[ob, EachTile];
        }; 

    tilingSimplification: REAL _ 100.0; -- average size below which things get simplified

    QuickDrawTiling: CD.DrawProc = {
        mapClip: CD.Rect _ CDBasics.DeMapRect[pr.interestClip, trans].itemInCell; 
            <<clipping boundary in object coordinates>>
        EachTile: EachTileProc = {
            pos _ CDBasics.SubPoints[pos, CDBasics.BaseOfRect[CD.InterestRect[tile]]];
            IF CDBasics.Intersect[mapClip, CDBasics.MoveRect[tile.bbox, pos]] 
                THEN tile.class.quickDrawMe[pr, tile, [off: CDBasics.MapPoint[pos, trans], orient: trans.orient]];
            quit _ pr.stopFlag^;
            };
        IF DrawObjectOutline[pr, ob, trans, tilingSimplification] THEN RETURN; -- object outlined
    [] _ EnumerateTiles[ob, EachTile];
        }; 

EnumerateTilingChildObjects: CDDirectory.EnumerateChildObjectsProc = {
    EachTile: EachTileProc = {quit _ proc[tile, data]};
quit _ EnumerateTiles[me, EachTile];
};

ReplaceTilingDirectChilds: CDDirectory.ReplaceDChildsProc = {
    EachTileCheckNoChange: EachTileProc = {
    FOR l: CDDirectory.ReplaceList _ replace, l.rest WHILE l#NIL DO
    quit _ l.first.old=tile; 
    ENDLOOP;
        };
changed _ EnumerateTiles[me, EachTileCheckNoChange];
IF NOT changed THEN RETURN;
ERROR;
};

TilingInterestRect: CD.RectProc = {
data: TilingData = NARROW [ob.specific];
RETURN [data.ir];
};

    WriteTiling: CD.InternalWriteProc = {
    data: TilingData = NARROW [ob.specific];
        CDIO.WriteRect[h, ob.bbox]; 
        TokenIO.WriteInt[h, data[0].sizeX];
        TokenIO.WriteInt[h, data.sizeY];
        CDIO.WriteRect[h, data.ir]; 
        FOR y: NAT IN [0 .. data.sizeY) DO
            line: TileLines _ data[y];
            FOR x: NAT IN [0 .. line.sizeX) DO
                CDIO.WriteObject[h, data[y][x]];
                ENDLOOP;
            ENDLOOP;
        };

    ReadTiling: CD.InternalReadProc = {
        bbox: CD.Rect _ CDIO.ReadRect[h]; 
        sizeX: NAT _ TokenIO.ReadInt[h];
        sizeY: NAT _ TokenIO.ReadInt[h];
        data: TilingData _ NEW [TilingDataRec[sizeY]];
        ob: CD.Object _ NEW [CD.ObjectRep _ [class: tilingClass, specific: data, bbox: bbox]];
        data.ir _ CDIO.ReadRect[h];
        FOR y: NAT IN [0 .. sizeY) DO
            line: TileLines _ NEW [TileLinesRec[sizeX]];
            FOR x: NAT IN [0 .. sizeX) DO
                line[x] _ CDIO.ReadObject[h];
                ENDLOOP;
            data[y] _ line;
            ENDLOOP;
        RETURN [ob];
        };
<<Implementors goodies>>
CreateCell: PUBLIC PROC [instances: CD.InstanceList, ir: CD.Rect _ [0,0,-1,-1], name: Rope.ROPE _ NIL, props: CD.PropList _ NIL] 
RETURNS [cell: CD.Object]= {
cell _ CDCells.CreateCell[il: instances, ir: ir];
cell.properties _ props;
CDCells.ToSequenceMode[cell];
SetName[cell, name];
};

SetName: PUBLIC PROC [obj: CD.Object, name: Rope.ROPE] = {
CDProperties.PutObjectProp[obj, $Describe, name];
};

Name: PUBLIC PROC [obj: CD.Object] RETURNS [name: Rope.ROPE] = {
SearchEachDesign: CDPrivate.DesignEnumerator = {
name _ CDDirectory.Name[obj, design];
quit _ name#NIL;
};
name _ NARROW [CDProperties.GetObjectProp[obj, $Describe]];
IF name=NIL THEN [] _ CDPrivate.EnumDesigns[SearchEachDesign];
};

    Get: PUBLIC PROC [design: CD.Design, name: Rope.ROPE] RETURNS [obj: CD.Object] = {
        obj _ CDDirectory.Fetch[design, name].object;
        IF obj=NIL THEN {TerminalIO.PutF["*** Object %g not found in the design.\n", IO.rope[name]]; ERROR};
        IF NOT CDOpsExtras.MakeImmutableAndSetNameHints[ob: obj, design: design] THEN TerminalIO.PutF["*** Object %g could not be made 
        immutable.\n", IO.rope[name]];
        };

Flatten: PUBLIC PROC [cell: CD.Object] RETURNS [new: CD.Object] = {
TopEnumerate: CDCells.InstEnumerator = {
obj: CD.Object _ Flatten[inst.ob];
IF NOT CDCells.IsCell[obj] OR CDProperties.GetObjectProp[obj, $DontFlatten]#NIL
THEN instances _ CONS [CDInstances.NewInst[obj, inst.trans, CDProperties.DCopyProps[inst.properties]], instances]
ELSE {
trans: CD.Transformation _ inst.trans;
InsideEnumerate: CDCells.InstEnumerator = {
instances _ CONS [CDInstances.Composed[inst, trans], instances];
};
[] _ CDCells.EnumerateInstances[obj, InsideEnumerate];
};
};

instances: CD.InstanceList _ NIL;
IF CDProperties.GetObjectProp[cell, $DontFlatten]#NIL THEN RETURN [cell];
IF NOT CDCells.IsCell[cell] THEN {
new _ CDDirectory.Expand1[cell].new; 
RETURN [IF new=NIL THEN cell ELSE Flatten[new]];
}; 
[] _ CDCells.EnumerateInstances[cell, TopEnumerate];
new _ CreateCell[instances: instances, ir: CD.InterestRect[cell], name: Name[cell]];
CDProperties.CopyProps[cell.properties, new];
};

<<Mechanism for flushing during edits>>
propertiesToFlushOnEdit: LIST OF ATOM _ NIL;
childToParents: RefTab.Ref _ RefTab.Create[];
<<Having a RefTab (of the right size) helps avoiding frequent allocations.>>
<<>>
AddChildParent: PROC [child, parent: CD.Object] = {
parents: LIST OF CD.Object _ NARROW [RefTab.Fetch[childToParents, child].val];
IF GList.Member[parent, parents] THEN RETURN;
parents _ CONS [parent, parents];
[] _ RefTab.Store[childToParents, child, parents];
};

FlushPropertiesAfterReplace: CDEvents.EventProc = {
BuildTable: CDDirectory.EachEntryAction = {
EachChild: CDDirectory.EachObjectProc = {
IF NOT me.immutable THEN AddChildParent[me, ob];
};
sch: Rope.ROPE _ NARROW [CDProperties.GetObjectProp[ob, $IconFor]];
schOb: CD.Object _ IF sch#NIL THEN CDDirectory.Fetch[design, sch].object ELSE NIL;
<<we include icons of sch>>
IF schOb#NIL THEN AddChildParent[schOb, ob];
<<In case obj is a mask, the corresponding sch (if any) "depends" on it.  That's a hack!>>
schOb _ IF Rope.Match["*.mask", name] THEN CDDirectory.Fetch[design, Rope.Replace[base: name, start: Rope.Length[name]-4, with: 
"sch"]].object ELSE NIL;
IF schOb#NIL THEN AddChildParent[ob, schOb];
<<We add all the children>>
[] _ CDDirectory.EnumerateChildObjects[ob, EachChild];
};
changedObjects: LIST OF CD.Object _ LIST [NARROW [x]];
foundANewOne: BOOL _ TRUE;
flushedObjects: Rope.ROPE _ NIL;
<<Slightly wrong here, because we miss the objects which are NOT in the directory (e.g. unnamed cells)>>
[] _  CDDirectory.Enumerate[design, BuildTable];
WHILE foundANewOne DO 
foundANewOne _ FALSE; 
FOR list: LIST OF CD.Object _ changedObjects, list.rest WHILE list#NIL DO
FOR parents: LIST OF CD.Object _ NARROW [RefTab.Fetch[childToParents, list.first].val], parents.rest WHILE parents#NIL DO
IF GList.Member[parents.first, changedObjects] THEN LOOP;
changedObjects _ CONS [parents.first, changedObjects]; foundANewOne _ TRUE;
ENDLOOP;
ENDLOOP;
ENDLOOP;
FOR list: LIST OF CD.Object _ changedObjects, list.rest WHILE list#NIL DO
flushed: BOOL _ FALSE;
FOR props: LIST OF ATOM _ propertiesToFlushOnEdit, props.rest WHILE props#NIL DO
IF CDProperties.GetObjectProp[list.first, props.first]=NIL THEN LOOP;
flushed _ TRUE;
CDProperties.PutObjectProp[list.first, props.first, NIL]; 
ENDLOOP;
IF flushed THEN flushedObjects _ Rope.Cat[flushedObjects, " ", CDDirectory.Name[list.first, design]];
ENDLOOP;
IF flushedObjects#NIL THEN TerminalIO.PutF["Flushed caches for %g.\n ", IO.rope[flushedObjects]];
RefTab.Erase[childToParents]; -- we clean up that table!
};

RegisterGenerator: PUBLIC PROC [generator: GeneratorProc, name: Rope.ROPE] = {
TerminalIO.PutF["Generator program %g %g.\n", IO.rope[name], IO.rope[
IF CDGenerate.Register[context: CDGenerate.AssertContext["PatchWork"], key: name, generator: generator, cache: FALSE] THEN 
"recorded" ELSE "overwritten"]];
};

RegisterProp: PUBLIC PROC [prop: ATOM, copy: BOOL _ FALSE, flushOnEdit: BOOL _ FALSE] RETURNS [sameAtom: ATOM] = {
[] _ CDProperties.RegisterProperty[prop, $PW];
CDProperties.InstallProcs[prop, [makeCopy: IF copy THEN CDProperties.CopyVal ELSE CDProperties.DontCopy]];
IF flushOnEdit THEN propertiesToFlushOnEdit _ CONS [prop, propertiesToFlushOnEdit];
sameAtom _ prop;
};

    RegisterClass: PUBLIC PROC [objectType: ATOM, expand: CDDirectory.ExpandProc, enumerateChildObjects: 
    CDDirectory.EnumerateChildObjectsProc _ NIL, replaceDirectChilds: CDDirectory.ReplaceDChildsProc _ NIL, interestRect: 
    CD.RectProc _ NIL, drawMe, quickDrawMe, showMeSelected: CD.DrawProc _ NIL] RETURNS [objectClass: CD.ObjectClass] = {
        dp: CDDirectory.DirectoryProcs _ [expand: expand];
        objectClassRec: CD.ObjectClassRec _ [];
        objectClassRec.showMeSelected _ CDDefaultProcs.ShowMeSelectedWithExpand;
    objectClassRec.interestRect _ IF interestRect=NIL THEN CDDefaultProcs.InterestRectWithExpand ELSE interestRect;
    objectClassRec.drawMe _ IF drawMe=NIL THEN CDDefaultProcs.DrawMe ELSE drawMe;
    objectClassRec.quickDrawMe _ IF quickDrawMe=NIL THEN CDDefaultProcs.QuickDrawMe ELSE quickDrawMe;
    objectClassRec.showMeSelected _ IF showMeSelected=NIL THEN CDDefaultProcs.ShowMeSelected ELSE showMeSelected;
        objectClassRec.directoryProcs _ NIL; objectClassRec.xDesign _ 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];
        };

    DrawObjectOutline: PROC [pr: CD.DrawRef, ob: CD.Object, trans: CD.Transformation, factor: REAL] RETURNS [simplified: BOOL] ~ {
        <<If the object may be simplified (small average size), display bbox and name if available and return TRUE, otherwise do nothing & 
        return FALSE.>>
        <<Factor is 50.0 for cells. Making it larger makes it harder to detail a class of objects.>>
        <<This is for the use of Quick DrawProcs, in order to have a standardized clipping algorithm>>
        <<The algorithm mimics the one implemented by CDCellsImpl>>
        averageSize: INT = MAX [((ob.bbox.y2-ob.bbox.y1)+(ob.bbox.x2-ob.bbox.x1))/2, 1];
        IF pr.stopFlag^ THEN RETURN [simplified: TRUE]; -- no drawing anyway...
        simplified _ pr.scaleHint<(factor/averageSize) AND pr.scaleHint>0;
        IF simplified THEN { -- we do the painting here
            realIR: CD.Rect = CDBasics.MapRect[CD.InterestRect[ob], trans]; -- remapped interest rect
            pr.drawOutLine[pr, realIR, CD.outlineLayer];
            IF pr.scaleHint*averageSize>9 THEN { -- also paint name inside
                name: Rope.ROPE _ CDDirectory.Name[ob, pr.design];
                IF name=NIL THEN name _ NARROW [CDProperties.GetObjectProp[ob, $Describe]];
                IF name#NIL THEN pr.drawComment[pr, realIR, name];
                };
            };
        };
<<Utilities for debug>>
OpenDesign: PUBLIC PROC [fileName: Rope.ROPE] RETURNS [design: CD.Design] = {
design _ CDIO.ReadDesign[fileName, NIL, CDIO.GetWorkingDirectory[]];
};
<<>>
Draw: PUBLIC PROC [obj: CD.Object, technologyName: ATOM _ NIL] RETURNS [design: CD.Design] = {
    design _ CDDebug.Draw[obj, IF technologyName=NIL THEN $cmosB ELSE technologyName].dummyDesign;
    design.mutability _ editable;
    };
<<Commands>>
RunGenerator: PROC [comm: CDSequencer.Command] = {
inner: PROC = {
design: CD.Design _ comm.design;
pos: CD.Position _ comm.pos;
context: CDGenerate.Context _ CDGenerate.AssertContext["PatchWork"];
key: Rope.ROPE;
obj: CD.Object;
time: BasicTime.GMT _ BasicTime.Now[]; -- Start the stop watch
min, sec: INT;
TerminalIO.PutF["PatchWork menu selected\n"];
key _ CDGenerate.SelectOneOf[context, "select generate"]; 
IF Rope.IsEmpty[key] THEN {TerminalIO.PutF["no generator selected\n"]; RETURN};
<<-- Generate the object>>
obj _ CDGenerate.FetchNCall[context, design, key];
<<-- Now figure out how long it took to generate this wonderful piece of layout>>
sec _ BasicTime.Period[time, BasicTime.Now[]];
min _ sec/60; sec _ sec MOD 60;
TerminalIO.PutF["PW completed in "];
IF min#0 THEN TerminalIO.PutF["%g min ", IO.int[min]]; TerminalIO.PutF["%g sec\n", IO.int[sec]];
IF obj=NIL THEN {TerminalIO.PutF["No returned object\n"]; RETURN};
[] _ CDOps.IncludeObjectI[design, obj, pos];
};
<<Silly line, just because CD does not do the right thing!>>
CDEnvironment.DoWithWDir[CDEnvironment.GetWorkingDirectory[comm.design], inner];
};

    ListIcons: PROC [comm: CDSequencer.Command] = {
        EachEntry: CDDirectory.EachEntryAction = {
            count _ count+1;
            IF NOT Rope.Match["*.icon", name, FALSE] THEN RETURN;
            IF NOT Ascii.Letter[Rope.Fetch[name]] AND NOT Ascii.Digit[Rope.Fetch[name]] THEN RETURN;
            displayed _ displayed+1;
            list _ CONS [name, list];
            };

        list: LIST OF Rope.ROPE _ NIL; count: INT _ 0; displayed: INT _ 0;
        TerminalIO.PutF["List icons\n"];
        [] _ CDDirectory.Enumerate[comm.design, EachEntry];
        list _ RopeList.Sort[list, RopeList.Compare];
        FOR l: LIST OF Rope.ROPE _ list, l.rest WHILE l#NIL DO
            TerminalIO.PutF["        %g", IO.rope[l.first]];
            ENDLOOP;
        TerminalIO.PutF["\n %g objects counted   %g displayed\n", IO.int[count], IO.int[displayed]];
        };
<<Initialization>>
CDSequencer.ImplementCommand[$PatchWork, RunGenerator];
CDCommandOps.RegisterWithMenu[$RectProgramMenu, "PatchWork generator", "proposes a menu of generators", $PatchWork]; 
CDEvents.RegisterEventProc[$AfterCellReplacement, FlushPropertiesAfterReplace];
[] _ RegisterProp[$DontFlatten, TRUE];
[] _ RegisterProp[$PWName, TRUE];
    CDCommandOps.RegisterWithMenu[$DirectoryMenu, "list icons", "lists cells of the form *.icon", NIL, ListIcons, dontQueue];
    [] _ CDDirectory.InstallDirectoryProcs[abutXClass, [
        enumerateChildObjects: EnumerateChildObjectsAbut, replaceDirectChilds: ReplaceDirectChildsAbut, expand: ExpandAbut
        ]];
    [] _ CDDirectory.InstallDirectoryProcs[abutYClass, [
        enumerateChildObjects: EnumerateChildObjectsAbut, replaceDirectChilds: ReplaceDirectChildsAbut, expand: ExpandAbut
        ]];
    [] _ CDDirectory.InstallDirectoryProcs[tilingClass, [
        enumerateChildObjects: EnumerateTilingChildObjects, replaceDirectChilds: ReplaceTilingDirectChilds, expand: ExpandTiling
        ]];

END.