; ведите мышью с зажатой левой кнопкой ,в смежных квадрантах
;и вы увидите их объединение
;полезно для редактора карт
Global p1x,p1y
Global p2x,p2y
Global id,level ,xx#,yy#
; константы детей
Const CHILD00 = 0
Const CHILD01 = 1
Const CHILD11 = 2
Const CHILD10 = 3
;
; QUADTREE
Type QUADTREE
Field Child.QUADTREE[3] ;четыре потомка
Field xmin,ymin ; начальные координаты квадранта
Field xmax,ymax ; оконечные координаты квадранта
Field id ,lev
End Type
; ============= создаём квадро-дерево =================
Function Quadtree.QUADTREE(xmin,ymin,xmax,ymax,depth)
this.QUADTREE = New QUADTREE
this\xmin = xmin
this\xmax = xmax
this\ymin = ymin
this\ymax = ymax
id = id + 1
this\id = id
this\lev = 0
If (depth > 0)
; деление квадранта на 4-ре квадранта
xmoy = (xmin+xmax) / 2
ymoy = (ymin+ymax) / 2
depth = depth - 1
this\Child[CHILD00] = Quadtree(xmin,ymin,xmoy,ymoy,depth)
this\Child[CHILD01] = Quadtree(xmin,ymoy,xmoy,ymax,depth)
this\Child[CHILD11] = Quadtree(xmoy,ymoy,xmax,ymax,depth)
this\Child[CHILD10] = Quadtree(xmoy,ymin,xmax,ymoy,depth)
EndIf
Return this
End Function
; ==================== Рендер квадро-дерева =====================
Function RenderQuadtree(this.QUADTREE,depth)
If RectsOverlap (xx#,yy#,1,1,this\xmin,this\ymin,this\xmax-this\xmin,this\ymax-this\ymin)
If (depth > 1)
Color 188,188,188
Line (this\xmin+this\xmax)/2,this\ymin,(this\xmin+this\xmax)/2,this\ymax
Line this\xmin,(this\ymin+this\ymax)/2,this\xmax,(this\ymin+this\ymax)/2
depth = depth - 1
RenderQuadtree(this\Child[CHILD00],depth)
RenderQuadtree(this\Child[CHILD01],depth)
RenderQuadtree(this\Child[CHILD11],depth)
RenderQuadtree(this\Child[CHILD10],depth)
If this\Child[CHILD00]\lev = 1 And this\Child[CHILD01]\lev = 1 And this\Child[CHILD11]\lev = 1 And this\Child[CHILD10]\lev = 1 Then this\lev = 2
If this\Child[CHILD00]\lev = 2 And this\Child[CHILD01]\lev = 2 And this\Child[CHILD11]\lev = 2 And this\Child[CHILD10]\lev = 2 Then this\lev = 3
If this\lev = 2 Then
this\Child[CHILD00]\lev = 0
this\Child[CHILD01]\lev = 0
this\Child[CHILD11]\lev = 0
this\Child[CHILD10]\lev = 0
EndIf
If this\lev = 3 Then
this\Child[CHILD00]\lev = 0
this\Child[CHILD01]\lev = 0
this\Child[CHILD11]\lev = 0
this\Child[CHILD10]\lev = 0
this\lev = 3
EndIf
Else
If MouseDown(1) Then this\lev = 1
If this\lev = 1 Then Color 255,0,0 : fill = True Else Color 66,66,66 : fill = False
Rect this\xmin+1,this\ymin+1,this\xmax-this\xmin-1,this\ymax-this\ymin-1,fill
Color 255,255,255
Text this\xmin+2,this\ymin+2, this\id +".id "
Text this\xmin+2,this\ymin+12, this\lev
EndIf
EndIf
If this\lev = 1 Then Color 255,0,0 : fill = True Else Color 66,66,66 : fill = False
Rect this\xmin+1,this\ymin+1,this\xmax-this\xmin-1,this\ymax-this\ymin-1,fill
Color 255,255,255
Text this\xmin+2,this\ymin+12, this\lev
End Function
;==============================================================================================
; Сама Программа :
;==============================================================================================
AppTitle "квадро-дерево "
Graphics 512,512,0,2
;
gor2=CreateImage(64,64)
gor8=CreateImage(128,128)
gor1=CreateImage(32,32)
SetBuffer ImageBuffer(gor2)
Rect 10,10,34,34,1
Oval 34/2,34/2,32,32,0
SetBuffer ImageBuffer(gor1)
Rect 10,10,14,14,0
Oval 30/2,30/2,8,8,1
SetBuffer ImageBuffer(gor8)
Rect 0,0,124,124,0
Rect 20,20,82,82,1
;
SetBuffer BackBuffer()
ClsColor 122,122,122
QuadDepth = 5;число вложений (глубина ) : Level 's
QuadSize = 512 ; размеры квадранта
; создание основного квадранта
root.QUADTREE = Quadtree(0,0,QuadSize,QuadSize,QuadDepth)
While Not KeyHit(1)
Cls
xx# = MouseX()
yy# = MouseY()
;DrawImage gor1,200,200
Select True
Case KeyDown(200) ; Up
Case KeyDown(208) ; Down
Case KeyDown(203) ; Left
Case KeyDown(205) ; Right
End Select
; Рендер квадро-дерева
Color 255,255,255
Rect root\xmin,root\ymin,root\xmax,root\ymax,0
For wroot.QUADTREE = Each QUADTREE
If wroot\lev = 1 Then
Color 255,0,0
DrawImage gor1 ,wroot\xmin,wroot\ymin
;Rect wroot\xmin,wroot\ymin,wroot\xmax-wroot\xmin,wroot\ymax-wroot\ymin,1
ElseIf wroot\lev = 2 Then
Color 255,0,0
DrawImage gor2 ,wroot\xmin,wroot\ymin
;Rect wroot\xmin,wroot\ymin,wroot\xmax-wroot\xmin,wroot\ymax-wroot\ymin,1
ElseIf wroot\lev = 3 Then
Color 255,0,0
DrawImage gor8 ,wroot\xmin,wroot\ymin
;Rect wroot\xmin,wroot\ymin,wroot\xmax-wroot\xmin,wroot\ymax-wroot\ymin,1
EndIf
Next
RenderQuadtree(root,QuadDepth)
Flip
Wend
Delete Each QUADTREE
End