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];
};

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 c 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
Last edited by: Christian Jacobi, October 15, 1986 4:56:01 pm PDT
-- 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
-- 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 
Κ˜
code™Kšœ
Οm
œ7™BKš
œ1™1K™4K™1K™4K™: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š
œ˜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˜—…—@²y©