<> <> <> <> <> <> <> <> DIRECTORY Commander, CornerStitching, IO, Process, SafeStorage; CornerStitchingImpl: CEDAR MONITOR IMPORTS Commander, IO, Process, SafeStorage EXPORTS CornerStitching = BEGIN Tesselation: TYPE = CornerStitching.Tesselation; Tile: TYPE = CornerStitching.Tile; Number: TYPE = CornerStitching.Number; Pos: TYPE = CornerStitching.Pos; CsRect: TYPE = CornerStitching.CsRect; PerTileProc: TYPE = CornerStitching.PerTileProc; PerTileChangeProc: TYPE = CornerStitching.PerTileChangeProc; Region: TYPE = CornerStitching.Region; UseOfAlreadyDeletedTile: ERROR = CODE; NEdge: PROC [t: REF Tile] RETURNS [Number] = INLINE {RETURN [t.en.pos.y]}; EEdge: PROC [t: REF Tile] RETURNS [Number] = INLINE {RETURN [NE[t].pos.x]}; SEdge: PROC [t: REF Tile] RETURNS [Number] = INLINE {RETURN [t.pos.y]}; WEdge: PROC [t: REF Tile] RETURNS [Number] = INLINE {RETURN [t.pos.x]}; <<>> <<-- Co-ordinates at "infinity">> 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: CsRect = [x1: Number.FIRST+1, y1: Number.FIRST, x2: Number.LAST-1, y2: Number.LAST-1]; maxSpace: CsRect = [x1: allSpace.x1+1, y1: allSpace.y1+1, x2: allSpace.x2-1, y2: allSpace.y2-1]; empty: CsRect = [x1: Number.LAST, y1: Number.LAST, x2: Number.FIRST, y2: Number.FIRST]; <<>> <<-- House-keeping tile values to flag deleted tiles and tiles at "infinity">> PrivateRec: TYPE = RECORD[notused: REF]; guard: REF = NEW[PrivateRec_[$CSGuard]]; deleted: REF = NEW[PrivateRec_[$CSDeleted]]; <<>> <<-- Border Tiles (shared by all tesselations)>> northLimit: REF Tile = NEW[Tile _ [pos: nwLimit, value: guard]]; northBuffer: REF Tile = NEW[Tile _ [pos: [allSpace.x1, allSpace.y2], value: guard]]; southLimit: REF Tile = NEW[Tile _ [pos: swLimit, value: guard]]; eastLimit: REF Tile = NEW[Tile _ [pos: seLimit, value: guard]]; westLimit: REF Tile = NEW[Tile _ [pos: swLimit, value: guard]]; Disguise: TYPE = RECORD [hiddenValue: REF]; disposedTiles: REF Tile _ NIL; disguiseCache: REF Disguise _ NIL; InitTesselationBorderTiles: PROC = BEGIN <<-- 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>> northLimit.ne _ RtoP[eastLimit]; eastLimit.en _ northLimit; <<-- South-East>> southLimit.en _ eastLimit; southLimit.ne _ RtoP[eastLimit]; eastLimit.ws _ RtoP[southLimit]; eastLimit.sw _ southLimit; <<-- North-West>> westLimit.ne _ RtoP[northLimit]; westLimit.en _ northLimit; northLimit.sw _ westLimit; northLimit.ws _ RtoP[westLimit]; <<-- South-West>> southLimit.sw _ westLimit; westLimit.ws _ RtoP[southLimit]; <<-- northBuffer>> northBuffer.en _ northLimit; northBuffer.ne _ RtoP[eastLimit]; northBuffer.sw _ westLimit; northBuffer.ws _ NIL; END; DumpCache: PUBLIC ENTRY PROC = BEGIN ENABLE UNWIND => NULL; IF disposedTiles#NIL THEN { lag: REF Tile _ disposedTiles; FOR tc: REF Tile _ disposedTiles.en, tc.en WHILE tc#NIL DO lag.en _ NIL; lag _ tc ENDLOOP; disposedTiles _ NIL }; IF disguiseCache#NIL THEN { lag: REF Disguise _ disguiseCache; FOR dc: REF Disguise _ NARROW[disguiseCache.hiddenValue], NARROW[dc.hiddenValue] WHILE dc # NIL DO lag.hiddenValue _ NIL; lag _ dc ENDLOOP; disguiseCache _ NIL }; END; NewTile: ENTRY PROC RETURNS [tile: REF Tile] = BEGIN ENABLE UNWIND => NULL; tile _ InternalNewTile[]; END; InternalNewTile: INTERNAL PROC RETURNS [tile: REF Tile] = INLINE BEGIN IF disposedTiles#NIL THEN { tile _ disposedTiles; disposedTiles _ disposedTiles.en; } ELSE tile _ NEW[Tile]; END; DisposeTile: ENTRY PROC [tile: REF Tile] = <<--caller must check that it is not a current tile>> <<--and cache the tile, this is faster than going through the garbage collector>> BEGIN 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; END; NewDisguise: ENTRY PROC [hiddenValue: REF_NIL] RETURNS [disguise: REF Disguise] = BEGIN ENABLE UNWIND => NULL; IF disguiseCache#NIL THEN { disguise _ disguiseCache; disguiseCache _ NARROW[disguiseCache.hiddenValue]; } ELSE disguise _ NEW[Disguise]; disguise.hiddenValue _ hiddenValue; END; DisposeDisguise: ENTRY PROC [disguise: REF Disguise] = BEGIN ENABLE UNWIND => NULL; disguise.hiddenValue _ disguiseCache; disguiseCache _ disguise; END; Setup: INTERNAL PROC [plane: REF Tesselation] = BEGIN eastSpace: REF Tile = InternalNewTile[]; centreSpace: REF 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, tilesInTesselationCount: 1]; IF plane.stopFlag=NIL THEN plane.stopFlag _ NEW[BOOL_FALSE]; END; NewTesselation: PUBLIC ENTRY PROC [data: REF_NIL, stopFlag: REF BOOL_NIL] RETURNS [plane: REF Tesselation] = BEGIN plane _ NEW[CornerStitching.Tesselation_[NIL, NIL, 1, stopFlag, data]]; Setup[plane]; SafeStorage.EnableFinalization[plane]; END; FreeTesselation: PUBLIC PROC [plane: REF Tesselation, freeCache: BOOL] = <<--This is to help the Garbage Collector (by NILing all REFs).>> BEGIN CacheTileList: PROC [header: REF Tile] = { WHILE header#NIL DO t: REF Tile _ header; header _ header.en; DisposeTile[t]; ENDLOOP; }; CacheIt: PerTileProc = { <<-- 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; }; MySetup: ENTRY PROC [plane: REF Tesselation] = { Setup[plane]; }; header: REF Tile _ NIL; IF plane#NIL THEN { EnumerateArea[plane, maxSpace, CacheIt, NIL, deleted]; CacheTileList[header]; MySetup[plane]; }; IF freeCache THEN DumpCache[]; END; EWCompatible: PROC [a, b: REF Tile] RETURNS [BOOL] = INLINE { <<--test whether tiles have same west border, same east border and same value>> 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: REF Tesselation, rect: CsRect, newValue: REF ANY _ NIL] = BEGIN SplitEWRunning: PROC [rider: REF Tile, splitY, endX: Number] = <<--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>> BEGIN <<--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>> WHILE WEdge[rider]> <<--go south until split line is hit>> WHILE SEdge[rider]>splitY DO rider _ WS[rider] ENDLOOP; --won't go left nor right! (Ib) <<--Ia and Ib and (rider touches or intersects split line)>> <<--split>> IF SEdge[rider]> IF EEdge[rider]> }; <<--I rider touches or intersects split line>> rider _ NE[rider]; --reinstalls Ia and Ib (Ib because old rider limits all WS..) ENDLOOP; END; tile: REF 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 _ FindTile[plane.current, rect.x1, rect.y2]; <<-- tile containing nw corner (right north of area of interest)>> plane.current _ tile; SplitEWRunning[tile, rect.y2, rect.x2]; --north border SplitEWRunning[FindTile[plane.current, rect.x1, rect.y1], rect.y1, rect.x2]; --south border <<-- change values.>> tile _ FindTile[plane.current, rect.x1, rect.y2-1]; DO <<--I all northern tiles are already handled>> <<-- split out left part of tile if necessary.>> IF tile.value#newValue AND WEdge[tile]> 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#newValue THEN { <<-- right border>> IF EEdge[tile]>rect.x2 THEN { right: REF 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, newValue]; --returns northernmost tile if changed }; <<--I tile has value >> IF EEdge[tile]>=rect.x2 THEN EXIT; tile _ NE[tile]; WHILE SEdge[tile]>=rect.y2 DO tile _ WS[tile] ENDLOOP; -- EMM <<--I tile.s <=rect.y2 >> ENDLOOP; <<--I tile touches east border and all northern tiles are already handled>> IF WEdge[tile]>rect.x1 THEN ERROR; IF SEdge[tile]<=rect.y1 THEN EXIT; <<--set tile back up and left; remember, the northern tiles are merged already >> tile _ Below[tile, rect.x1]; ENDLOOP END; FuncChangeRect: PUBLIC PROC [plane: REF Tesselation, rect: CsRect, perTile: PerTileChangeProc, data: REF _ NIL] = BEGIN DisguiseTile: PerTileProc = BEGIN tile.value _ NewDisguise[tile.value]; END; ApplyFuncToTile: PerTileProc = BEGIN disguise: REF Disguise = NARROW[tile.value]; clippedBB: CsRect = [ 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 <<-- restore tile value>> [] _ MyChangeTile[plane, tile, disguise.hiddenValue]; <<-- call user perTile function>> perTile[plane: plane, rect: clippedBB, oldValue: disguise.hiddenValue, data: data]; DisposeDisguise[disguise]; END; <<>> <<--FuncChangeRect>> EnumerateArea[plane, rect, DisguiseTile, NIL, deleted]; EnumerateArea[plane, rect, ApplyFuncToTile, data, deleted]; END; ChangeTile: PUBLIC PROC [plane: REF Tesselation, tile: REF Tile, newValue: REF _ NIL] = TRUSTED BEGIN IF tile.value#newValue THEN [] _ MyChangeTile[plane, tile, newValue] END; MyChangeTile: PROC [plane: REF Tesselation, tile: REF Tile, new: REF] RETURNS [REF Tile] = <<-- returns the northernmost tile intersecting the changed region. >> <<-- (there is exactly one such tile! maximal-EW-property)>> BEGIN n: Number = NEdge[tile]; e: Number = EEdge[tile]; s: Number = SEdge[tile]; w: Number = WEdge[tile]; tWest, tEast, tNorth: REF Tile; IF tile.value=new THEN RETURN [tile]; tile.value _ new; <<-- 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>> tEast _ NE[tile]; IF tEast.value=new AND NEdge[tEast]>n THEN [] _ NSSplit[plane, tEast, n]; <<--northwest corner>> tWest _ tile.en; --east now but west soon WHILE WEdge[tWest]>=w DO tWest _ tWest.sw ENDLOOP; <<-- the tile with EEdge >= w but WEdge < w. >> <<-- In fact SEdge[tWest] < n holds only if EEdge = w>> IF tWest.value=new AND SEdge[tWest]> tWest _ tile.sw; IF tWest.value=new AND SEdge[tWest]> tEast _ WS[tile]; WHILE EEdge[tEast]<=e DO tEast _ NE[tEast] ENDLOOP; <<-- analogous to split of northwest corner.>> IF tEast.value=new AND NEdge[tEast]>s THEN [] _ NSSplit[plane, tEast, s]; <<>> <<-- 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 >> tWest _ tile.sw; WHILE NEdge[tWest]> IF tWest.value=new THEN tile _ EWMerge[plane, tWest, tile]; <<-- 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.>> tEast _ NE[tile]; WHILE SEdge[tEast]>s DO tile _ tEast.sw; IF (tEast.value=new OR WS[tEast].value=new) AND SEdge[tile]> <<>> <<-- run South to North along the East edge >> <<-- splitting North-South, merging East-West; eventually merging North-South..>> 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] END; AreaEmpty: PUBLIC PROC [plane: REF Tesselation, rect: CsRect, skipValue: REF ANY _ NIL] RETURNS [BOOL] = <<-- Relies on the Maximal East-West strip property.>> BEGIN 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 _ FindTile[plane.current, rect.x1, rect.y1]; FOR tile: REF Tile _ plane.current, Above[tile, rect.x1] WHILE SEdge[tile]> BEGIN tile: REF 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]; <<--find south west corner>> plane.current _ FindTile[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#skipValue OR EEdge[tile]> IF EEdge[tile]> tile _ FindTile[plane.current, rect.x2-1, rect.y1]; WHILE SEdge[tile]rect.x1 THEN { bBox.x2 _ MAX[bBox.x2, WEdge[tile]]; bBox.y2 _ NEdge[tile] }; tile _ Above[tile, rect.x2-1]; ENDLOOP; END; EnumerateArea: PUBLIC PROC [plane: REF Tesselation, rect: CsRect, perTile: PerTileProc, data: REF _ NIL, skipValue: REF] = <<-- 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 FreeTesselation.>> <<-- Defn: b is a's child iff b.sw = a.>> BEGIN IsChild: PROC [me: REF Tile, you: REF Tile] RETURNS [BOOL] = INLINE { RETURN [you.sw=me AND you.pos.y>rect.y1]; }; IsBrother: PROC [me: REF Tile, you: REF Tile] RETURNS [BOOL] = INLINE { RETURN [me.sw=you.sw AND you.pos.y>rect.y1]; }; tile: REF Tile; visit: REF 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 _ FindTile[plane.current, rect.x1, rect.y2]; <<-- correct for one off error when rect.y2 lies at tile boundary (YUK)>> IF SEdge[tile]=rect.y2 AND SEdge[tile]>rect.y1 THEN tile _ Below[tile, rect.x1]; plane.current _ tile; <<--a tile is visited only after all its children>> WHILE ~doneSouthEastTile DO seeking: {youth, experience, nothing} _ youth; --of tile DO IF seeking=youth THEN { child: REF Tile _ NE[tile]; WHILE SEdge[child]>=rect.y2 DO child _ WS[child] ENDLOOP; <<--if child is a child of tile then it is southernmost one>> IF IsChild[tile, child] AND WEdge[child]> visit _ tile; <<-- Is tile a border tile?>> IF WEdge[tile]<=rect.x1 OR SEdge[tile]<=rect.y1 THEN { <<-- Find next border tile, i.e. next tree root>> 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#skipValue THEN perTile[visit, data]; --must not fool tile IF seeking=nothing THEN EXIT ENDLOOP ENDLOOP; END; ListArea: PUBLIC PROC [plane: REF Tesselation, rect: CsRect, skipValue: REF _ NIL] RETURNS [rl: LIST OF REF Region_NIL] = BEGIN PerTile: PerTileProc = { 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, skipValue]; END; Below: PROC [tile: REF Tile, x: Number] RETURNS [t: REF Tile] = INLINE <<-- assumes x is within tile (i.e. WEdge[tile] <= x & EEdge[tile] > x)>> BEGIN t _ WS[tile]; WHILE NE[t].pos.x<=x DO t _ NE[t] ENDLOOP; END; Above: PROC [tile: REF Tile, x: Number] RETURNS [t: REF Tile] = INLINE <<-- assumes x is within tile (i.e. WEdge[tile] <= x & EEdge[tile] > x)>> BEGIN t _ tile.en; WHILE t.pos.x>x DO t _ t.sw ENDLOOP; END; TileAt: PUBLIC PROC [plane: REF Tesselation, pos: Pos] RETURNS [tile: REF Tile] = BEGIN pos.x _ MIN[maxSpace.x2, pos.x]; pos.y _ MIN[maxSpace.y2, pos.y]; tile _ FindTile[current: plane.current, x: pos.x, y: pos.y]; IF tile.value=guard THEN ERROR; plane.current _ tile; END; FindTile: PROC [current: REF Tile, x, y: Number] RETURNS [REF Tile] = <<--a-symmetric>> TRUSTED BEGIN IF current.value=deleted THEN ERROR UseOfAlreadyDeletedTile; DO --south-- WHILE y=current.en.pos.y DO current _ current.en ENDLOOP; 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] END; EWSplit: PROC [plane: REF Tesselation, tile: REF Tile, x: Number] RETURNS [east: REF Tile] = <<-- the East tile will be the new one.>> <<-- x is west point in new east tile.>> BEGIN t: REF Tile; east _ NewTile[]; IF WEdge[tile]>=x OR EEdge[tile]<= x THEN ERROR; <<-- east starts out a replica of tile>> east^ _ tile^; plane.tilesInTesselationCount _ plane.tilesInTesselationCount + 1; <<-- Fix the tiles relative to each other.>> tile.ne _ RtoP[east]; east.sw _ tile; east.pos.x _ x; <<-- Fix North boundary>> t _ east.en; WHILE t.pos.x>=x DO t.ws _ RtoP[east]; t _ t.sw ENDLOOP; tile.en _ t; <<-- Fix East boundary>> t _ NE[east]; WHILE t.sw=tile DO t.sw _ east; t _ WS[t] ENDLOOP; <<-- Fix South boundary>> t _ Below[tile, x]; east.ws _ RtoP[t]; WHILE t.en=tile DO t.en _ east; t _ NE[t] ENDLOOP; RETURN [east] END; NSSplit: PROC [plane: REF Tesselation, tile: REF Tile, y: Number] RETURNS [north: REF Tile] = <<-- the North tile will be the new one.>> <<-- y is south point of new north tile>> BEGIN t: REF Tile; north _ NewTile[]; IF SEdge[tile]>=y OR NEdge[tile]<=y THEN ERROR; <<-- north starts out a replica of tile>> north^ _ tile^; plane.tilesInTesselationCount _ plane.tilesInTesselationCount + 1; <<-- Fix the tiles relative to each other.>> tile.en _ north; north.ws _ RtoP[tile]; north.pos.y _ y; <<-- Fix East boundary>> t _ NE[north]; WHILE t.pos.y>=y DO t.sw _ north; t _ WS[t] ENDLOOP; tile.ne _ RtoP[t]; <<-- Fix North boundary>> t _ north.en; WHILE t.ws=RtoP[tile] DO t.ws _ RtoP[north]; t _ t.sw ENDLOOP; <<-- Fix West boundary>> 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] END; EWMerge: PROC [plane: REF Tesselation, tileW, tileE: REF Tile] RETURNS [REF Tile] = <<-- 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.>> BEGIN <<--checks>> 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; <<-- Fix the tiles relative to each other.>> tileW.en _ tileE.en; tileW.ne _ tileE.ne; <<-- Fix North boundary>> FOR t: REF Tile _ tileW.en, t.sw WHILE WS[t]=tileE DO t.ws _ RtoP[tileW] ENDLOOP; <<-- Fix East boundary>> FOR t: REF Tile _ NE[tileW], WS[t] WHILE t.sw=tileE DO t.sw _ tileW ENDLOOP; <<-- Fix South boundary>> FOR t: REF 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.tilesInTesselationCount _ plane.tilesInTesselationCount - 1; RETURN [tileW]; END; NSMerge: PROC [plane: REF Tesselation, tileS, tileN: REF Tile] RETURNS [REF Tile] = <<-- 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.>> BEGIN <<--checks>> 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; <<-- Fix the tiles relative to each other.>> tileS.ne _ tileN.ne; tileS.en _ tileN.en; <<-- Fix East boundary>> FOR t: REF Tile _ NE[tileS], WS[t] WHILE t.sw=tileN DO t.sw _ tileS ENDLOOP; <<-- Fix North boundary>> FOR t: REF Tile _ tileS.en, t.sw WHILE WS[t]=tileN DO t.ws _ RtoP[tileS] ENDLOOP; <<-- Fix West boundary>> FOR t: REF 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.tilesInTesselationCount _ plane.tilesInTesselationCount - 1; RETURN [tileS]; END; WS: PROC [t: REF Tile] RETURNS [REF Tile] = INLINE { TRUSTED { RETURN [LOOPHOLE[t.ws]] } }; NE: PROC [t: REF Tile] RETURNS [REF Tile] = INLINE { TRUSTED { RETURN [LOOPHOLE[t.ne]] } }; RtoP: PROC [r: REF Tile] RETURNS [LONG POINTER TO Tile] ~ INLINE { TRUSTED { RETURN [LOOPHOLE[r]] } }; Load: Commander.CommandProc = { cmd.out.PutRope["CornerStiching loaded\n"]; }; FinalizeTesselation: ENTRY PROC [plane: REF CornerStitching.Tesselation] = BEGIN ENABLE UNWIND => NULL; InternalDispose: PerTileProc = <<-- Depends on fact that Enumeration proceeds NE to SW, >> <<-- so en ref may be clobbered by caching process.>> BEGIN tile.value _ deleted; tile.en _ header; header _ tile; END; header: REF 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: REF Tile _ header; header _ header.en; t.sw _ t.en _ NIL; t.ne _ t.ws _ NIL; ENDLOOP; END; FinalizerProcess: PROC[fooFQ: SafeStorage.FinalizationQueue] = BEGIN DO foo: REF CornerStitching.Tesselation = NARROW[SafeStorage.FQNext[fooFQ]]; FinalizeTesselation[foo]; ENDLOOP END; fooFQ: SafeStorage.FinalizationQueue = SafeStorage.NewFQ[]; SafeStorage.EstablishFinalization[CODE[CornerStitching.Tesselation], 0, fooFQ]; TRUSTED {Process.Detach[FORK FinalizerProcess[fooFQ]]}; InitTesselationBorderTiles[]; Commander.Register[key: "CornerStiching", proc: Load, doc: "loads the CornerStiching"]; END. <> <> <> <<>> <> <> <> <<>> <> <> <<>> <> <> <<>> <> <> <> <>