SXQuadTreeImpl.mesa: Spinifex flavour of Quad Trees
Copyright c 1985 by Xerox Corporation. All rights reserved.
Written by Beretta, June 3, 1985 2:54:18 pm PDT
gbb November 5, 1985 5:59:45 pm PST
DIRECTORY
CD USING [Error, Number, Rect],
CDBasics USING [Center, Inside, Intersect, Surround],
SXQuadTree
, TerminalIO USING [WriteInt, --WriteLn,-- WriteRope]
;
SXQuadTreeImpl: CEDAR PROGRAM
IMPORTS CD, CDBasics
EXPORTS SXQuadTree =
BEGIN
OPEN SXQuadTree;
Quadrant: TYPE = {ne,nw,sw,se};
Subdivision: TYPE = {fitsNorth, fitsSouth, fitsEast, fitsWest, store, wrong};
choiceMatrix: ARRAY Quadrant OF ARRAY Quadrant OF Subdivision = [
ne: [ne: fitsNorth, nw: fitsNorth, sw: store, se: fitsEast],
nw: [ne: wrong, nw: fitsNorth, sw: fitsWest, se: wrong],
sw: [ne: wrong, nw: wrong, sw: fitsSouth, se: wrong],
se: [ne: wrong, nw: wrong, sw: fitsSouth, se: fitsSouth]
];
This is trickier than it seems.
Unpleasant cases arise when degenerate boxes lie on the quadrant dividing axes. Accordingly quadNE & quadSW have slightly different semantics. quadNE is made to favour the south-west, and quadSW to favour the north-east. The choiceMatrix is encoded to interpret apparent contradictions such as quadNE in nw and quadSW in ne as indicating a degenrate box lying on the vertical splitting axis. Such a box is contained by both the ne & nw subtree.
Create: PUBLIC PROCEDURE [quadTree: QuadTreeRoot] RETURNS [newQuadTree: QuadTreeRoot] =
Hack. When all rectangles are known, also the bounding box of their union is known, and the Quad Tree can be created a least.
BEGIN
IF quadTree.geometry # NIL THEN
CD.Error [explanation: "\nQuad Tree already created\n"];
newQuadTree ← quadTree;
newQuadTree.geometry ← NEW [QuadTree];
[[x: newQuadTree.geometry.midX, y: newQuadTree.geometry.midY]] ← CDBasics.Center [newQuadTree.size];
FOR r: Rectangles ← quadTree.private, r.rest WHILE r # NIL DO
newQuadTree ← Insert [newQuadTree, r.first]
ENDLOOP;
quadTree.private ← NIL;
END; -- Create
Store: PUBLIC PROCEDURE [quadTree: QuadTreeRoot, rect: REF Rectangle] RETURNS [newQuadTree: QuadTreeRoot] =
This is a hack to fix a hack. The rectangles are first stored in a linear list. When all are there, the Quad Tree is created calling Create at the appropriate place.
BEGIN
IF quadTree.geometry # NIL THEN
CD.Error [explanation: "\nHack doesn't work: QTree already created\n"];
newQuadTree ← quadTree;
newQuadTree.private ← CONS [rect, newQuadTree.private];
IF ~CDBasics.Inside [rect.interestBound, newQuadTree.size] THEN
newQuadTree.size ← CDBasics.Surround [rect.interestBound, newQuadTree.size];
END; -- Store
SplittingSizeTooSmall: PROCEDURE [r: CD.Rect] RETURNS [BOOL] =
For insertion procedure. A heuristic to prevent ridiculous splitting.
BEGIN
splitLimit: CD.Number = 0;
RETURN [(r.x2-r.x1) * (r.y2-r.y1) < splitLimit]
END; -- SplittingSizeTooSmall
Insert: PROCEDURE [quadTree: QuadTreeRoot, rect: REF Rectangle] RETURNS [newQuadTree: QuadTreeRoot] =
Inserts a rectangle into a Quad Tree.
BEGIN
branchBoundary: CD.Rect;
qt: REF QuadTree;
quadNE, quadSW: Quadrant;
newQuadTree ← quadTree;
branchBoundary ← newQuadTree.size;
qt ← newQuadTree.geometry;
DO
st: AreaSplit;
classify top right corner
quadNE ← IF qt.midX < rect.interestBound.x2
THEN IF qt.midY < rect.interestBound.y2 THEN ne ELSE se
ELSE IF qt.midY < rect.interestBound.y2 THEN nw ELSE sw;
classify bottom left corner (not quite the same as quadNE! NOTE <=, NOT < )
quadSW ← IF qt.midX <= rect.interestBound.x1
THEN IF qt.midY <= rect.interestBound.y1 THEN ne ELSE se
ELSE IF qt.midY <= rect.interestBound.y1 THEN nw ELSE sw;
IF SplittingSizeTooSmall [branchBoundary] THEN EXIT;
SELECT choiceMatrix [quadNE][quadSW] FROM
store => EXIT;
fitsNorth => {branchBoundary.y1 ← qt.midY; st ← north};
fitsSouth => {branchBoundary.y2 ← qt.midY; st ← south};
fitsEast => {branchBoundary.x1 ← qt.midX; st ← east};
fitsWest => {branchBoundary.x2 ← qt.midX; st ← west};
ENDCASE => ERROR; -- rectangle not normalised
IF qt.subTrees[st] = NIL THEN
The first box in a new split does not recurse; a heuristic to avoid irrational splitting. Some boxes will not be as deep as they could be, but it should not matter greatly.
BEGIN
IF qt.boxes#NIL AND qt.boxes.rest#NIL THEN
qt has more than one box: split.
BEGIN
qt.subTrees[st] ← NEW [QuadTree ← [boxes: NIL,
subTrees: ALL[NIL],
midX: (branchBoundary.x2+branchBoundary.x1)/2,
midY: (branchBoundary.y2+branchBoundary.y1)/2]];
qt ← qt.subTrees[st];
TerminalIO.WriteRope ["New subtree created "];
EXIT -- insert in new subtree
END
ELSE -- qt has zero or one box
EXIT -- insert in current subtree
END;
qt ← qt.subTrees[st]; -- chase down one level
TerminalIO.WriteRope ["Chase down one level "]
ENDLOOP; -- DO
qt.boxes ← CONS [rect, qt.boxes];
TerminalIO.WriteRope ["Inserted "]; WriteRectangle [rect.interestBound];
TerminalIO.WriteRope [" in "];
TerminalIO.WriteInt [qt.midX]; TerminalIO.WriteInt [qt.midY];
TerminalIO.WriteLn;
RETURN [newQuadTree]
END; -- Insert
Enumerate: PUBLIC PROCEDURE [quadTree: QuadTreeRoot, clipRect: CD.Rect, PerRect: PerRectProc, data: REF ANY ← NIL] =
Interim procedure
BEGIN
FlattenTree: PROCEDURE [qt: REF QuadTree] =
BEGIN
IF qt = NIL THEN RETURN;
FOR boxes: LIST OF REF Rectangle ← qt.boxes, boxes.rest WHILE boxes#NIL DO
IF CDBasics.Intersect [clipRect, boxes.first.interestBound] THEN PerRect [boxes.first, data]
ENDLOOP;
IF clipRect.y2 > qt.midY THEN FlattenTree [qt.subTrees[north]];
IF clipRect.y1 < qt.midY THEN FlattenTree [qt.subTrees[south]];
IF clipRect.x2 > qt.midX THEN FlattenTree [qt.subTrees[east]];
IF clipRect.x1 < qt.midX THEN FlattenTree [qt.subTrees[west]];
END; -- FlattenTree
IF CDBasics.Intersect [clipRect, quadTree.size] THEN FlattenTree [quadTree.geometry];
END; -- Enumerate
WriteRectangle: PROCEDURE [r: CD.Rect] =
Writes the coordinates of a rectangle on the screen.
BEGIN
TerminalIO.WriteRope ["x1, y1, x2, y2: "];
TerminalIO.WriteInt [r.x1]; TerminalIO.WriteInt [r.y1];
TerminalIO.WriteInt [r.x2]; TerminalIO.WriteInt [r.y2];
TerminalIO.WriteLn
END; -- WriteRectangle
END.
Edited on June 18, 1985 10:47:24 am PDT, by Beretta
Made heuristics for splitting limit meaningful.
changes to: SplittingSizeTooSmall: tests on the area.