<> <> <> <> 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] ]; <> <> 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. <> <> <>