G2dQuadtreeImpl.mesa
Copyright Ó 1990, 1992 by Xerox Corporation. All rights reserved.
Bloomenthal, July 1, 1992 7:06 pm PDT
DIRECTORY G2dBasic, G2dQuadtree, Real, Rope;
G2dQuadtreeImpl: CEDAR PROGRAM
IMPORTS Real
EXPORTS G2dQuadtree
~ BEGIN
ROPE:    TYPE ~ Rope.ROPE;
Pair:    TYPE ~ G2dBasic.Pair;
Edge:    TYPE ~ G2dQuadtree.Edge;
Quadrant:  TYPE ~ G2dQuadtree.Quadrant;
Square:   TYPE ~ G2dQuadtree.Square;
SquareRep:  TYPE ~ G2dQuadtree.SquareRep;
Corners:   TYPE ~ G2dQuadtree.Corners;
Corner:   TYPE ~ G2dQuadtree.Corner;
CornerRep:  TYPE ~ G2dQuadtree.CornerRep;
Stack:    TYPE ~ G2dQuadtree.Stack;
StackRep:   TYPE ~ G2dQuadtree.StackRep;
SquareProc:  TYPE ~ G2dQuadtree.SquareProc;
TwoQuadrants: TYPE ~ G2dQuadtree.TwoQuadrants;
TwoCorners:  TYPE ~ G2dQuadtree.TwoCorners;
Allocation
NewSquare: PUBLIC PROC [size: REAL, center: Pair ¬ [0, 0]] RETURNS [Square] ~ {
RETURN[NewKid[NIL, size, lb, 0, NewCorners[size, center]]];
};
NewKid: PROC [parent: Square, size: REAL, quadrant: Quadrant, level: NAT, corners: Corners]
RETURNS [square: Square]
~ {
square ¬ NEW[SquareRep];
square.parent ¬ parent;
square.quadrant ¬ quadrant;
square.terminal ¬ TRUE;
square.corners ¬ corners;
};
NewCorner: PROC [point: Pair] RETURNS [corner: Corner] ~ {
corner ¬ NEW[CornerRep ¬ [point: point]];
};
NewCorners: PUBLIC PROC [size: REAL, center: Pair] RETURNS [corners: Corners] ~ {
d: REAL ~ 0.5*size;
l: REAL ~ center.x-d;
r: REAL ~ center.x+d;
b: REAL ~ center.y-d;
t: REAL ~ center.y+d;
corners ¬ [NewCorner[[l, b]], NewCorner[[l, t]], NewCorner[[r, b]], NewCorner[[r, t]]];
};
Attributes
Root: PUBLIC PROC [square: Square] RETURNS [root: Square] ~ {
root ¬ square;
IF square # NIL THEN WHILE root.parent # NIL DO root ¬ root.parent; ENDLOOP;
};
NTerminalSquares: PUBLIC PROC [root: Square] RETURNS [nSquares: NAT ¬ 0] ~ {
squareProc: SquareProc ~ {nSquares ¬ nSquares+1};
ApplyToTerminal[root, squareProc];
};
Size: PROC [s: Square] RETURNS [REAL] ~ {RETURN[s.corners[rt].point.x-s.corners[lt].point.x]};
Modification
AddSquare: PUBLIC PROC [square: Square, edge: Edge] RETURNS [root: Square] ~ {
IF square = NIL THEN RETURN[NIL];
IF EdgeNeighbor[square, edge] # NIL THEN RETURN[Root[square]];
IF square.parent = NIL THEN {
Create square's parent, using square's corner as the center of parent:
NewParent: PROC [square: Square, q, oppQ: Quadrant] RETURNS [root: Square] ~ {
l, r, b, t, d: REAL ¬ 2.0*Size[square];
c: Pair ~ square.corners[q].point;
pp: Pair ~ square.corners[oppQ].point;
SELECT oppQ FROM
lb  => {l ¬ pp.x; b ¬ pp.y; r ¬ pp.x+d; t ¬ pp.y+d};
lt  => {l ¬ pp.x; t ¬ pp.y; r ¬ pp.x+d; b ¬ pp.y-d};
rb  => {r ¬ pp.x; b ¬ pp.y; l ¬ pp.x-d; t ¬ pp.y+d};
rt  => {r ¬ pp.x; t ¬ pp.y; l ¬ pp.x-d; b ¬ pp.y-d};
ENDCASE;
root ¬ NEW[SquareRep];
root.corners[oppQ] ¬ square.corners[oppQ];
IF oppQ # lb THEN root.corners[lb] ¬ NewCorner[[l, b]];
IF oppQ # lt THEN root.corners[lt] ¬ NewCorner[[l, t]];
IF oppQ # rb THEN root.corners[rb] ¬ NewCorner[[r, b]];
IF oppQ # rt THEN root.corners[rt] ¬ NewCorner[[r, t]];
};
q: Quadrant ~ SELECT edge FROM l => lb, r => rt, b => rb, ENDCASE => lt;
oppQ: Quadrant ~ OppositeQuadrant[q];
square.parent ¬ root ¬ NewParent[square, q, oppQ];
square.quadrant ¬ oppQ;
root.corners[oppQ] ¬ square.corners[oppQ];
root.kids[oppQ] ¬ square; -- root has a kid, but is not itself truly subdivided
};
{
AddSquareToParent: PROC [parent: Square, quadrant: Quadrant, size: REAL] ~ {
new: Square¬ NEW[SquareRep ¬ [quadrant: quadrant, terminal: TRUE, parent: parent]];
c: Corner ¬ parent.corners[quadrant];
l, r: REAL ¬ parent.corners[quadrant].point.x;
b, t: REAL ¬ parent.corners[quadrant].point.y;
SELECT quadrant FROM
lb => {r ¬ l+size; t ¬ b+size};
lt => {r ¬ l+size; b ¬ t-size};
rb => {l ¬ r-size; t ¬ b+size};
rt => {l ¬ r-size; b ¬ t-size};
ENDCASE;
parent.kids[quadrant] ¬ new;
FOR e: Edge IN Edge DO
neighbor: Square ~ EdgeNeighbor[new, e];
IF neighbor # NIL THEN {
n: Corners ~ neighbor.corners;
SELECT e FROM
l => {new.corners[lb] ¬ n[rb]; new.corners[lt] ¬ n[rt]};
r => {new.corners[rb] ¬ n[lb]; new.corners[rt] ¬ n[lt]};
b => {new.corners[lb] ¬ n[lt]; new.corners[rb] ¬ n[rt]};
t => {new.corners[lt] ¬ n[lb]; new.corners[rt] ¬ n[rb]};
ENDCASE;
};
ENDLOOP;
new.corners[quadrant] ¬ parent.corners[quadrant];
FOR q: Quadrant IN Quadrant DO
IF new.corners[q] = NIL THEN new.corners[q] ¬ NEW[CornerRep ¬
[point: SELECT q FROM lb => [l, b], lt => [l, t], rb => [r, b], ENDCASE => [r, t]]];
ENDLOOP;
};
parent: Square ¬ square.parent;
info: EdgeInfo ~ GetEdgeInfo[square, edge];
IF info.recurse THEN {
neighborOfParent: Square ¬ EdgeNeighbor[square.parent, edge];
IF neighborOfParent = NIL THEN root ¬ AddSquare[square.parent, edge];
IF (neighborOfParent ¬ EdgeNeighbor[square.parent, edge]) = NIL THEN ERROR;
parent ¬ neighborOfParent;
};
parent.terminal ¬ FALSE;
AddSquareToParent[parent, info.nQuadrant, Size[square]];
};
RETURN[Root[square]];
};
Callback
ApplyToTerminal: PUBLIC PROC [square: Square, squareProc: SquareProc] ~ {
Inner: PROC [square: Square] ~ {
IF square = NIL THEN RETURN;
IF square.terminal
THEN {IF NOT squareProc[square] THEN RETURN}
ELSE FOR o: Quadrant IN Quadrant DO Inner[square.kids[o]]; ENDLOOP;
};
Inner[square];
};
Directions
OppositeQuadrant: PUBLIC PROC [q: Quadrant] RETURNS [oq: Quadrant] ~ {
oq ¬ SELECT q FROM lt => rb, lb => rt, rt => lb, rb => lt, ENDCASE => ERROR;
};
EdgeFromQuadrants: PUBLIC PROC [q0, q1: Quadrant] RETURNS [e: Edge] ~ {
e ¬ SELECT q0 FROM
lt => SELECT q1 FROM lb => l, rt => t, ENDCASE => ERROR,
lb => SELECT q1 FROM lt => l, rb => b, ENDCASE => ERROR,
rt => SELECT q1 FROM lt => t, rb => r, ENDCASE => ERROR,
rb => SELECT q1 FROM lb => b, rt => r, ENDCASE => ERROR,
ENDCASE => ERROR;
};
NextCWEdge: PUBLIC PROC [edge: Edge] RETURNS [Edge] ~ {
RETURN[SELECT edge FROM l => t, t => r, r => b, ENDCASE => l];
};
EdgeQuadrants: PUBLIC PROC [edge: Edge] RETURNS [tq: TwoQuadrants] ~ {
tq ¬ SELECT edge FROM l => [lt, lb], r => [rt, rb], t => [lt, rt], ENDCASE => [lb, rb];
};
EdgeCorners: PUBLIC PROC [square: Square, edge: Edge] RETURNS [TwoCorners] ~ {
quadrants: TwoQuadrants ~ EdgeQuadrants[edge];
RETURN[[square.corners[quadrants.q0], square.corners[quadrants.q1]]];
};
Neighbors
EdgeInfo: TYPE ~ RECORD [nQuadrant: Quadrant, recurse: BOOL];
GetEdgeInfo: PROC [s: Square, e: Edge] RETURNS [info: EdgeInfo] ~ {
info.recurse ¬ SELECT s.quadrant FROM
lt => e = l OR e = t,
lb => e = l OR e = b,
rt => e = r OR e = t,
rb => e = r OR e = b,
ENDCASE => ERROR;
info.nQuadrant ¬ SELECT s.quadrant FROM
lt => SELECT e FROM l, r => rt, ENDCASE => lb,
lb => SELECT e FROM l, r => rb, ENDCASE => lt,
rt => SELECT e FROM l, r => lt, ENDCASE => rb,
rb => SELECT e FROM l, r => lb, ENDCASE => rt,
ENDCASE => ERROR;
};
EdgeNeighbor: PUBLIC PROC [square: Square, edge: Edge] RETURNS [neighbor: Square] ~ {
IF square = NIL OR square.parent = NIL
THEN RETURN[NIL]
ELSE {
info: EdgeInfo ¬ GetEdgeInfo[square, edge];
IF info.recurse
THEN {
parentNeighbor: Square ¬ EdgeNeighbor[square.parent, edge];
IF parentNeighbor # NIL THEN neighbor ¬ parentNeighbor.kids[info.nQuadrant];
}
ELSE neighbor ¬ square.parent.kids[info.nQuadrant];
};
};
Stack Procedures
StackOverflow: PUBLIC ERROR = CODE;
StackUnderflow: PUBLIC ERROR = CODE;
NewStack: PUBLIC PROC [length: NAT] RETURNS [Stack] ~ {
RETURN[NEW[StackRep[length]]];
};
WriteBottomOfStack: PUBLIC PROC [square: Square, stack: Stack] ~ {
newBottom: NAT ~ (stack.bottom+1) MOD stack.maxLength;
stack[stack.bottom] ¬ square;
IF newBottom = stack.top THEN ERROR StackOverflow;
stack.bottom ¬ newBottom;
stack.size ¬ stack.size+1;
stack.maxSize ¬ MAX[stack.maxSize, stack.size];
};
ReadTopOfStack: PUBLIC PROC [stack: Stack] RETURNS [square: Square] ~ {
IF stack.bottom = stack.top THEN ERROR StackUnderflow;
square ¬ stack[stack.top];
stack.top ¬ (stack.top+1) MOD stack.maxLength;
stack.size ¬ stack.size-1;
};
StackEmpty: PUBLIC PROC [stack: Stack] RETURNS [BOOL] ~ {
RETURN[stack.bottom = stack.top];
};
LengthenStack: PUBLIC PROC [stack: Stack, amount: REAL ¬ 1.3]
RETURNS [newStack: Stack]
~ {
newStack ¬ NEW[StackRep[Real.Round[amount*stack.maxLength]]];
FOR i: NAT IN [0..stack.maxLength) DO newStack[i] ¬ stack[i]; ENDLOOP;
newStack.top ¬ stack.top;
newStack.bottom ¬ stack.bottom;
newStack.size ¬ stack.size;
};
END.