QuadTree.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Greene, June 14, 1990 5:40 pm PDT
Chauser, June 2, 1992 2:23 pm PDT
DIRECTORY
Basics,
QuadTree,
Real,
Vector,
IO,
FS,
Rope;
QuadTreeImpl: CEDAR MONITOR LOCKS tree USING tree: QT
IMPORTS Basics, Real, IO, FS EXPORTS QuadTree =
BEGIN OPEN Basics, QuadTree;
testing: BOOLEAN = FALSE;
QT: TYPE = REF QTRec;
QTRec: PUBLIC TYPE = MONITORED RECORD [
structure: QTNode ¬ NIL,
universe: BoundingBox
];
QTNode: TYPE = REF QTNodeRec;
QTNodeRec: TYPE = RECORD [
count: INTEGER ¬ 0, --set to -1 once the node is split
level: CARDINAL,
area: InternalBoundingBox,
items: LIST OF QTItem ¬ NIL,
scan: LIST OF QTItem ¬ NIL, --used to scan items during enumerate
quadrants: ARRAY[0..3] OF QTNode ¬ ALL[NIL]
];
splitThreshold: INTEGER = 18;
maxLevels: CARDINAL = 15;
Create: PUBLIC PROC [universe: BoundingBox] RETURNS [tree:QT] ~ {
structure: QTNode ¬ NEW[QTNodeRec ¬ [
area: [ [FIRST[CARDINAL], FIRST[CARDINAL]], [LAST[CARDINAL], LAST[CARDINAL]] ],
level: 0
]];
RETURN[ NEW[QTRec ¬ [structure: structure, universe: universe]] ];
};
Insert: PUBLIC PROC [tree: QT, itemSize: BoundingBox, itemData: REF ANY, locked: BOOL ¬ FALSE] ~ {
item: QTItem ¬ NEW[QTItemRec ¬ [size: IntFromExt[itemSize, tree.universe], data: itemData]];
root: QTNode ¬ tree.structure;
IF locked THEN LockedInsert[tree, item] ELSE InsertItemInNode[item, root];
};
LockedInsert: PROC [tree: QT, item: QTItem] ~ {
root: QTNode ¬ tree.structure;
InsertItemInNode[item, root];
};
IntFromExt: PROC [ext, universe: BoundingBox] RETURNS [int: InternalBoundingBox] ~ {
int.lowerLeft ¬ ScaleVec[ext.lowerLeft, universe];
int.upperRight ¬ ScaleVec[ext.upperRight, universe];
};
ScaleVec: PROC [v: Vector.VEC, u: BoundingBox] RETURNS [iv: InternalVEC] ~ {
iv.x ¬ ScaleInRange[v.x, u.lowerLeft.x, u.upperRight.x];
iv.y ¬ ScaleInRange[v.y, u.lowerLeft.y, u.upperRight.y];
};
ScaleInRange: PROC [r, l, u: REAL] RETURNS [i: CARDINAL] ~ INLINE{
IF (r <= l) THEN RETURN[0];
IF (r >= u) THEN RETURN[65535];
RETURN[Real.Fix[( (r - l) * 65535.0 ) / (u - l)]];
};
InsertItemInNode: PROC [item: QTItem, node: QTNode] ~ {
IF node.level = maxLevels THEN node.items ¬ CONS[item, node.items]
ELSE IF node.count >= 0 THEN {
node.items ¬ CONS[item, node.items];
node.count ¬ node.count + 1;
IF node.count > splitThreshold THEN {
node.count ¬ -1;
node.scan ¬ node.items;
node.items ¬ NIL;
UNTIL node.scan = NIL DO
InsertItemInNode[node.scan.first, node];
node.scan ¬ node.scan.rest;
ENDLOOP;
};
}
ELSE { -- node.count = -1 means node is split already
quad: INTEGER ¬ LocateQuadrant[item, node.level];
IF quad = -1 THEN node.items ¬ CONS[item, node.items] --belongs here
ELSE {
IF node.quadrants[quad] = NIL THEN node.quadrants[quad] ¬ NewNode[node, quad];
InsertItemInNode[item, node.quadrants[quad]];
};
};
};
LocateQuadrant: PROC [item: QTItem, level: CARDINAL] RETURNS [quad: INTEGER] ~ {
xBit: CARDINAL ¬ ExtractBit[item.size.lowerLeft.x, 15 - level];
yBit: CARDINAL ¬ ExtractBit[item.size.lowerLeft.y, 15 - level];
quadLL: CARDINAL ¬ xBit + 2*yBit;
quadUR: CARDINAL;
xBit ¬ ExtractBit[item.size.upperRight.x, 15 - level];
yBit ¬ ExtractBit[item.size.upperRight.y, 15 - level];
quadUR ¬ xBit + 2*yBit;
IF quadLL = quadUR THEN RETURN[quadLL] ELSE RETURN[-1];
};
ExtractBit: PROC [w: CARDINAL, loc: CARDINAL] RETURNS [b: CARDINAL] ~ INLINE {
RETURN[BITAND[BITSHIFT[LOOPHOLE[w], -loc], 1]];
};
NewNode: PROC [parent: QTNode, quad: INTEGER] RETURNS [son: QTNode] ~ {
son ¬ NEW[QTNodeRec ¬ [
level: parent.level + 1,
area: SubArea[parent.area, parent.level, quad]
]];
};
SubArea: PROC [org: InternalBoundingBox, level: CARDINAL, quad: INTEGER] RETURNS [sub: InternalBoundingBox] ~ {
yBit: CARDINAL ¬ quad/2;
xBit: CARDINAL ¬ quad - 2*yBit;
sub.lowerLeft.x ¬ ComputeCorner[org.lowerLeft.x, xBit, level, 0];
sub.lowerLeft.y ¬ ComputeCorner[org.lowerLeft.y, yBit, level, 0];
sub.upperRight.x ¬ ComputeCorner[org.lowerLeft.x, xBit, level, 1];
sub.upperRight.y ¬ ComputeCorner[org.lowerLeft.y, yBit, level, 1];
};
ComputeCorner: PROC [base: CARDINAL, bit: CARDINAL, level: CARDINAL, pad: CARDINAL] RETURNS [result: CARDINAL] ~ {
scratch: WORD ¬ bit + pad;
result ¬ BITOR[
LOOPHOLE[base],
BITSHIFT[scratch, 15 - level] - pad
];
};
Enumerate: PUBLIC PROC [tree: QT, region: BoundingBox, PerItem: PerItemProc, quanta: CARD ¬ LAST[CARD], locked: BOOL ¬ FALSE ] ~ {
IF quanta < LAST[CARD] AND NOT locked THEN ERROR;
IF locked THEN LockedEnumerate[tree, region, PerItem, quanta]
ELSE InnerEnumerate[tree, region, PerItem, quanta];
};
LockedEnumerate: ENTRY PROC [tree: QT, region: BoundingBox, PerItem: PerItemProc, quanta: CARD ¬ LAST[CARD] ] ~ {
ENABLE UNWIND => NULL;
InnerEnumerate[tree, region, PerItem, quanta];
};
InnerEnumerate: PROC [tree: QT, region: BoundingBox, PerItem: PerItemProc, quanta: CARD ¬ LAST[CARD] ] ~ {
intRegion: InternalBoundingBox ¬ IntFromExt[region, tree.universe];
ResetScans: PerNodeProc ~ {
node.scan ¬ node.items;
};
extraPassNeeded: BOOL ¬ TRUE;
ProcessAQuanta: PerNodeProc ~ {
quantaCount: CARD ¬ 0;
UNTIL node.scan = NIL DO
IF quantaCount >= quanta THEN {
extraPassNeeded ¬ TRUE;
RETURN[FALSE]; --this node finished for now
};
IF Intersect[region, node.scan.first.size].overlap THEN {
IF PerItem[node.scan.first] THEN RETURN[TRUE]; --quit requested
quantaCount ¬ quantaCount + 1;
};
node.scan ¬ node.scan.rest;
ENDLOOP;
RETURN[FALSE]; --this node finished
};
ProcessAll: PerNodeProc ~ {
scan: LIST OF QTItem ¬ node.items;
UNTIL scan = NIL DO
IF Intersect[region, scan.first.size].overlap THEN
IF PerItem[scan.first] THEN RETURN[TRUE]; --quit requested
scan ¬ scan.rest;
ENDLOOP;
};
IF quanta < LAST[CARD] THEN TreeWalk[tree.structure, intRegion, ResetScans];
UNTIL extraPassNeeded = FALSE DO
extraPassNeeded ¬ FALSE;
TreeWalk[tree.structure, intRegion, IF quanta < LAST[CARD] THEN ProcessAQuanta ELSE ProcessAll];
ENDLOOP;
};
PerNodeProc: TYPE = PROC [node: QTNode, region: InternalBoundingBox] RETURNS [quit: BOOLEAN ¬ FALSE];
TreeWalk: PROC [node: QTNode, region: InternalBoundingBox, PerNode: PerNodeProc] ~ {
IF PerNode[node, region] THEN RETURN;
FOR quad: CARDINAL IN [0..3] DO
nextNode: QTNode ¬ node.quadrants[quad];
nextRegion: InternalBoundingBox; lap: BOOLEAN;
IF nextNode = NIL THEN LOOP;
[nextRegion, lap] ¬ Intersect[region, nextNode.area];
IF lap THEN TreeWalk[nextNode, nextRegion, PerNode];
ENDLOOP;
};
Intersect: PROC [b1, b2: InternalBoundingBox] RETURNS [common: InternalBoundingBox, overlap: BOOLEAN] ~ {
common.lowerLeft.x ¬ MAX[b1.lowerLeft.x, b2.lowerLeft.x];
common.lowerLeft.y ¬ MAX[b1.lowerLeft.y, b2.lowerLeft.y];
common.upperRight.x ¬ MIN[b1.upperRight.x, b2.upperRight.x];
common.upperRight.y ¬ MIN[b1.upperRight.y, b2.upperRight.y];
overlap ¬ (common.lowerLeft.x <= common.upperRight.x) AND (common.lowerLeft.y <= common.upperRight.y);
};
Destroy: PUBLIC ENTRY PROC [tree: QT, PerItem: PerItemProc ¬ NIL] ~ {
ENABLE UNWIND => NULL;
TreeDestroyWalk: PROC [node: QTNode] ~ {
scan, temp: LIST OF QTItem;
IF node = NIL THEN RETURN;
scan ¬ node.items;
UNTIL scan = NIL DO
IF PerItem # NIL THEN [] ¬ PerItem[scan.first];
temp ¬ scan; scan ¬ scan.rest;
temp.first ¬ NIL; temp.rest ¬ NIL;
ENDLOOP;
FOR quad: CARDINAL IN [0..3] DO
nextNode: QTNode ¬ node.quadrants[quad];
[] ¬ TreeDestroyWalk[nextNode];
node.quadrants[quad] ¬ NIL;
ENDLOOP;
};
TreeDestroyWalk[tree.structure];
};
For testing
qt: QT;
s: IO.STREAM;
PrintItems: PerItemProc ~ {
s.PutF1["QT item number %g\n", IO.int[NARROW[item.data, REF INT]­] ]
};
IF testing THEN {
s ¬ FS.StreamOpen["QuadTreeImpl.testlog", $create];
qt ¬ Create[[[0.0, 0.0], [10.0, 10.0]]];
Insert[qt, [[4.0, 4.0], [6.0, 6.0]], NEW[INT ¬ 1]];
Insert[qt, [[5.0, 2.0], [6.0, 3.0]], NEW[INT ¬ 2]];
Insert[qt, [[7.0, 7.0], [8.0, 8.0]], NEW[INT ¬ 3]];
Enumerate[qt, [[6.0, 6.0], [6.0, 6.0]], PrintItems];
Destroy[qt];
s.Close[];
};
END.