
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;
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]]];
};
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]};
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 {
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]];
};
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];
};
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]]];
};
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];
};
};
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.
      
G2dQuadtreeImpl.mesa
Copyright ╙ 1990, 1992 by Xerox Corporation.  All rights reserved.
Bloomenthal, July 1, 1992 7:06 pm PDT
Allocation
Attributes

Modification
Create square's parent, using square's corner as the center of parent:
Callback
Directions
Neighbors
Stack Procedures
 Э╩	╤  ХNewlineDelimiter
Ц"cedarcode" styleЩ ЪЬЩJЪЬ
╧eЬ7ЩBJЩ%JШ JЪ╧k	Ь#Ш,JШ ЧЪ╨blЬЮЬЮШJЪЮЬШJЪЮЬШJШ ЧЪЬЮШJШ JЪЮЬЮЬЮЬШJЪЬЮЬШJЪЬЮЬШ!JЪЬ
ЮЬШ'JЪЬ	ЮЬШ$JЪЬЮЬШ)JЪЬ
ЮЬШ&JЪЬ	ЮЬШ$JЪЬЮЬШ)JЪЬЮЬШ#JЪЬ
ЮЬШ(JЪЬЮЬШ+JЪЬЮЬШ.JЪЬЮЬШ+ЧheadЪ╧l
Щ
Ъ
╧n	ЬЮЬЮЬЮЬЮЬШOJЪЮЬЮЬ*Ш;JШJШ ЧЪбЬЮЬЮЬЮЬШ[JЪЮЬШJШJЪЬ	ЮЬШJШJШJЪЬЮЬШJШJШJШ ЧЪб	ЬЮЬЮЬШ:JЪЬ	ЮЬШ)JШJШ ЧЪ
╨bn
ЬЮЬЮЬЮЬЮЬШQJЪЬЮЬШJЪЬЮЬШJЪЬЮЬШJЪЬЮЬШJЪЬЮЬШJШWJШЧЧЪа
Щ
ЪбЬЮЬЮЬЮЬШ=JШJЪЮЬ
ЮЬЮЬЮЬЮЬЮЬЮЬШLJШJЩ ЧЪ
бЬЮЬЮЬЮЬЮЬ	ШLJЪб
Ь'Ш1JШ"JШJШ ЧJЪ
бЬЮЬЮЬЮЬЮЬ/Ш^ЧЪаЩЪб	ЬЮЬЮЬЮЬШNJЪ
ЮЬ
ЮЬЮЬЮЬЮЬШ!JЪЮЬЮЬЮЬЮЬШ>ЪЮЬЮЬЮЬШJЩFЪб	ЬЮЬ%ЮЬШNJЪЬЮЬШ'JШ"JЪЬ&Ш&ЪЮЬЮШJШ4JШ4JШ5JШ4JЪЮЬШЧJЪЬЮЬШJШ*JЪЮЬЮЬ&Ш7JЪЮЬЮЬ&Ш7JЪЮЬЮЬ&Ш7JЪЮЬЮЬ&Ш7JШЧJЪЬЮЬЮЬЮЬШHJШ%JШ2JШJШ*JЪЬ╧c5ШOJШЧШЪбЬЮЬ,ЮЬШLJЪЬЮЬ,ЮЬШSJШ%JЪЬЮЬ$Ш.JЪЬЮЬ$Ш.ЪЮЬ
ЮШJШJШJШJШJЪЮЬШЧJШЪЮЬ	ЮЬЮШJШ(ЪЮЬЮЬЮЬШJШЪЮЬЮШJШ8JШ8JШ8JШ8JЪЮЬШЧJШЧJЪЮЬШЧJШ1ЪЮЬЮЬ
ЮШЪЮЬЮЬЮЬЮЬШ=JЪЬЮЬЮЬ*ЮЬШTЧJЪЮЬШЧJШЧJШJШ+ЪЮЬЮЬШJШ=JЪЮЬЮЬЮЬ╧b	ЬШEJЪЮЬ:ЮЬЮЬЮЬШKJШJШЧJЪЬЮЬШJШ8JШЧJЪЮЬШJШЧЧЪаЩЪбЬЮЬЮЬ-ШIЪбЬЮЬШ JЪЮЬ
ЮЬЮЬЮЬШЪЮЬШJЪ
ЮЬЮЬЮЬЮЬЮЬШ,JЪЮЬЮЬЮЬ
ЮЬдЬЮЬШCЧJШЧJШJШЧЧЪа
Щ
ЪбЬЮЬЮЬЮЬШFJЪ	ЬЮЬЮЬ)ЮЬЮЬШLJШJШ ЧЪбЬЮЬЮЬЮЬШGЪЬЮЬЮШJЪ	ЬЮЬЮЬЮЬЮЬШ8JЪ	ЬЮЬЮЬЮЬЮЬШ8JЪ	ЬЮЬЮЬЮЬЮЬШ8JЪ	ЬЮЬЮЬЮЬЮЬШ8JЪЮЬЮЬШЧJШJШ ЧЪб
ЬЮЬЮЬШ7JЪЮЬЮЬЮЬЮЬШ>JШJШ ЧЪбЬЮЬЮЬЮЬШFJЪЬЮЬЮЬ.ЮЬШWJШJШ ЧЪбЬЮЬЮЬШNJШ.JЪЮЬ?ШEJШЧЧЪа	Щ	ЪЬ
ЮЬЮЬ ЮЬШ=JШ ЧЪбЬЮЬЮЬШCЪЬЮЬЮШ%JЪЬЮЬШJЪЬЮЬШJЪЬЮЬШJЪЬЮЬШJЪЮЬЮЬШЧЪЬЮЬЮШ'JЪЬЮЬЮЬЮЬШ.JЪЬЮЬЮЬЮЬШ.JЪЬЮЬЮЬЮЬШ.JЪЬЮЬЮЬЮЬШ.JЪЮЬЮЬШЧJШJШ ЧЪбЬЮЬЮЬШUЪЮЬ
ЮЬЮШ&JЪЮЬЮЬЮЬШЪЮЬШJШ+ЪЮЬШЪЮЬШJЪЬбЬШ;JЪЮЬЮЬЮЬ0ШLJШЧJЪЮЬ/Ш3ЧJШЧЧJШЧЧЪаЩJЪЬЮЬЮЬШ#JЪЬЮЬЮЬШ$JШ ЪбЬЮЬ
ЮЬЮЬШ7JЪЮЬЮЬШJШJШ ЧЪбЬЮЬ#ШBJЪЬЮЬЮЬШ6JШJЪЮЬЮЬЮЬШ2JШJШJЪЬЮЬШ/JШJШ ЧЪбЬЮЬЮЬШGJЪЮЬЮЬЮЬШ6JШJЪЬЮЬШ.JШJШJШ ЧЪб
ЬЮЬЮЬЮЬШ9JЪЮЬШ!JШJШ ЧЪбЬЮЬЮЬШ=JЪЮЬШJШJЪЬЮЬ/Ш=JЪ
ЮЬЮЬЮЬЮЬЮЬШFJШJШJШJШЧЧJШ JЪЮЬШЧ ЕЧ    0  *!  