[polopok]

Итак , продолжаем. Пришлось изменить код ,так как , в первом варианте я делил весь объём куба на меньшие ,а потому память слала далеко-далеко ,когда глубина вложений превышала 7. Теперь изначально есть корневой куб ,а 4-ре его потомка = Null . При нажатии ЛМ (левой кнопки мыши) проверяется в котором потомке находиться мышь(объект) и затем делится рекурсивно если потомок = Null или не Null . И вот тут я запутался с родителями-потомками . Представляю сырой вариант ниже.

Код:

Global id,mx,my ,QDepth  
Global px,py,pz ,s ,mxx,myy



Type OCTREE
Field Child.OCTREE[8] ;8 потомков
Field xmin,ymin,zmin ; начальные координаты куба
Field xmax,ymax,zmax ; оконечные координаты куба
Field xcentr,ycentr,zcentr ; центр куба
Field qred,qgreen,qblue,qalpha,qcolor
End Type

Function Octree.OCTREE(xmin,ymin,zmin,xmax,ymax,zmax,depth)
	xcentr = (xmin+xmax) / 2
	ycentr = (ymin+ymax) / 2
	zcentr = (zmin+zmax) / 2

this.OCTREE = New OCTREE
	this\xmin = xmin
	this\xmax = xmax
	this\ymin = ymin
	this\ymax = ymax
	this\zmin = zmin
	this\zmax = zmax
	this\xcentr = xcentr
	this\ycentr = ycentr
	this\zcentr = zcentr
		
	id = id + 1


	For c = 1 To 8
		this\Child[c] = Null 
		
		If this\Child[c] <> Null 
			Delete this\Child[c] 
			this\Child[c] = Null 
		EndIf
	Next 


	Return this
End Function


; ====================      =====================
Function RenderOctree(this.OCTREE,depth)

If this.OCTREE <> Null
If PointInCube(this\xmin,this\ymin,this\zmin,this\xmax,this\ymax,this\zmax,mx,my,pz ) 	= True
	If (depth > 0)			
	
		      Color 128,128,128
		      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
	
			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)
			RenderOctree(this\Child[8],depth)	
			
			Text this\xmin+3,this\ymin+3,"+"
			      Color 6,6,196
      Rect this\xmin+1,this\ymin+1,this\xmax-this\xmin-1,this\ymax-this\ymin-1,0
	Else
      Color 196,6,6
      Rect this\xmin+1,this\ymin+1,this\xmax-this\xmin-1,this\ymax-this\ymin-1,1
	End If 
End If 
End If
End Function

; ====================      =====================
Function AddToOctree.OCTREE(xmin,ymin,zmin,xmax,ymax,zmax,depth)
If PointInCube(xmin,ymin,zmin,xmax,ymax,zmax,mx,my,pz ) 	= True 
	xcentr = (xmin+xmax) / 2
	ycentr = (ymin+ymax) / 2
	zcentr = (zmin+zmax) / 2
	
this.OCTREE = New OCTREE
	this\xmin = xmin
	this\xmax = xmax
	this\ymin = ymin
	this\ymax = ymax
	this\zmin = zmin
	this\zmax = zmax
	this\xcentr = xcentr
	this\ycentr = ycentr
	this\zcentr = zcentr
		
	id = id + 1	

If (depth >= 0)	

	depth = depth - 1

	this\Child[1] = AddToOctree(xmin,ymin,zmin  ,xcentr,ycentr,zcentr ,depth) 
	this\Child[2] = AddToOctree(xmin,ycentr,zmin  ,xcentr,ymax,zcentr ,depth)
	this\Child[3] = AddToOctree(xcentr,ycentr,zmin  ,xmax,ymax,zcentr ,depth) 
	this\Child[4] = AddToOctree(xcentr,ymin,zmin  ,xmax,ycentr,zcentr ,depth) 
	this\Child[5] = AddToOctree(xmin,ymin,zcentr  ,xcentr,ycentr,zmax,depth) 
	this\Child[6] = AddToOctree(xmin,ycentr,zcentr  ,xcentr,ymax,zmax,depth)
	this\Child[7] = AddToOctree(xcentr,ycentr,zcentr  ,xmax,ymax,zmax,depth) 
	this\Child[8] = AddToOctree(xcentr,ymin,zcentr  ,xmax,ycentr,zmax,depth) 

EndIf
EndIf
	Return this
End Function





Graphics 800,600,32,2 
SetBuffer BackBuffer() 
HidePointer

QuadDepth =4    ; 8 ;число вложений (глубина ) 
QuadSize = 512 ; размеры квадранта 

timestart = MilliSecs()
root.OCTREE = Octree(0,0,0,QuadSize,QuadSize,QuadSize,QuadDepth)
timeout = (MilliSecs()-timestart)
While Not KeyHit(1) 
mx = MouseX() 
my = MouseY() 
s = Abs(MouseZ())
Cls 
Select True 
Case KeyDown(200) : py=py-1*20; Up
Case KeyDown(208) : py=py+1*20; Down
Case KeyDown(203) : px=px-1*20; Left
Case KeyDown(205) : px=px+1*20; Right
Case KeyDown(57) 
End Select 
If  KeyHit(30) And pz <180 Then pz=pz+10 ;   A key
If  KeyHit(44) And pz > 0 Then pz=pz-10	

		If MouseDown(1) Or KeyDown(157)  Then ;
		For c = 1 To 8
		;If PointInCube(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,mx,my,pz ) 	= True 
		If root\Child[c]  = Null
			;root.OCTREE = AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
		Text 200,200,"YES !!!"	+c
			root\Child[c] = AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
		Else 	
			;root.OCTREE =	AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
			root\Child[c] = AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
		EndIf 
		;EndIf 
		Next 
		EndIf 
		If MouseDown(2)  Then ;

		EndIf 
		
	
myy = (2*(my-400) -(mx-400))/2 + pz;-s
mxx = ((mx-400)+myy);-;s


RenderStaticLine(root)	
RenderOctree(root,QuadDepth)

Color 255,255,255
Oval 400+ mxx -myy -(6) , 400+ (mxx +myy )/2-pz-(6) ,(12),(12),0

Color 255,5,5
;	Line  400+ (root\xmin-root\ymax),400+ (root\xmin+root\ymax)/2- pz,400+ (root\xmax-root\ymax) , 400+ (root\xmax+root\ymax)/2-pz
;	Line  400+ (root\xmax-root\ymax) , 400+ (root\xmax+root\ymax)/2- pz ,400+ (root\xmax-root\ymin),400+ (root\xmax+root\ymin)/2-pz
Text 550,20,"S = "+s+"   col-vo elements = "+id
Text 550,180-pz,"  Z = "+pz+"     timeout  "+timeout 
Flip 
Wend 
Delete Each OCTREE
End  

Function RenderStaticLine(this.OCTREE)
If this.OCTREE <> Null
Color 255,255,255
	Line 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- this\zmin , 400+ (this\xmin-this\ymax),400+ (this\xmin+this\ymax)/2- this\zmin
	Line  400+ (this\xmin-this\ymax),400+ (this\xmin+this\ymax)/2- this\zmin,400+ (this\xmax-this\ymax) , 400+ (this\xmax+this\ymax)/2- this\zmin 
	Line  400+ (this\xmax-this\ymax) , 400+ (this\xmax+this\ymax)/2- this\zmin ,400+ (this\xmax-this\ymin),400+ (this\xmax+this\ymin)/2- this\zmin
	Line  400+ (this\xmax-this\ymin),400+ (this\xmax+this\ymin)/2- this\zmin , 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- this\zmin 
Color 255,5,5	
	Line 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- pz , 400+ (this\xmin-this\ymax),400+ (this\xmin+this\ymax)/2-pz
	Line  400+ (this\xmax-this\ymin),400+ (this\xmax+this\ymin)/2- pz , 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- pz
Color 255,255,255	
End If
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



Function CombineARGB#(aa#,rr%,gg%,bb%)	
	;Return aa*$1000000+rr*$10000+gg*$100+bb	
	Return $ff000000 Or rr Shl 16 Or gg Shl 8 Or bb 
End Function

Изменённый код:

Global id,mx,my ,QuadDepth 
Global px,py,pz ,s ,mxx,myy



Type OCTREE
Field Child.OCTREE[8] ;8 потомков
Field xmin,ymin,zmin ; начальные координаты куба
Field xmax,ymax,zmax ; оконечные координаты куба
Field xcentr,ycentr,zcentr ; центр куба
Field qred,qgreen,qblue,qalpha,qcolor
Field depth 
End Type

Function Octree.OCTREE(xmin,ymin,zmin,xmax,ymax,zmax,depth)
	xcentr = (xmin+xmax) / 2
	ycentr = (ymin+ymax) / 2
	zcentr = (zmin+zmax) / 2

this.OCTREE = New OCTREE
	this\xmin = xmin
	this\xmax = xmax
	this\ymin = ymin
	this\ymax = ymax
	this\zmin = zmin
	this\zmax = zmax
	this\xcentr = xcentr
	this\ycentr = ycentr
	this\zcentr = zcentr
	this\depth = depth 	
	id = id + 1

If (depth = QuadDepth )
	depth = depth - 1
	
	this\Child[1] = Octree(xmin,ymin,zmin  ,xcentr,ycentr,zcentr ,depth) 
	this\Child[2] = Octree(xmin,ycentr,zmin  ,xcentr,ymax,zcentr ,depth)
	this\Child[3] = Octree(xcentr,ycentr,zmin  ,xmax,ymax,zcentr ,depth) 
	this\Child[4] = Octree(xcentr,ymin,zmin  ,xmax,ycentr,zcentr ,depth) 
	this\Child[5] = Octree(xmin,ymin,zcentr  ,xcentr,ycentr,zmax,depth) 
	this\Child[6] = Octree(xmin,ycentr,zcentr  ,xcentr,ymax,zmax,depth)
	this\Child[7] = Octree(xcentr,ycentr,zcentr  ,xmax,ymax,zmax,depth) 
	this\Child[8] = Octree(xcentr,ymin,zcentr  ,xmax,ycentr,zmax,depth) 

End If
	Return this
End Function


; ====================      =====================
Function RenderOctree(this.OCTREE,depth)

If this.OCTREE <> Null
;If PointInCube(this\xmin,this\ymin,this\zmin,this\xmax,this\ymax,this\zmax,mx,my,pz ) 	= True
	If (depth >= 0)			
	
		      Color 28,28,28
		      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
	
			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)
			RenderOctree(this\Child[8],depth)	
			
		Color 6,6,196
		Rect this\xmin+1,this\ymin+1,this\xmax-this\xmin-2,this\ymax-this\ymin-2,0
		Color 128,128,128
		Text this\xmin+this\depth*4,this\ymin+this\depth*4,"+  " +this\depth
	Else
		Color 196,6,6
		Rect this\xmin+2,this\ymin+2,this\xmax-this\xmin-3,this\ymax-this\ymin-3,1
		Color 128,128,128
		Text this\xmin+this\depth*4,this\ymin+this\depth*4,"+  " +this\depth
	End If 
End If 
;End If
End Function

; ====================      =====================
Function AddToOctree.OCTREE(xmin,ymin,zmin,xmax,ymax,zmax,depth)
If PointInCube(xmin,ymin,zmin,xmax,ymax,zmax,mx,my,pz ) 	= True 
	xcentr = (xmin+xmax) / 2
	ycentr = (ymin+ymax) / 2
	zcentr = (zmin+zmax) / 2
	
this.OCTREE = New OCTREE
	this\xmin = xmin
	this\xmax = xmax
	this\ymin = ymin
	this\ymax = ymax
	this\zmin = zmin
	this\zmax = zmax
	this\xcentr = xcentr
	this\ycentr = ycentr
	this\zcentr = zcentr
	this\depth = depth 		
;	id = id + 1	

If (depth > 0)	

	depth = depth - 1

	this\Child[1] = AddToOctree(xmin,ymin,zmin  ,xcentr,ycentr,zcentr ,depth) 
	this\Child[2] = AddToOctree(xmin,ycentr,zmin  ,xcentr,ymax,zcentr ,depth)
	this\Child[3] = AddToOctree(xcentr,ycentr,zmin  ,xmax,ymax,zcentr ,depth) 
	this\Child[4] = AddToOctree(xcentr,ymin,zmin  ,xmax,ycentr,zcentr ,depth) 
	this\Child[5] = AddToOctree(xmin,ymin,zcentr  ,xcentr,ycentr,zmax,depth) 
	this\Child[6] = AddToOctree(xmin,ycentr,zcentr  ,xcentr,ymax,zmax,depth)
	this\Child[7] = AddToOctree(xcentr,ycentr,zcentr  ,xmax,ymax,zmax,depth) 
	this\Child[8] = AddToOctree(xcentr,ymin,zcentr  ,xmax,ycentr,zmax,depth) 

EndIf
EndIf
	Return this
End Function





Graphics 800,600,32,2 
SetBuffer BackBuffer() 
HidePointer

QuadDepth =5    ; 8 ;число вложений (глубина ) 
QuadSize = 512 ; размеры квадранта 

timestart = MilliSecs()
root.OCTREE = Octree(0,0,0,QuadSize,QuadSize,QuadSize,QuadDepth)
timeout = (MilliSecs()-timestart)
While Not KeyHit(1) 
mx = MouseX() 
my = MouseY() 
s = Abs(MouseZ())
Cls 
Select True 
Case KeyDown(200) : py=py-1*20; Up
Case KeyDown(208) : py=py+1*20; Down
Case KeyDown(203) : px=px-1*20; Left
Case KeyDown(205) : px=px+1*20; Right
Case KeyDown(57) 
End Select 
If  KeyHit(30) And pz <180 Then pz=pz+10 ;   A key
If  KeyHit(44) And pz > 0 Then pz=pz-10	

		If MouseDown(1) Or KeyDown(157)  Then ;
		If root.OCTREE <> Null
		;If root\Child[c] <> Null
		For c = 1 To 8
		If PointInCube(root\Child[c]\xmin,root\Child[c]\ymin,root\Child[c]\zmin,root\Child[c]\xmax,root\Child[c]\ymax,root\Child[c]\zmax,mx,my,pz ) 	= True 
		
			;root.OCTREE = AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
		Text 200,200,"YES !!!     "	+c
			root\Child[c] = AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
		;Else 	
			;root.OCTREE =	AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
			;root\Child[c] = AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
		EndIf 
		
		Next 
		EndIf 
		;EndIf 
		EndIf 
		If MouseDown(2)  Then ;

		EndIf 
		
	
myy = (2*(my-400) -(mx-400))/2 + pz;-s
mxx = ((mx-400)+myy);-;s


;RenderStaticLine(root)	
RenderOctree(root,QuadDepth)

Color 255,255,255
Oval 400+ mxx -myy -(6) , 400+ (mxx +myy )/2-pz-(6) ,(12),(12),0

Color 255,5,5
;	Line  400+ (root\xmin-root\ymax),400+ (root\xmin+root\ymax)/2- pz,400+ (root\xmax-root\ymax) , 400+ (root\xmax+root\ymax)/2-pz
;	Line  400+ (root\xmax-root\ymax) , 400+ (root\xmax+root\ymax)/2- pz ,400+ (root\xmax-root\ymin),400+ (root\xmax+root\ymin)/2-pz
Text 550,20,"S = "+s+"   col-vo elements = "+id
Text 550,180-pz,"  Z = "+pz+"     timeout  "+timeout 
Flip 
Wend 
Delete Each OCTREE
End  

Function RenderStaticLine(this.OCTREE)
If this.OCTREE <> Null
Color 255,255,255
	Line 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- this\zmin , 400+ (this\xmin-this\ymax),400+ (this\xmin+this\ymax)/2- this\zmin
	Line  400+ (this\xmin-this\ymax),400+ (this\xmin+this\ymax)/2- this\zmin,400+ (this\xmax-this\ymax) , 400+ (this\xmax+this\ymax)/2- this\zmin 
	Line  400+ (this\xmax-this\ymax) , 400+ (this\xmax+this\ymax)/2- this\zmin ,400+ (this\xmax-this\ymin),400+ (this\xmax+this\ymin)/2- this\zmin
	Line  400+ (this\xmax-this\ymin),400+ (this\xmax+this\ymin)/2- this\zmin , 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- this\zmin 
Color 255,5,5	
	Line 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- pz , 400+ (this\xmin-this\ymax),400+ (this\xmin+this\ymax)/2-pz
	Line  400+ (this\xmax-this\ymin),400+ (this\xmax+this\ymin)/2- pz , 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- pz
Color 255,255,255	
End If
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



Function CombineARGB#(aa#,rr%,gg%,bb%)	
	;Return aa*$1000000+rr*$10000+gg*$100+bb	
	Return $ff000000 Or rr Shl 16 Or gg Shl 8 Or bb 
End Function