DIRECTORY
Commander, CStitching, IO; --, Process, SafeStorage;

CStitchingImpl: CEDAR MONITOR
IMPORTS Commander, CStitching, IO --, Process, SafeStorage 
EXPORTS CStitching =
BEGIN 
OPEN CStitching;

UseOfAlreadyDeletedTile: ERROR = CODE;

neLimit: Pos = [x: Number.LAST, y: Number.LAST];
nwLimit: Pos = [x: Number.FIRST, y: Number.LAST];
swLimit: Pos = [x: Number.FIRST, y: Number.FIRST];
seLimit: Pos = [x: Number.LAST, y: Number.FIRST];
allSpace: Rect = [x1: Number.FIRST+1, y1: Number.FIRST, x2: Number.LAST-1, y2: Number.LAST-1];
maxSpace: Rect = [x1: allSpace.x1+1, y1: allSpace.y1+1, x2: allSpace.x2-1, y2: allSpace.y2-1];

empty: Rect = [x1: Number.LAST, y1: Number.LAST,  x2: Number.FIRST, y2: Number.FIRST];
PrivateRec: TYPE = RECORD[notused: REF];
guard: REF = NEW[PrivateRec_[$CSGuard]];
deleted: REF = NEW[PrivateRec_[$CSDeleted]];
northLimit: Tile = NEW[TileRec _ [pos: nwLimit, value: guard]];
northBuffer: Tile = NEW[TileRec _ [pos: [allSpace.x1, allSpace.y2], value: guard]];
southLimit: Tile = NEW[TileRec _ [pos: swLimit, value: guard]];
eastLimit: Tile = NEW[TileRec _ [pos: seLimit, value: guard]];
westLimit: Tile = NEW[TileRec _ [pos: swLimit, value: guard]];

Disguise: TYPE = RECORD [hiddenValue: REF];

disposedTiles: Tile _ NIL;
disguiseCache: REF Disguise _ NIL;

InitTesselationBorderTiles: PROC = {
northLimit.nE _ RtoP[eastLimit];
eastLimit.eN _ northLimit;
southLimit.eN _ eastLimit;
southLimit.nE _ RtoP[eastLimit];
eastLimit.wS _ RtoP[southLimit];
eastLimit.sW _ southLimit;
westLimit.nE _ RtoP[northLimit];
westLimit.eN _ northLimit;
northLimit.sW _ westLimit;
northLimit.wS _ RtoP[westLimit];
southLimit.sW _ westLimit;
westLimit.wS _ RtoP[southLimit];
northBuffer.eN _ northLimit;
northBuffer.nE _ RtoP[eastLimit];
northBuffer.sW _ westLimit;
northBuffer.wS _ NIL;
};

DumpCache: PUBLIC ENTRY PROC = {
ENABLE UNWIND => NULL;
cnt: INT _ 0; 
IF disposedTiles#NIL THEN {
lag: Tile _ disposedTiles;
FOR tc: Tile _ disposedTiles.eN, tc.eN WHILE tc#NIL DO
lag.eN _ NIL; lag _ tc;
IF (cnt_cnt+1)>1000 THEN EXIT
ENDLOOP;
disposedTiles _ NIL
};
IF disguiseCache#NIL THEN {
lag: REF Disguise _ disguiseCache;
cnt _ 0;
FOR dc: REF Disguise _ NARROW[disguiseCache.hiddenValue], NARROW[dc.hiddenValue] WHILE dc # NIL DO
lag.hiddenValue _ NIL; lag _ dc;
IF (cnt_cnt+1)>1000 THEN EXIT
ENDLOOP;
disguiseCache _ NIL
};
};

NewTile: ENTRY PROC RETURNS [tile: Tile] = {
ENABLE UNWIND => NULL;
tile _ InternalNewTile[];
};

InternalNewTile: INTERNAL PROC RETURNS [tile: Tile] = INLINE {
IF disposedTiles#NIL THEN {
tile _ disposedTiles;
disposedTiles _ disposedTiles.eN;
}
ELSE tile _ NEW[TileRec];
};

DisposeTile: ENTRY PROC [tile: Tile] = {
ENABLE UNWIND => NULL;
tile.sW _ NIL;  -- Prevent potential circular chains in the disposed cache.
tile.nE _ tile.wS _ NIL;
tile.value _ deleted;
tile.eN _ disposedTiles;
disposedTiles _ tile;
};

NewDisguise: ENTRY PROC [hiddenValue: REF_NIL] RETURNS [disguise: REF Disguise] = {
ENABLE UNWIND => NULL;
IF disguiseCache#NIL THEN {
disguise _ disguiseCache;
disguiseCache _ NARROW[disguiseCache.hiddenValue];
}
ELSE disguise _ NEW[Disguise];
disguise.hiddenValue _ hiddenValue;
};

DisposeDisguise: ENTRY PROC [disguise: REF Disguise] = {
ENABLE UNWIND => NULL;
disguise.hiddenValue _ disguiseCache;
disguiseCache _ disguise;
};

Setup: INTERNAL PROC [plane: Tesselation] = {
eastSpace: Tile = InternalNewTile[];
centreSpace: Tile = InternalNewTile[];
eastSpace^ _ [
eN: northBuffer, nE: RtoP[eastLimit], sW: centreSpace, wS: RtoP[southLimit],
pos: [allSpace.x2, allSpace.y1], 
value: guard
];
centreSpace^ _ [
eN: northBuffer, nE: RtoP[eastSpace], sW: westLimit, wS: RtoP[southLimit], 
pos: [allSpace.x1, allSpace.y1], 
value: NIL
];
plane^ _ [southEast: eastSpace, current: centreSpace, data: NIL, stopFlag: plane.stopFlag, tileCount: 1];
IF plane.stopFlag=NIL THEN plane.stopFlag _ NEW[BOOL_FALSE];
};

NewTesselation: PUBLIC ENTRY PROC [data: REF_NIL, stopFlag: REF BOOL_NIL] RETURNS [plane: Tesselation] = {
plane _ NEW[CStitching.TesselationRec_[current: NIL, southEast: NIL, stopFlag: stopFlag, data: data]];
Setup[plane];
};


ResetTesselation: PUBLIC PROC [plane: Tesselation] = {

CacheTileList: PROC [header: Tile] = {
WHILE header#NIL DO
t: Tile _ header;
header _ header.eN;
DisposeTile[t];
ENDLOOP; 
};

CacheIt: TileProc = {
tile.value _ deleted;
tile.eN _ header;
header _ tile;
};

MySetup: ENTRY PROC [plane: Tesselation] = {
Setup[plane];
};

header: Tile _ NIL;
IF plane#NIL THEN {
EnumerateArea[plane, maxSpace, CacheIt, NIL, deleted];
CacheTileList[header]; 
MySetup[plane];
};
};

EWCompatible: PROC [a, b: Tile] RETURNS [BOOL] = INLINE {
RETURN [a.value=b.value AND a.pos.x=b.pos.x AND NE[a].pos.x=NE[b].pos.x]
};

ChangeRect: PUBLIC PROC [plane: Tesselation, rect: Rect, new: REF ANY _ NIL] = {

SplitEWRunning: PROC [rider: Tile, splitY, endX: Number] = {
WHILE WEdge[rider]<endX DO
WHILE SEdge[rider]>splitY DO rider _ WS[rider] ENDLOOP; --won't go left nor right! (Ib)
IF SEdge[rider]<splitY THEN {
IF EEdge[rider]<endX OR rider.value#new --left edge said must split-- THEN 
rider _ NSSplit[plane, rider, splitY];
};
rider _ NE[rider]; --reinstalls Ia and Ib (Ib because old rider limits all WS..) 
ENDLOOP;
};

tile: Tile;
rect.x1 _ MAX[maxSpace.x1, rect.x1];
rect.x2 _ MIN[maxSpace.x2, rect.x2];
rect.y1 _ MAX[maxSpace.y1, rect.y1];
rect.y2 _ MIN[maxSpace.y2, rect.y2];
IF rect.x1>=rect.x2 OR rect.y1>=rect.y2 THEN RETURN;
tile _ MyFindTile[plane.current, rect.x1, rect.y2];
plane.current _ tile;
SplitEWRunning[tile, rect.y2, rect.x2]; --north border
SplitEWRunning[MyFindTile[plane.current, rect.x1, rect.y1], rect.y1, rect.x2]; --south border 
tile _ MyFindTile[plane.current, rect.x1, rect.y2-1];
DO
IF tile.value#new AND WEdge[tile]<rect.x1 THEN {
left: Tile;
tile _ EWSplit[plane, tile, rect.x1].east;
left _ tile.sW;  
IF EWCompatible[left, left.eN] THEN left _ NSMerge[plane, left, left.eN];
IF EWCompatible[left, WS[left]] THEN left _ NSMerge[plane, WS[left], left];
};
DO --loop rides tile eastwards and changes value until border is hit
IF tile.value#new THEN {
IF EEdge[tile]>rect.x2 THEN {
right: Tile _ EWSplit[plane, tile, rect.x2].east;
IF EWCompatible[right, right.eN] THEN right _ NSMerge[plane, right, right.eN];
IF EWCompatible[right, WS[right]] THEN right _ NSMerge[plane, WS[right], right];
};
tile _ MyChangeTile[plane, tile, new]; --returns northernmost tile if changed
};
IF EEdge[tile]>=rect.x2 THEN EXIT;
tile _ NE[tile];
WHILE SEdge[tile]>=rect.y2 DO tile _ WS[tile] ENDLOOP; -- EMM
ENDLOOP;
IF WEdge[tile]>rect.x1 THEN ERROR;
IF SEdge[tile]<=rect.y1 THEN EXIT;
tile _ Below[tile, rect.x1];
ENDLOOP
};


ChangeEnumerateArea: PUBLIC PROC [plane: Tesselation, rect: Rect, eachRect: RectProc, data: REF _ NIL, skip: REF] = {

DisguiseTile: TileProc = {
tile.value _ NewDisguise[tile.value];
};

ApplyFuncToTile: TileProc = {
disguise: REF Disguise = NARROW[tile.value];
clippedBB: Rect = [
MAX[WEdge[tile], rect.x1], 
MAX[SEdge[tile], rect.y1], 
MIN[EEdge[tile], rect.x2], 
MIN[NEdge[tile], rect.y2]
]; -- Clip tile against Enumeration's bounding box
[] _ MyChangeTile[plane, tile, disguise.hiddenValue];
IF disguise.hiddenValue#skip THEN eachRect[plane: plane, rect: clippedBB, oldValue: disguise.hiddenValue, data: data];
DisposeDisguise[disguise];
};
EnumerateArea[plane, rect, DisguiseTile, NIL, deleted];
EnumerateArea[plane, rect, ApplyFuncToTile, data, deleted];
};

ChangeTile: PUBLIC PROC [plane: Tesselation, tile: Tile, new: REF _ NIL] = TRUSTED {
IF tile.value#new THEN [] _ MyChangeTile[plane, tile, new]
};

MyChangeTile: PROC [plane: Tesselation, tile: Tile, new: REF] RETURNS [Tile] = {
n: Number = NEdge[tile];
e: Number = EEdge[tile];
s: Number = SEdge[tile];
w: Number = WEdge[tile];
tWest, tEast, tNorth: Tile;
IF tile.value=new THEN RETURN [tile];
tile.value _ new;  
tEast _ NE[tile];
IF tEast.value=new AND NEdge[tEast]>n THEN [] _ NSSplit[plane, tEast, n];
tWest _ tile.eN; --east now but west soon
WHILE WEdge[tWest]>=w DO tWest _ tWest.sW ENDLOOP;
IF tWest.value=new AND SEdge[tWest]<n THEN [] _ NSSplit[plane, tWest, n];
tWest _ tile.sW;
IF tWest.value=new AND SEdge[tWest]<s THEN [] _ NSSplit[plane, tWest, s];
tEast _ WS[tile];
WHILE EEdge[tEast]<=e DO tEast _ NE[tEast] ENDLOOP;
IF tEast.value=new AND NEdge[tEast]>s THEN [] _ NSSplit[plane, tEast, s];
tWest _ tile.sW;
WHILE NEdge[tWest]<n DO
IF tWest.value#new AND tWest.eN.value#new THEN tWest _ tWest.eN
ELSE {
tile _ NSSplit[plane, tile, NEdge[tWest]];
IF tWest.value=new THEN [] _ EWMerge[plane, tWest, NE[tWest]];
tWest _ tile.sW;
}
ENDLOOP;
IF tWest.value=new THEN tile _ EWMerge[plane, tWest, tile];
tEast _ NE[tile];
WHILE SEdge[tEast]>s DO
tile _ tEast.sW;
IF (tEast.value=new OR WS[tEast].value=new) AND SEdge[tile]<SEdge[tEast] THEN
[] _ NSSplit[plane, tile, SEdge[tEast]];
tEast _ WS[tEast]
ENDLOOP;
tNorth _ tEast.sW; --not yet north..
WHILE NEdge[tNorth]<=s DO tNorth _ tNorth.eN ENDLOOP;
DO
tile _ tNorth; --current tile in area
tNorth _ tile.eN; --now north of current tile only
IF NE[tile].value=new THEN {
IF tile.nE=tNorth.nE THEN [] _ NSSplit[plane, NE[tile], NEdge[tile]];
tile _ EWMerge[plane, tile, NE[tile]]
};
IF EWCompatible[tile, WS[tile]] THEN tile _ NSMerge[plane, WS[tile], tile];
IF NEdge[tNorth]>n THEN EXIT
ENDLOOP;

IF EWCompatible[tile, tNorth] THEN [] _ NSMerge[plane, tile, tNorth];
RETURN [tile]
};

IsEmpty: PUBLIC PROC [plane: Tesselation, rect: Rect, skip: REF ANY _ NIL] RETURNS [BOOL] = {
rect.x1 _ MAX[maxSpace.x1, rect.x1];
rect.x2 _ MIN[maxSpace.x2, rect.x2];
rect.y1 _ MAX[maxSpace.y1, rect.y1];
rect.y2 _ MIN[maxSpace.y2, rect.y2];
IF rect.x1>rect.x2 OR rect.y1>rect.y2 THEN RETURN [TRUE];
plane.current _ MyFindTile[plane.current, rect.x1, rect.y1];
FOR tile: Tile _ plane.current, Above[tile, rect.x1] WHILE SEdge[tile]<rect.y2 DO
IF tile.value#skip OR EEdge[tile]<rect.x2 THEN RETURN [FALSE]
ENDLOOP;
RETURN [TRUE]
};

BBox: PUBLIC PROC [plane: Tesselation, rect: Rect, skip: REF _ NIL] RETURNS [bBox: Rect _ empty] = {
tile: Tile;
rect.x1 _ MAX[maxSpace.x1, rect.x1];
rect.x2 _ MIN[maxSpace.x2, rect.x2];
rect.y1 _ MAX[maxSpace.y1, rect.y1];
rect.y2 _ MIN[maxSpace.y2, rect.y2];
IF rect.x1>rect.x2 OR rect.y1>rect.y2 THEN RETURN [empty];
plane.current _ MyFindTile[plane.current, rect.x1, rect.y1];
FOR tile _ plane.current, Above[tile, rect.x1] DO
IF SEdge[tile]>=rect.y2 THEN RETURN;  -- plane is empty
IF tile.value#skip OR EEdge[tile]<rect.x2 THEN EXIT
ENDLOOP;
bBox.y1 _ MAX[SEdge[tile], rect.y1];
WHILE SEdge[tile]<rect.y2 DO
IF tile.value#skip THEN {bBox.x1 _ rect.x1; EXIT};
IF EEdge[tile]<rect.x2 AND EEdge[tile]<bBox.x1 THEN bBox.x1 _ EEdge[tile];
tile _ Above[tile, rect.x1];
ENDLOOP;
tile _ MyFindTile[plane.current, rect.x2-1, rect.y1];
WHILE SEdge[tile]<rect.y2 DO
IF tile.value#skip THEN {
bBox.x2 _ rect.x2;
bBox.y2 _ NEdge[tile]
}
ELSE IF WEdge[tile]>rect.x1 THEN {
bBox.x2 _ MAX[bBox.x2, WEdge[tile]];
bBox.y2 _ NEdge[tile]
};
tile _ Above[tile, rect.x2-1];
ENDLOOP;
};

EnumerateArea: PUBLIC PROC [plane: Tesselation, rect: Rect, eachTile: TileProc, data: REF _ NIL, skip: REF] = {

IsChild: PROC [me: Tile, you: Tile] RETURNS [BOOL] = INLINE {
RETURN [you.sW=me AND you.pos.y>rect.y1];
};

IsBrother: PROC [me: Tile, you: Tile] RETURNS [BOOL] = INLINE {
RETURN [me.sW=you.sW AND you.pos.y>rect.y1];
};

tile, visit: Tile;
doneSouthEastTile: BOOL _ FALSE;
rect.x1 _ MAX[maxSpace.x1, rect.x1];
rect.x2 _ MIN[maxSpace.x2, rect.x2];
rect.y1 _ MAX[maxSpace.y1, rect.y1];
rect.y2 _ MIN[maxSpace.y2, rect.y2];
IF rect.x1>=rect.x2 OR rect.y1>=rect.y2 THEN RETURN;
tile _ MyFindTile[plane.current, rect.x1, rect.y2];
IF SEdge[tile]=rect.y2 AND SEdge[tile]>rect.y1 THEN tile _ Below[tile, rect.x1];
plane.current _ tile;
WHILE ~doneSouthEastTile DO
seeking: {youth, experience, nothing} _ youth;  --of tile
DO
IF seeking=youth THEN {
child: Tile _ NE[tile];
WHILE SEdge[child]>=rect.y2 DO child _ WS[child] ENDLOOP;
IF IsChild[tile, child] AND WEdge[child]<rect.x2 THEN {
tile _ child;
LOOP
}
ELSE seeking _ experience --all childs of tile are handled
};
visit _ tile;
IF WEdge[tile]<=rect.x1 OR SEdge[tile]<=rect.y1 THEN {
seeking _ nothing;
IF SEdge[tile]>rect.y1 THEN tile _ Below[tile, rect.x1]
ELSE {
IF EEdge[tile]>=rect.x2 THEN doneSouthEastTile _ TRUE
ELSE {
tile _ NE[tile];
WHILE SEdge[tile]>rect.y1 DO tile _ WS[tile] ENDLOOP;
}
}
}
ELSE {
IF IsBrother[tile, WS[tile]] THEN {
tile _ WS[tile]; --brother
seeking _ youth
}
ELSE tile _ tile.sW; --father!
};
IF visit.value#skip THEN eachTile[visit, data]; --must not fool tile
IF seeking=nothing THEN EXIT
ENDLOOP
ENDLOOP;
};

ListArea: PUBLIC PROC [plane: Tesselation, rect: Rect, skip: REF _ NIL] RETURNS [rl: LIST OF REF Region_NIL] = {
PerTile: TileProc = {
rl _ CONS[NEW[ Region _ [
[ 
MAX[WEdge[tile], rect.x1], 
MAX[SEdge[tile], rect.y1],  
MIN[EEdge[tile], rect.x2], 
MIN[NEdge[tile], rect.y2]
],
tile.value
]], rl];
};
EnumerateArea[plane, rect, PerTile, NIL, skip];
};
EnumerateNeighborhood: PUBLIC PROC [plane: Tesselation, tile: Tile, eachTile: TileProc, data: REF _ NIL, skip: REF _ NIL] = BEGIN
eastBound: Number ~ tile.EEdge;
northBound: Number ~ tile.NEdge;
westBound: Number ~ tile.WEdge;
southBound: Number ~ tile.SEdge;
FOR tileSouth: Tile _ tile.WS, tileSouth.NE WHILE tileSouth.WEdge < eastBound DO
IF (tileSouth.value # skip) THEN eachTile [tileSouth, data]
ENDLOOP;
FOR tileWest: Tile _ tile.SW, tileWest.EN WHILE tileWest.SEdge < northBound DO
IF (tileWest.value # skip) THEN eachTile [tileWest, data]
ENDLOOP;
FOR tileNorth: Tile _ tile.EN, tileNorth.SW WHILE tileNorth.EEdge > westBound DO
IF (tileNorth.value # skip) THEN eachTile [tileNorth, data]
ENDLOOP;
FOR tileEast: Tile _ tile.NE, tileEast.WS WHILE tileEast.NEdge > southBound DO
IF (tileEast.value # skip) THEN eachTile [tileEast, data]
ENDLOOP
END;	-- EnumerateNeighborhood

Below: PROC [tile: Tile, x: Number] RETURNS [t: Tile] = INLINE {
t _ WS[tile];
WHILE NE[t].pos.x<=x DO t _ NE[t] ENDLOOP;
};

Above: PROC [tile: Tile, x: Number] RETURNS [t: Tile] = INLINE {
t _ tile.eN;
WHILE t.pos.x>x DO t _ t.sW ENDLOOP;
};

FindTile: PUBLIC PROC [plane: Tesselation, pos: Pos] RETURNS [tile: Tile] = {
pos.x _ MIN[maxSpace.x2, pos.x];
pos.y _ MIN[maxSpace.y2, pos.y];
tile _ MyFindTile[current: plane.current, x: pos.x, y: pos.y];
IF tile.value=guard THEN ERROR;
plane.current _ tile;
};

MyFindTile: PROC [current: Tile, x, y: Number] RETURNS [Tile] = TRUSTED {
IF current.value=deleted THEN ERROR UseOfAlreadyDeletedTile;
DO
--south-- WHILE y<current.pos.y DO current _ LOOPHOLE[current.wS] ENDLOOP;
--north-- WHILE y>=current.eN.pos.y DO current _ current.eN ENDLOOP;
IF x<current.pos.x THEN --west-- 
WHILE x<current.pos.x DO current _ current.sW ENDLOOP
ELSE IF x>=current.nE.pos.x THEN --east--
WHILE x>=current.nE.pos.x DO current _ LOOPHOLE[current.nE] ENDLOOP
ELSE EXIT
ENDLOOP;
RETURN [current]
};

EWSplit: PROC [plane: Tesselation, tile: Tile, x: Number] RETURNS [east: Tile] = {
t: Tile;
east _ NewTile[];
IF WEdge[tile]>=x OR EEdge[tile]<= x THEN ERROR;
east^ _ tile^;
plane.tileCount _ plane.tileCount + 1;
tile.nE _ RtoP[east];
east.sW _ tile;
east.pos.x _ x;
t _ east.eN;
WHILE t.pos.x>=x DO t.wS _ RtoP[east]; t _ t.sW ENDLOOP;
tile.eN _ t;
t _ NE[east];
WHILE t.sW=tile DO t.sW _ east; t _ WS[t] ENDLOOP;
t _ Below[tile, x];
east.wS _ RtoP[t];
WHILE t.eN=tile DO t.eN _ east; t _ NE[t] ENDLOOP;
RETURN [east]
};

NSSplit: PROC [plane: Tesselation, tile: Tile, y: Number] RETURNS [north: Tile] = {
t: Tile;
north _ NewTile[];
IF SEdge[tile]>=y OR NEdge[tile]<=y THEN ERROR;
north^ _ tile^;
plane.tileCount _ plane.tileCount + 1;
tile.eN _ north;
north.wS _ RtoP[tile];
north.pos.y _ y;
t _ NE[north];
WHILE t.pos.y>=y DO t.sW _ north; t _ WS[t] ENDLOOP;
tile.nE _ RtoP[t];
t _ north.eN;
WHILE t.wS=RtoP[tile] DO t.wS _ RtoP[north]; t _ t.sW ENDLOOP;
t _ tile.sW;
WHILE t.eN.pos.y<=y DO t _ t.eN ENDLOOP;
north.sW _ t;
WHILE NE[t]=tile DO t.nE _ RtoP[north]; t _ t.eN ENDLOOP;
RETURN [north]
};

EWMerge: PROC [plane: Tesselation, tileW, tileE: Tile] RETURNS [Tile] = {
IF tileE.sW#tileW OR NE[tileW]#tileE OR tileW.pos.y#tileE.pos.y OR tileW.eN.pos.y#tileE.eN.pos.y OR tileW.value#tileE.value THEN ERROR;
tileW.eN _ tileE.eN;
tileW.nE _ tileE.nE;
FOR t: Tile _ tileW.eN, t.sW WHILE WS[t]=tileE DO t.wS _ RtoP[tileW] ENDLOOP;
FOR t: Tile _ NE[tileW], WS[t] WHILE t.sW=tileE DO t.sW _ tileW ENDLOOP;
FOR t: Tile _ WS[tileE], NE[t] WHILE t.eN=tileE DO t.eN _ tileW ENDLOOP;
IF plane.current=tileE THEN plane.current _ tileW;
DisposeTile[tileE];
plane.tileCount _ plane.tileCount - 1;
RETURN [tileW];
};

NSMerge: PROC [plane: Tesselation, tileS, tileN: Tile] RETURNS [Tile] = {
IF WS[tileN]#tileS OR tileS.eN#tileN OR tileS.pos.x#tileN.pos.x OR NE[tileS].pos.x#NE[tileN].pos.x OR tileS.value#tileN.value THEN ERROR;
tileS.nE _ tileN.nE;
tileS.eN _ tileN.eN;
FOR t: Tile _ NE[tileS], WS[t] WHILE t.sW=tileN DO t.sW _ tileS ENDLOOP;
FOR t: Tile _ tileS.eN, t.sW WHILE WS[t]=tileN DO t.wS _ RtoP[tileS] ENDLOOP;
FOR t: Tile _ tileN.sW, t.eN WHILE NE[t]=tileN DO t.nE _ RtoP[tileS] ENDLOOP;
IF plane.current=tileN THEN plane.current _ tileS;
DisposeTile[tileN];
plane.tileCount _ plane.tileCount - 1;
RETURN [tileS];
};

RtoP: PROC [r: Tile] RETURNS [LONG POINTER TO TileRec] ~ INLINE {
TRUSTED { RETURN [LOOPHOLE[r]] }
};

Load: Commander.CommandProc = {
cmd.out.PutRope["CornerStiching loaded\n"];
};

InitTesselationBorderTiles[];
Commander.Register[key: "CornerStiching", proc: Load, doc: "loads the CornerStiching"];
END.

@CStitchingImpl.mesa
Copyright Σ 1983, 1986 by Xerox Corporation.  All rights reserved.
Written by Shand, September 12, 1983 11:40 pm PDT
Last Edited by: McCreight, November 28, 1983 5:53 pm
Last Edited by: Jacobi, February 23, 1984 3:59 pm
Last Edited by: Shand, August 6, 1984 4:16:51 am PDT
Last Edited by: Beretta, February 13, 1985 11:46:26 am PST
gbb December 19, 1986 2:14:23 pm PST
Last edited by: Christian Jacobi, November 4, 1986 2:17:58 pm PST
-- Co-ordinates at "infinity"

-- House-keeping tile values to flag deleted tiles and tiles at "infinity"

-- Border Tiles (shared by all tesselations)
-- The stitching is not quite kosher at Guard corners.
-- Think of the guard tile as having bevelled ends  
-- which fit together like a picture-frame and are stitched accordingly.
-- North-East
-- South-East
-- North-West
-- South-West
-- northBuffer
--caller must check that it is not a current tile
--and cache the tile, this is faster than going through the garbage collector
SafeStorage.EnableFinalization[plane];
--Doesnt really garbage collect; use tile in internal cache.
-- Depends on fact that Enumeration proceeds NE to SW, 
-- so eN ref may be clobbered by caching process.
--test whether tiles have same west border, same east border and same value
--split tiles, starting with rider, going eastwards
--rider must intersect splitY horizontal line 
--splitY will belong to the north tiles
--endX is first point not to be split
--knows value to be inserted and might not split the last tile if already right value. ugh
--
--Invariants
--Ia (tiles to the left of rider are handled) 
--Ib (while SEdge[rider]>splitY rider _ WS[rider] wouldnt change rider's left x coordinate)
--at beginning Ia and Ib true because of parameters
--go east
--Ia and Ib
--go south until split line is hit
--Ia and Ib and (rider touches or intersects split line)
--split
--this second test prevents splitting tiles outside area of interest which might have to be remerged later (but ChangeRect wont do it, laying outside)
--I rider touches or intersects split line
--I rider touches or intersects split line
-- tile containing nw corner (right north of area of interest)
-- change values.
--I all northern tiles are already handled
-- split out left part of tile if necessary.
-- make sure we keep outside tile in order NS-wise.
-- right border
--I tile has value  
--I tile.s <=rect.y2  
--I tile touches east border and all northern tiles are already handled
--set tile back up and left; remember, the northern tiles are merged already 
-- restore tile value
-- call user eachRect function

--ChangeEnumerateArea
-- returns the northernmost tile intersecting the changed region.  
-- (there is exactly one such tile! maximal-EW-property)
-- restore maximal East-West strip property

-- split up tiles that horizontally abut any of the tile's four corners, 
-- but extend beyond the corner in a North-South direction
--northeast corner
--northwest corner
-- the tile with EEdge >= w but WEdge < w.  
-- In fact SEdge[tWest] < n holds only if EEdge = w
--southwest corner
--southeast corner
-- analogous to split of northwest corner.

-- convert the West and East adjacent tiles to maximal East-West strips
-- run South to North along the West edge 
-- splitting North-South, merging East-West 
-- tile is the northernmost strip in the changed area.
-- now any maximal-EW-property violations of tile are confined to its Eastern border.  
-- however, some merges at the northern and southern borders may be pending.

-- run North to South along the East edge splitting North-South any tile to 
-- the East which abuts more than one new tile in the changed area.
--I SEdge[tEast]<=s

-- run South to North along the East edge 
-- splitting North-South, merging East-West; eventually merging North-South..
-- Relies on the Maximal East-West strip property.
-- relies on the Maximal East-West strip property.
--find south west corner
-- else the east edge of tile must abut a non-skip tile (Maximal East-West)
--find north east corner by going up starting at the south east corner
-- Uses the tiles own links to maintain an implicit stack of tiles.  
-- Enumeration proceeds in a manner which ensures that a tiles nE and eN 
-- pointers will never be needed once that tile has appeared in the enumeration; 
-- this fact is exploited in ResetTesselation.
-- Defn:	b is a's child iff b.sW = a.
-- correct for one off error when rect.y2 lies at tile boundary (YUK)
--a tile is visited only after all its children
--if child is a child of tile then it is southernmost one
--NOT seeking youth!
-- Is tile a border tile?
-- Find next border tile, i.e. next tree root
Enumerates the tiles neighboring tile in canonical order (positive orientation from the southwestern vertex). On each such tile whose value is different from skip, the call-back procedure eachTile is called.
-- assumes x is within tile (i.e. WEdge[tile] <= x & EEdge[tile] > x)
-- assumes x is within tile (i.e. WEdge[tile] <= x & EEdge[tile] > x)
--a-symmetric
-- the East tile will be the new one.
-- x is west point in new east tile.
-- east starts out a replica of tile
-- Fix the tiles relative to each other.
-- Fix North boundary
-- Fix East boundary
-- Fix South boundary
-- the North tile will be the new one.
-- y is south point of new north tile
-- north starts out a replica of tile
-- Fix the tiles relative to each other.
-- Fix East boundary
-- Fix North boundary
-- Fix West boundary
-- The East tile will be deallocated.
-- The caller must assure that tileW.value=tileE.value and that the tiles really
-- do have a common border of equal length.
--checks
-- Fix the tiles relative to each other.
-- Fix North boundary
-- Fix East boundary
-- Fix South boundary
-- the north tile will be deallocated.
-- the caller must assure that tileS.value=tileN.value and that the tiles really
-- do have a common border of equal length.
--checks
-- Fix the tiles relative to each other.
-- Fix East boundary
-- Fix North boundary
-- Fix West boundary
Just drop it
FinalizeTesselation: ENTRY PROC [plane: CStitching.Tesselation] = {
ENABLE UNWIND => NULL;

InternalDispose: TileProc = {
-- Depends on fact that Enumeration proceeds NE to SW, 
-- so eN ref may be clobbered by caching process.
tile.value _ deleted;
tile.eN _ header;
header _ tile;
};

header: Tile _ NIL;
IF plane.current#NIL THEN EnumerateArea[plane, maxSpace, InternalDispose, NIL, deleted];
plane.current _ plane.southEast _ NIL;
plane.data _ NIL;
WHILE header#NIL DO
t: Tile _ header;
header _ header.eN;
t.sW _ t.eN _ NIL; t.nE _ t.wS _ NIL;
ENDLOOP; 
};

FinalizerProcess: PROC[fooFQ: SafeStorage.FinalizationQueue] = {
DO
foo: CStitching.Tesselation = NARROW[SafeStorage.FQNext[fooFQ]];
FinalizeTesselation[foo];
ENDLOOP
};

fooFQ: SafeStorage.FinalizationQueue = SafeStorage.NewFQ[];
SafeStorage.EstablishFinalization[CODE[CStitching.TesselationRec], 0, fooFQ];
TRUSTED {Process.Detach[FORK FinalizerProcess[fooFQ]]};

Edited on February 8, 1985 4:40:46 pm PST, by Jacobi
Formatting
MyFindTile completely rewritten

Edited on September 30, 1985 1:43:22 pm PDT, by Jacobi
Correct comments when which procedure is valid included in definition
EnumerateArea and ListArea made two procedures whith simpler parameters

Edited on December 12, 1985 6:28:29 pm PST, by Jacobi
maxSpace introduced,

Edited on January 14, 1986 7:07:36 pm PST, by Jacobi
finalization introduced

Edited on January 17, 1986 4:06:17 pm PST, by Jacobi
comments, invariants, shorter,
bug correction in ChangeTile, 
Below, WS, NE introduced

Edited on March 18, 1986 5:51:41 pm PST, by Jacobi
better names,
better parameters 
gbb December 19, 1986 2:12:57 pm PST
Implemented EnumerateNeighborhood.
changes to: EnumerateNeighborhood: new.

ΚX˜
code™Kš
œB™BKš
œ1™1K™4K™1K™4K™:K™$K™AK˜—š
Οk	˜	KšœœΟc˜4—K˜šΟnœœ
˜Kšœœ
ž˜;Kšœ
˜—Kšœ
˜Kšœ˜K˜Kšœœœ
˜&K˜™Kšœœœ˜0Kšœœœ˜1Kšœœœ˜2Kšœœœ˜1Kš	œœœ
œœ˜^Kš
œ^˜^K˜Kš	œœ
œœ
œ˜V—K™™JKšœœœ
œ˜(Kšœœœ˜(Kšœ	œœ˜,—K™™,Kšœœ)˜?Kšœœ<˜SKšœœ)˜?Kšœœ)˜>Kšœœ)˜>—K˜Kšœ
œœœ˜+K˜Kšœœ
˜Kšœœœ
˜"K˜šŸœœ˜$K™6K™4K™H™
Kš
œ ˜ Kš
œ˜—™
Kš
œ˜Kš
œ ˜ Kš
œ ˜ Kš
œ˜—™
Kš
œ ˜ Kš
œ˜Kš
œ˜Kš
œ ˜ —™
Kš
œ˜Kš
œ ˜ —š
œ™Kš
œ˜Kš
œ!˜!Kš
œ˜Kšœœ
˜—Kš
œ˜—K˜šŸ	œœ
œ
œ˜ Kšœ
œœ
˜Kšœœ˜šœœ
œ˜Kš
œ˜šœ$œœ
˜6Kšœ	œ˜Kšœœ
˜Kšœ
˜—Kšœ˜K˜—šœœ
œ˜Kšœœ˜"Kš
œ˜š
œœœœœœ
˜bKšœœ˜ Kšœœ
˜Kšœ
˜—Kšœ˜K˜—Kš
œ˜—K˜šŸœœ
œ
œ˜,Kšœ
œœ
˜Kš
œ˜Kš
œ˜—K˜š
Ÿœœ
œ
œœ˜>šœœ
œ˜Kš
œ˜Kš
œ!˜!K˜
—Kšœœ
˜Kš
œ˜—K˜šŸœœ
œ˜(Kš
œ1™1Kš
œM™MKšœ
œœ
˜Kšœ
œž;˜KKšœœ
˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—K˜šŸœœ
œœ
œœœ˜SKšœ
œœ
˜šœœ
œ˜Kš
œ˜Kšœœ˜2K˜
—Kšœœ˜Kš
œ#˜#Kš
œ˜—K˜šŸœœ
œœ˜8Kšœ
œœ
˜Kš
œ%˜%Kš
œ˜Kš
œ˜—K˜šŸœœ
œ˜-Kš
œ$˜$Kš
œ&˜&š
œ˜Kš
œL˜LKš
œ!˜!Kš
œ˜Kš
œ˜—š
œ˜Kš
œK˜KKš
œ!˜!Kšœ˜
Kš
œ˜—Kšœ<œ*˜iKšœœ
œœ
œ
œ˜<Kš
œ˜—K˜šŸœœ

œœ
œœ
œ
œœ˜jKšœœ#œœ#˜fKš
œ
˜
Kš
œ&™&Kš
œ˜—K˜K˜šΠbnœœ
œ˜6Kš
œ<™<K•StartOfExpansionH -- [tile: CornerStitching.TilePtr, data: REF ANY] RETURNS [REF ANY] -- ˜šŸ
œœ˜&šœœ
˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœ˜	—Kš
œ˜—K˜š œ˜Kš
œ7™7Kš
œ1™1Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—K˜šŸœœ
œ˜,Kš
œ
˜
K˜K˜—Kšœœ
˜šœœ
œ˜Kšœ(œ˜6Kš
œ˜Kš
œ˜K˜—Kš
œ˜—K˜š
Ÿœœœœœ˜9Kš
œK™KKš
œœœ
œ
œ
˜HKš
œ˜K˜—šŸ
œœ
œ'œ
œœ˜PK˜šŸœœ(˜<Kš
œ3™3Kš
œ.™.Kš
œ'™'Kš
œ%™%Kš
œZ™ZKš
™š
ž™Kšžœ
ž&œ
ž
™.Kšœž
œ"œžœž™[—K™3Kš
œ	™	šœ˜Kš
ž™Kš
œ"™"Kš	œœ	œœž˜WKšžœ-™8K™šœœ˜Kš
œ–
™–
šœœžœ
œ
˜KKš
œ&˜&Kš
œ*™*—K˜—Kš
œ*™*Kšœœ	ž8ž˜QKšœ
˜—Kš
œ˜—K˜Kš
œ˜Kšœ
œ˜$Kšœ
œ˜$Kšœ
œ˜$Kšœ
œ˜$Kšœœœ
œ
˜4Kš
œ3˜3K™>Kš
œ˜Kšœ(ž˜6KšœNž˜^Kš
œ™Kš
œ5˜5š
˜K™*Kš
œ,™,šœœœ˜0Kš
œ˜Kš
œ*˜*Kš
œ˜K™3Kšœœ&˜IKšœœœœ˜KK˜—šœ
žA˜Dšœœ˜Kš
œ™šœœ˜Kš
œ1˜1Kšœœ)˜NKšœœ	œœ˜PK˜—Kšœ'ž&˜MK˜K™—Kšœœ
œ
˜"Kšœœ˜Kš	œœœœž˜=Kš
œ™Kšœ
˜—Kš
œG™GKšœœ
œ
˜"Kšœœ
œ
˜"Kš
œM™MKš
œ˜Kš
˜—Kš
œ˜—K˜K˜šŸœœ
œ<œœœ˜uK–H -- [tile: CornerStitching.TilePtr, data: REF ANY] RETURNS [REF ANY] -- ˜šΟbœ˜Kš
œ%˜%Kš
œ˜—K–H -- [tile: CornerStitching.TilePtr, data: REF ANY] RETURNS [REF ANY] -- ˜š‘œ˜Kšœ
œœ
˜,š
œ˜Kšœ˜Kšœ˜Kšœ˜Kšœ˜Kšœž/˜2—K™Kš
œ5˜5Kš
œ™KšœœU˜vKš
œ˜Kš
œ˜—K™Kš
œ™Kšœ)œ˜7Kš
œ;˜;Kš
œ˜—K˜šŸ
œœ
œ'œœœ˜TKšœœ$˜:Kš
œ˜—K˜šŸœœ'œœ˜PK™CK™8K˜K˜K˜K˜Kš
œ˜Kšœœ
œ˜%Kš
œ˜Kš
œ+™+K™Kš
‘I™IKš
œ:™:K™Kšœœ˜Kšœœœ˜IK™Kšœž˜)Kšœœœ
˜2Kš
œ,™,Kš
œ3™3Kšœœœ˜IK™Kš
œ˜Kšœœœ˜IK™Kšœœ˜Kšœœ	œœ
˜3K™*Kšœœœ˜IK™Kš
‘G™GKš
œ*™*Kš
œ,™,K˜šœ˜Kšœœœ˜?šœ˜Kš
œ*˜*Kšœœœ	˜>K˜K˜
—Kšœ
˜—Kš
œ6™6Kšœœ$˜;Kš
œW™WKš
œL™LK™Kš
œL™LKš
œC™CKšœœ˜šœ˜K˜š	œœ
œœ˜MKš
œ(˜(—Kšœœ˜Kšœ
˜—Kš
œ™K™Kš
œ*™*Kš
œM™MKšœž˜$Kšœœœ
˜5š
˜Kšœž˜%Kšœž ˜2šœ
œœ˜Kšœœœ˜EKšœœ˜%K˜—Kšœœœœ˜KKšœœ
˜Kšœ
˜—K˜Kšœœ"˜EKšœ˜
Kš
œ˜—K˜šŸœœ
œ(œ
œœœœ˜]Kš
œ2™2Kšœ
œ˜$Kšœ
œ˜$Kšœ
œ˜$Kšœ
œ˜$Kš
œœœ
œœ˜9Kš
œ<˜<šœ2œ˜QKš
œœœ
œœ
˜=Kšœ
˜—Kšœœ
˜
Kš
œ˜—K˜šŸœœ
œ(œœœ˜dKš
œ2™2Kš
œ˜Kšœ
œ˜$Kšœ
œ˜$Kšœ
œ˜$Kšœ
œ˜$Kšœœœ
œ	˜:Kš
œ™Kš
œ<˜<šœ,˜1Kšœœ
œž˜7Kšœœœ
˜3Kšœ
˜—Kšœ
œ˜$šœ˜Kšœœœ˜2Kš
œK™KKšœœœ˜JKš
œ˜Kšœ
˜—Kš
œF™FKš
œ5˜5šœ˜šœœ˜Kš
œ˜Kš
œ˜K˜
—šœ
œœ˜"Kšœ
œ˜$Kš
œ˜K˜—Kš
œ˜Kšœ
˜—Kš
œ˜—K˜šŸ
œœ
œ<œœœ˜oKš
œE™EKš
œI™IKš
œQ™QKš
œ.™.Kš
œ%™%K˜š
Ÿœœœœœ˜=Kšœœ˜)K˜—K˜š
Ÿ	œœœœœ˜?Kšœœ˜,K˜—K˜Kš
œ˜Kšœœœ
˜ Kšœ
œ˜$Kšœ
œ˜$Kšœ
œ˜$Kšœ
œ˜$Kšœœœ
œ
˜4Kš
œ3˜3K™EKšœœœ˜PKš
œ˜K™/šœ˜Kšœ0ž	˜9š
˜šœœ˜Kšœœ˜Kšœœ	œœ
˜9Kš
œ9™9šœœœ˜7Kš
œ
˜
Kš
˜K˜
—Kšœž ˜:K˜—Kš
œ™Kš
œ
˜
K™šœœœ˜6K™-K˜Kšœœ˜7šœ˜Kšœœ˜5šœ˜Kšœœ˜Kšœœœœ
˜5K˜
—K˜
—K˜
—šœ˜šœœœ˜#Kšœœž	˜K˜K˜
—Kšœž	˜K˜—Kšœœž˜DKšœœ
˜Kš
˜—Kšœ
˜—Kš
œ˜—K˜šŸœœ
œ(œœœœ
œ
œœ˜pš‘œ˜šœœ
œ˜š
œ˜Kšœ˜Kšœ˜Kšœ˜Kšœ˜Kš
œ˜—Kš
œ
˜
Kš
œ˜—Kš
œ˜—Kšœ$œ˜/Kš
œ˜—
code2šŸœœ
œ<œœœœ˜
Kšœ!Οeœy’œ’œ™Ο
Jš
œ˜Jš
œ ˜ Jš
œ˜Jš
œ ˜ 
unitš	œœœ
œ˜PKšœœ˜;Kšœ
˜—š	œœœ
œ˜NKšœœ˜9Kšœ
˜—š	œœœ
œ˜PKšœœ˜;Kšœ
˜—š	œœœ
œ˜NKšœœ˜9Kš
˜—Kšœž˜—K˜šŸœœœ
œ˜@Kš
œE™EKšœœ˜
Kš
œ
œ
œœœ
˜*Kš
œ˜—K˜šŸœœœ
œ˜@Kš
œE™EKš
œ˜Kšœœ
œ
˜$Kš
œ˜—K˜šŸœœ
œ œ˜MKšœœ˜ Kšœœ˜ Kš
œ>˜>Kšœœ
œ
˜Kš
œ˜Kš
œ˜—K˜šŸ
œœœ
œ˜IKš
œ
™
Kšœœ
œ˜<š
˜Kš
ž	œ
œœœ
œ
˜JKšž	œ
œœœ
˜Dšœžœ
˜!Kšœœ˜5—šœ
œœ
ž˜)Kšœœœ
˜C—Kšœ
˜	Kšœ
˜—Kšœ
˜Kš
œ˜—K˜šŸœœ-œ˜RKš
œ%™%Kš
œ$™$Kš
œ˜Kš
œ˜Kšœœœ
œ
˜0Kš
œ$™$Kš
œ˜Kš
œ&˜&K™(Kš
œ˜Kš
œ˜K˜K™Kš
œ˜Kšœœœ
˜8Kš
œ˜K™Kšœœ˜
Kšœœœœ
˜2K™Kš
œ˜Kš
œ˜Kšœœœœ
˜2Kšœ˜
Kš
œ˜—K˜šŸœœ-œ˜SKš
œ&™&Kš
œ%™%Kš
œ˜Kš
œ˜Kšœœœ
œ
˜/Kš
œ%™%Kš
œ˜Kš
œ&˜&K™(Kš
œ˜Kš
œ˜Kš
œ˜K™Kšœœ˜Kšœœœœ
˜4K˜K™Kš
œ
˜
Kšœœœ
˜>K™Kš
œ˜Kšœœ
œ
˜(Kš
œ
˜
Kšœ
œ	œœ
˜9Kšœ˜Kš
œ˜—K˜šŸœœ*œ˜IK™%Kš
œP™PK™+Kš
œ™Kšœœ
œœœœœ
œ
˜‡
K™(Kš
œ˜Kš
œ˜K™Kš
œœ
œ
œœ
˜MK™Kšœœ	œœœ
œ
˜HK™Kšœœ	œœœ
œ
˜HKšœœ˜2Kš
œ˜Kš
œ&˜&Kšœ	˜Kš
œ˜—K˜šŸœœ*œ˜IK™&Kš
œP™PK™+Kš
œ™Kšœ
œœœœ
œœœœ
œ
˜‰
K™(Kš
œ˜Kš
œ˜K™Kšœœ	œœœ
œ
˜HK™Kš
œœ
œ
œœ
˜MK™Kš
œœ
œ
œœ
˜MKšœœ˜2K˜Kš
œ&˜&Kšœ	˜Kš
œ˜—K˜šŸœœœœ
œ
œœ
˜AKšœœœ˜ K˜—K˜š‘œ˜Kš
œ+˜+Kš
œ˜K˜—Kš
Ÿ™šŸœœ
œ$™CKšœ
œœ
™K™š œ™Kš
œ7™7Kš
œ1™1Kš
œ™Kš
œ™Kš
œ™Kš
œ™—K™Kšœœ
™Kšœœ
œ1œ™XKšœ"œ
™&Kšœ
œ
™šœœ
™Kš
œ™Kš
œ™Kšœœœ
™%Kšœ™	—Kš
œ™—K™šŸœœ*™@š
™Kšœœ™@Kš
œ™Kš
™—Kš
œ™—K™Kš
œ;™;Kšœ"œ'™MKšœœ™7K™Kš
œ˜Kš
œW˜WKšœ
˜K˜™4K™
Kš
œ™—K™š
œ6™6K™EK™G—K™š
œ5™5K™—K™š
œ4™4K™—K™š
œ4™4K™K™K™—K™š
œ2™2K™
K™—™$KšœΟrœ
™"Kšœ£œ™'—K™—…—D"Ί