[polopok]

Я тут подумал , если точки в вокселе нет ,то он удаляется ,но в динамике точки перемещаются , а потому могут сново попасть в удалённый узел ,значит нужно удалять только те воксели при премещении точек оказались пусты . Так что я ввёл дополнительный параметр ,как жизнь вокселя . Думаю понятней будет в коде ( добавленые/изменённые строки ,помечены так ;///

time = CreateTimer(120)
SeedRnd(MilliSecs())
Const Points = 200
Global id,id2,mx,my ,CubDepth ,CubSize   
Global px,py,pz ,s ,mxx,myy , mmy 
Global timeoutcreate# , timeintcreate 
Global viewline ,v=3


Type OCTREE
Field Child.OCTREE[7] ;8 потомков
Field xmin,ymin,zmin
Field  emply , timeLive, isView	 ;///
;Field qred,qgreen,qblue,qalpha,qcolor
Field size , depth 
End Type

Type Point
Field x,y,z
Field x2,y2,z2
Field vx,vy,vz
End Type 

Global root.OCTREE , one.OCTREE

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 
	this\emply =0
	id2=id2+1
	
	Return this
End Function




Function AddOctree.OCTREE( this.OCTREE,xmin,ymin,zmin ,size,depth )

If  InCube(xmin,ymin,zmin,size) =  True 
	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 
		id2=id2+1
		this\emply = 1
	Else 		
	this\emply = 1
	this\timelive = 0	 ;///
		If depth >0		
		newdepth = depth -1
		newxmin = xmin+newsize
		newymin = ymin+newsize
		newzmin = zmin+newsize
		this\Child[0] = AddOctree(this\Child[0], xmin,ymin,zmin  ,newsize ,newdepth ) 
		this\Child[1] = AddOctree(this\Child[1], xmin,newymin  ,zmin  ,newsize ,newdepth )
		this\Child[2] = AddOctree(this\Child[2], newxmin ,newymin ,zmin  ,newsize  ,newdepth ) 
		this\Child[3] = AddOctree(this\Child[3], newxmin ,ymin,zmin  ,newsize  ,newdepth ) 
		
		this\Child[4] = AddOctree(this\Child[4], xmin,ymin,newzmin ,newsize,newdepth ) 
		this\Child[5] = AddOctree(this\Child[5], xmin,newymin ,newzmin ,newsize ,newdepth )
		this\Child[6] = AddOctree(this\Child[6], newxmin ,newymin ,newzmin ,newsize ,newdepth ) 
		this\Child[7] = AddOctree(this\Child[7], newxmin ,ymin,newzmin ,newsize ,newdepth ) 
		
		EndIf 
	EndIf
Else 
	If  this<>Null
	this\emply = 0	
	this\timelive = 1	 ;///
	If depth >0		
		newdepth = depth -1
		newxmin = xmin+newsize
		newymin = ymin+newsize
		newzmin = zmin+newsize
		this\Child[0] = AddOctree(this\Child[0], xmin,ymin,zmin  ,newsize ,newdepth ) 
		this\Child[1] = AddOctree(this\Child[1], xmin,newymin  ,zmin  ,newsize  ,newdepth )
		this\Child[2] = AddOctree(this\Child[2], newxmin ,newymin ,zmin  ,newsize  ,newdepth ) 
		this\Child[3] = AddOctree(this\Child[3], newxmin ,ymin,zmin  ,newsize ,newdepth ) 
		
		this\Child[4] = AddOctree(this\Child[4], xmin,ymin,newzmin ,newsize ,newdepth ) 
		this\Child[5] = AddOctree(this\Child[5], xmin,newymin ,newzmin ,newsize ,newdepth )
		this\Child[6] = AddOctree(this\Child[6], newxmin ,newymin ,newzmin ,newsize ,newdepth ) 
		this\Child[7] = AddOctree(this\Child[7], newxmin ,ymin,newzmin ,newsize ,newdepth ) 
		
	EndIf 
	EndIf
EndIf
	Return this
End Function


Function InCube(Axmin,Aymin,Azmin,Asize)
	For pts.POINT = Each POINT
		If PointInCube(Axmin,Aymin,Azmin,Axmin+Asize,Aymin+Asize,Azmin+Asize,pts\x,pts\y,pts\z ) = True  Then 
		Return True 
		Exit 
		EndIf 
	Next 
	Return False 
End Function 

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

 For p = 0 To Points 
	pt.POINT = New POINT
	pt\x = Int(Rnd(10,120))
	pt\y =  Int(Rnd(10,120))
	pt\z =  Int(Rnd(10,120))
	id3 = id3 +1
 Next 
CubDepth =6 ; 8 ;число вложений (глубина ) 
CubSize = 128 ; размеры квадранта 

root.OCTREE = RootOctree(0,0,0,CubSize ,CubDepth )
While Not KeyHit(1) 
start  = MilliSecs()
id=0
Cls 

If KeyHit(28)  Then viewline = Not viewline 


WaitTimer(time)

timestart = MilliSecs()

	AddOctree(root, 0,0,0,CubSize ,CubDepth)	

For pt2.POINT = Each POINT	

	If pt2\x <-250 Then 

	v=3
	EndIf
	If pt2\x >= 226 Then 

	v=-3
	EndIf
        pt2\x = pt2\x +v	
Next 

For roots.OCTREE = Each OCTREE 
	If roots<>Null	
		id=id+1
		If roots\timelive = 1 Then roots\timelive = roots\timelive +1  ;///
		If roots\emply = 0 And roots\timelive = 2 And roots <> First OCTREE  ;///
		Delete roots
		id2=id2-1
		EndIf 
	EndIf 
Next 


RenderOctree(root,CubDepth )

timeout = (MilliSecs()-timestart)	


;--------------- INFO -----------------------------------
	Color 255,255,255
	Text 550,20,"Elements = "+id+"   id2  = "+id2
	Text 550,80,"Time AddOctree = "+timeout  
	timeoutvis = (MilliSecs()-timeinvis)	
	Text 550,100,"Current FPS: " + CurFPS#  
	Text 550,120,"ViewBoxes = "+viewline +"       - press ENTER"
	CurFPS# = 1000.0 / (MilliSecs() - Start)
Flip 
Wend 
Delete Each OCTREE
Delete Each POINT
FreeTimer time
End  

Function RenderOctree(this.OCTREE,depth)
If this.OCTREE <> Null 
	If (depth >0)	And this\emply = 1
		If viewline = 0			
			If this\emply = 0 Then Color 255,0,255
			If this= First OCTREE  Then Color 0,0,255 Else Color 200,200,200
			
						
			x_min1 = 400+ (this\xmin - this\ymin)
			x_min2 = 400+ ((this\xmin+this\size) - this\ymin)
			x_min3 = 400+ ((this\xmin+this\size) - (this\ymin+this\size))
			x_min4 = 400+ ((this\xmin) - (this\ymin+this\size))
			
			y_min1 = 300+ (this\xmin + this\ymin)/2 -  this\zmin
			y_min2 = 300+ ((this\xmin+this\size) + this\ymin)/2 -  this\zmin
			y_min3 = 300+ ((this\xmin+this\size) + (this\ymin+this\size))/2 -  this\zmin 
			y_min4 = 300+ ((this\xmin) + (this\ymin+this\size))/2 -  this\zmin
				
				Line x_min1 , y_min1 , x_min2 , y_min2
				Line x_min2 , y_min2 , x_min3 , y_min3
				Line x_min3 , y_min3 , x_min4 , y_min4
				Line x_min4 , y_min4 , x_min1 , y_min1
					
				Line x_min1 , y_min1 -this\size , x_min2 , y_min2 -this\size
				Line x_min2 , y_min2 -this\size , x_min3 , y_min3 -this\size
				Line x_min3 , y_min3 -this\size , x_min4 , y_min4 -this\size
				Line x_min4 , y_min4 -this\size , x_min1 , y_min1 -this\size
				
				Line x_min1 , y_min1 , x_min1 , y_min1 -this\size
				Line x_min2 , y_min2 , x_min2 , y_min2 -this\size
				Line x_min3 , y_min3 , x_min3 , y_min3 -this\size
				Line x_min4 , y_min4 , x_min4 , y_min4 -this\size
		
		EndIf 
			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)	

	Else 	
		If viewline = 1	
			zz = this\zmin
			If  zz > 200 Then zz = 200 
			If zz < 0 Then zz = 0
			
				Color 25+zz ,25+zz ,25+zz
			LockBuffer GraphicsBuffer()
						WritePixel 400+ ( this\xmin -this\ymin) , 300+ ( this\xmin +this\ymin)/2 - this\zmin,$ffffff, GraphicsBuffer()
			UnlockBuffer GraphicsBuffer()
		EndIf 	
		

			
			LockBuffer GraphicsBuffer()
			WritePixel this\xmin , this\ymin , $ffffff	
			UnlockBuffer GraphicsBuffer()

	EndIf 
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