Global id,mx,my ,CubDepth
Global px,py,pz ,s ,mxx,myy
Type OCTREE
Field Child.OCTREE[8] ;8 потомков
Field xmin,ymin,zmin
;Field xcentr,ycentr,zcentr ; центр куба
Field qred,qgreen,qblue,qalpha,qcolor
Field size , depth , block=False
End Type
Function RootOctree.OCTREE(xmin,ymin,zmin ,size,depth)
newsize = size / 2
this.OCTREE = New OCTREE
this\xmin = xmin
this\ymin = ymin
this\zmin = zmin
this\size = size
this\depth = depth
id = id + 1
If depth = CubDepth
newdepth = depth -1
this\Child[0] = RootOctree(xmin,ymin,zmin ,newsize ,newdepth )
this\Child[1] = RootOctree(xmin,ymin+newsize ,zmin ,newsize ,newdepth )
this\Child[2] = RootOctree(xmin+newsize,ymin+newsize,zmin ,newsize ,newdepth )
this\Child[3] = RootOctree(xmin+newsize,ymin,zmin ,newsize ,newdepth )
this\Child[4] = RootOctree(xmin,ymin,zmin+newsize,newsize ,newdepth )
this\Child[5] = RootOctree(xmin,ymin+newsize,zmin+newsize,newsize ,newdepth )
this\Child[6] = RootOctree(xmin+newsize,ymin+newsize,zmin+newsize,newsize ,newdepth )
this\Child[7] = RootOctree(xmin+newsize,ymin,zmin+newsize,newsize ,newdepth )
EndIf
Return this
End Function
Function AddOctree.OCTREE( this.OCTREE,xmin,ymin,zmin ,size,depth)
If PointInCube(xmin,ymin,zmin,xmin+size,ymin+size,zmin+size,mx,my,pz )
newsize = size / 2
If this = Null
this.OCTREE = New OCTREE
this\xmin = xmin
this\ymin = ymin
this\zmin = zmin
this\size = size
this\depth = depth
id = id + 1
Else
EndIf
If depth >0
newdepth = depth -1
this\Child[0] = AddOctree(this\Child[0], xmin,ymin,zmin ,newsize ,newdepth )
this\Child[1] = AddOctree(this\Child[1], xmin,ymin+newsize ,zmin ,newsize ,newdepth )
this\Child[2] = AddOctree(this\Child[2], xmin+newsize,ymin+newsize,zmin ,newsize ,newdepth )
this\Child[3] = AddOctree(this\Child[3], xmin+newsize,ymin,zmin ,newsize ,newdepth )
this\Child[4] = AddOctree(this\Child[4], xmin,ymin,zmin+newsize,newsize ,newdepth )
this\Child[5] = AddOctree(this\Child[5], xmin,ymin+newsize,zmin+newsize,newsize ,newdepth )
this\Child[6] = AddOctree(this\Child[6], xmin+newsize,ymin+newsize,zmin+newsize,newsize ,newdepth )
this\Child[7] = AddOctree(this\Child[7], xmin+newsize,ymin,zmin+newsize,newsize ,newdepth )
;EndIf
EndIf
EndIf
Return this
End Function
Function PoinInCircle(ox , oy ,r)
If Int((mx - ox)^2 + (my - oy)^2) <= r^2 Then
mx = ox : my = oy
EndIf
End Function
Graphics 800,600,32,2
SetBuffer BackBuffer()
;HidePointer
CubDepth =6 ; 8 ;число вложений (глубина )
CubSize = 512 ; размеры квадранта
root.OCTREE = RootOctree(0,0,0,CubSize ,CubDepth )
While Not KeyHit(1)
timestartvis = MilliSecs()
mx = MouseX()
my = MouseY()
s = Abs(MouseZ())+5
Cls
If KeyDown(30) And pz <180 Then pz=pz+1 ; A key
If KeyDown(44) And pz > 0 Then pz=pz-1 ; Z key
myy = (2*(my-300) -(mx-400))/2 + pz;-s
mxx = ((mx-400)+myy);-;s
If MouseDown(1) Or KeyDown(57) Then ;
timestart = MilliSecs()
AddOctree(root, 0,0,0,CubSize ,CubDepth)
timeout = (MilliSecs()-timestart)
EndIf
RenderOctree(root,CubDepth )
Oval 400+(mx-my )-s,300+ ( my+mx )/2- pz -s,s*2,s*2,0
; INFO
Color 255,255,255
Text 550,20,"S = "+s+" Kolichestvo elementov = "+id
Text 550,180," Z = "+pz+" Time Create "+timeout
timeoutvis = (MilliSecs()-timestartvis)
Text 550,200," Time Visualization "+timeout
Flip
Wend
Delete Each OCTREE
End
Function RenderOctree(this.OCTREE,depth)
If this.OCTREE <> Null
If (depth > 0)
Color 128,128,128
Rect this\xmin , this\ymin , this\size , this\size , 0
Text this\xmin +this\depth*6, this\ymin +this\depth*6 , this\depth
depth = depth - 1
RenderOctree(this\Child[0],depth)
RenderOctree(this\Child[1],depth)
RenderOctree(this\Child[2],depth)
RenderOctree(this\Child[3],depth)
RenderOctree(this\Child[4],depth)
RenderOctree(this\Child[5],depth)
RenderOctree(this\Child[6],depth)
RenderOctree(this\Child[7],depth)
If depth=0
Color 228,28,28
; Rect 400+ this\xmin-this\ymin , 300+ (this\ymin+ this\xmin)/2 -this\zmin , this\size , this\size , 0
; Line 400+ (this\xmin-this\ymin), 300+ (this\ymin+ this\xmin)/2 +this\zmin , 400+ ((this\xmin+this\size )-this\ymin), 300+ ((this\xmin+this\size )+ this\xmin)/2 +this\zmin
EndIf
Else
Color 228,28,28
Rect 400+ (this\xmin-this\ymin) , 300+ (this\ymin+ this\xmin)/2 -this\zmin , this\size , this\size , 0
Color 128,128,128
Rect this\xmin , this\ymin , this\size , this\size , 1
End If
EndIf
End Function
Function PointInCube(pointXmin#,pointYmin#,pointZmin#,pointXmax#,pointYmax#,pointZmax#,pointX#,pointY#,pointZ )
If pointX >=pointXmin And pointX < pointXmax
If pointY >= pointYmin And pointY < pointYmax
If pointZ>= pointZmin And pointZ< pointZmax
Return True
End If
End If
End If
Return False
End Function