Advertisement
WarPie90

Untitled

May 24th, 2016
413
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 3.61 KB | None | 0 0
  1. {$R+}
  2. type
  3.   TBox = record x1,y1,x2,y2:Int32; end;
  4.   TPoint = record x,y:Int32; end;
  5.   TPointArray = array of TPoint;
  6.  
  7.   TQuadNode = record
  8.     Bounds: TBox;
  9.     Points: array of TPoint;
  10.     NorthWest, NorthEast: Int32;  //Holds indices of the pos in the Tree-Array
  11.     SouthWest, SouthEast: Int32;
  12.   end;
  13.  
  14.   TQuadTree = record
  15.     NODE_CAPACITY: UInt8;
  16.     Data: array of TQuadNode;
  17.   end;
  18.  
  19.  
  20.  
  21. function TQuadTree.AddBox(x1,y1,x2,y2:Int32): Int32;
  22. begin
  23.   Result := Length(self.Data);
  24.   SetLength(self.Data, Result+1);
  25.  
  26.   self.Data[Result].Bounds.x1 := x1;
  27.   self.Data[Result].Bounds.y1 := y1;
  28.   self.Data[Result].Bounds.x2 := x2;
  29.   self.Data[Result].Bounds.y2 := y2;
  30.  
  31.   self.Data[Result].NorthWest := -1;
  32.   self.Data[Result].NorthEast := -1;
  33.   self.Data[Result].SouthWest := -1;
  34.   self.Data[Result].SouthEast := -1;
  35. end;
  36.  
  37.  
  38. procedure TQuadTree.Init(area:TBox; capacity:Int32=2);
  39. begin
  40.   self.AddBox(area.x1, area.y1, area.x2, area.y2);
  41.   self.NODE_CAPACITY := capacity;
  42. end;
  43.  
  44.  
  45. // Insert a point into the QuadTree
  46. function TQuadTree.Insert(p:TPoint; idx:Int32 = 0): Boolean;
  47. begin
  48.   try
  49.     WriteLn('Range check: (index:' + ToString(idx) + ', size:' + ToString(Length(self.data))+')');
  50.     //outside this box?
  51.       if (self.Data[idx].Bounds.x1 > p.x) or (self.Data[idx].Bounds.x2 < p.x) or (self.Data[idx].Bounds.y1 > p.y) or (self.Data[idx].Bounds.y2 < p.y) then
  52.         Exit(False);
  53.  
  54.       //can we fit it here?
  55.       if (Length(self.Data[idx].Points) < NODE_CAPACITY) then
  56.       begin
  57.         self.Data[idx].Points += p;
  58.         Exit(True);
  59.       end;
  60.  
  61.       // Otherwise, subdivide and then add the point to whichever node will accept it
  62.       if (self.Data[idx].northWest = -1) then
  63.       begin
  64.         WriteLn('Dividing! (',self.Data[idx].northWest, ', ', self.Data[idx].northEast, ', ', self.Data[idx].southWest, ', ', self.Data[idx].southEast, ')');
  65.         self.SubDivide(idx);
  66.       end;
  67.       WriteLn(self.Data[idx].northWest, ', ', self.Data[idx].northEast, ', ', self.Data[idx].southWest, ', ', self.Data[idx].southEast);
  68.  
  69.       if self.Insert(p, self.Data[idx].northWest) then Exit(True);
  70.       if self.Insert(p, self.Data[idx].northEast) then Exit(True);
  71.       if self.Insert(p, self.Data[idx].southWest) then Exit(True);
  72.       if self.Insert(p, self.Data[idx].southEast) then Exit(True);
  73.   except
  74.     // This should _never_ happen!
  75.     RaiseException('Range check: (index:' + ToString(idx) + ', size:' + ToString(Length(self.data))+')');
  76.   end;
  77. end;
  78.  
  79.  
  80. // Insert a point into the QuadTree
  81. procedure TQuadTree.SubDivide(idx:Int32);
  82. var
  83.   mid:TPoint;
  84. begin
  85.   WriteLn('Divide got idx: ', idx);
  86.  
  87.   mid.X := (self.Data[idx].Bounds.X1 + self.Data[idx].Bounds.X2) shr 1;
  88.   mid.Y := (self.Data[idx].Bounds.Y1 + self.Data[idx].Bounds.Y2) shr 1;
  89.  
  90.   self.Data[idx].northWest := self.AddBox(self.Data[idx].bounds.x1, self.Data[idx].bounds.y1, mid.x, mid.y);
  91.   self.Data[idx].northEast := self.AddBox(mid.x, self.Data[idx].bounds.y1, self.Data[idx].bounds.x2, mid.y);
  92.   self.Data[idx].southWest := self.AddBox(self.Data[idx].bounds.x1, mid.y, mid.x, self.Data[idx].bounds.y2);
  93.   self.Data[idx].southEast := self.AddBox(mid.x, mid.y, self.Data[idx].bounds.x2, self.Data[idx].bounds.y2);
  94. end;
  95.  
  96.  
  97. function TPAFromBox(B:TBox): TPointArray;
  98. var x,y:Int32;
  99. begin
  100.   for y:=B.x1 to B.y2 do
  101.     for x:=B.x1 to B.x2 do
  102.       Result += TPoint([x,y]);
  103. end;
  104.  
  105.  
  106. var
  107.   Tree : TQuadTree;
  108.   TPA: TPointArray;
  109.   i:Int32;
  110. begin
  111.   TPA := TPAFromBox([0,0,10,10]);
  112.   Tree.Init([0,0,11,11]);
  113.  
  114.   for i:=0 to High(TPA) do
  115.   begin
  116.     Tree.Insert(TPA[i]);
  117.     WriteLn('----------------------');
  118.   end;
  119. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement