DIRECTORY CD USING [Error, Number, Rect], CDBasics USING [Center, Inside, Intersect, Surround], SXQuadTree ; 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] ]; Create: PUBLIC PROCEDURE [quadTree: QuadTreeRoot] RETURNS [newQuadTree: QuadTreeRoot] = 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] = 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] = 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] = BEGIN branchBoundary: CD.Rect; qt: REF QuadTree; quadNE, quadSW: Quadrant; newQuadTree _ quadTree; branchBoundary _ newQuadTree.size; qt _ newQuadTree.geometry; DO st: AreaSplit; 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; 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 BEGIN IF qt.boxes#NIL AND qt.boxes.rest#NIL THEN 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]; 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 ENDLOOP; -- DO qt.boxes _ CONS [rect, qt.boxes]; RETURN [newQuadTree] END; -- Insert Enumerate: PUBLIC PROCEDURE [quadTree: QuadTreeRoot, clipRect: CD.Rect, PerRect: PerRectProc, data: REF ANY _ NIL] = 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 END. –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 , TerminalIO USING [WriteInt, --WriteLn,-- WriteRope] 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. Hack. When all rectangles are known, also the bounding box of their union is known, and the Quad Tree can be created a least. 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. For insertion procedure. A heuristic to prevent ridiculous splitting. Inserts a rectangle into a Quad Tree. classify top right corner classify bottom left corner (not quite the same as quadNE! NOTE <=, NOT < ) 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. qt has more than one box: split. TerminalIO.WriteRope ["New subtree created "]; TerminalIO.WriteRope ["Chase down one level "] TerminalIO.WriteRope ["Inserted "]; WriteRectangle [rect.interestBound]; TerminalIO.WriteRope [" in "]; TerminalIO.WriteInt [qt.midX]; TerminalIO.WriteInt [qt.midY]; TerminalIO.WriteLn; Interim procedure 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 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. ‌ت¸کڑœ3™3Jڑœ<™Kڑœ -™EKڑ‌کKڑœ‌œکKڑ‌œ ‌œک/Kڑ‌œ ک—ڑ‍œ‌ œ ‌œ‌œکeJڑœ%™%Lڑ‌کKڑœ‌œکKڑœ‌œ کKڑœکLڑœکKڑœ"ک"Jڑœکڑ‌کKڑœکKڑ ™Kڑœ ‌œ!‌œ‌œ!‌œ‌œ‌œ‌œ!‌œ‌œکœKڑ L™LKڑœ ‌œ"‌œ‌œ"‌œ‌œ‌œ‌œ"‌œ‌œکںKڑ‌œ(‌œ‌ک4ڑ‌œ‌ک)Kڑœ ‌œکKڑœ7ک7Kڑœ7ک7Kڑœ5ک5Kڑœ5ک5Kڑ‌œ‌œ ک-—ڑ‌œ‌œ‌کK™Kڑ‌کڑ ‌œ ‌œ‌œ‌œ‌ک*K™ Kڑ‌œکKڑ œ‌œ‌œ‌œ‌œbک¢KڑœکKڑœ.™.Kڑ‌œ کKڑ‌ک—ڑ‌œ کKڑ‌œ ک!—Kڑ‌ک—Kڑœ ک-Kڑœ.™.Kڑ‌œ ذcsک—Lڑœ‌œک!KڑœH™HKڑœ™Kڑœ=™=Kڑœ™Kڑ‌œکLڑ‌œ ک—ڑ‍ œ‌œ$‌œ#‌œ‌œ‌œکtJ™Kڑ‌کڑ‍œ‌ œ‌œک+Kڑ‌کKڑ‌œ‌œ‌œ‌œکڑ ‌œ‌œ‌œ‌œ"‌œ‌œ‌کJKڑ‌œ:‌œک\Kڑ‌œک—Kڑ‌œ‌œ"ک?Kڑ‌œ‌œ"ک?Kڑ‌œ‌œ!ک>Kڑ‌œ‌œ!ک>Jڑ‌œ ذceک—Lڑ‌œ.‌œ!کUKڑ‌œ ک•StartOfExpansion[]ڑ‍œ‌ œ‌œ™(J™4Lڑ‌™Kڑœ*™*Kڑœ7™7Kڑœ7™7Kڑœ™Lڑ‌œ ™——Lڑ‌œک™3K™/Kڑœدrœ¤™5——…—Œع