[polopok]

Итак , пробую связать воксели в изометрии .
Код правда сырой ,да и при большей глубине(depth) уж сильно тормозит
код:

Global id,level ,mx,my ,QDepth  
Global px#,py,pz ,s

Type QUADTREE
Field Child.QUADTREE[7] ;8 потомков
Field xmin,ymin,zmin ; начальные координаты квадранта
Field xmax,ymax,zmax ; оконечные координаты квадранта 
Field id ,vis , lock;  ;vis - visible , lock - bloked
End Type

Function Quadtree.QUADTREE(xmin,ymin,zmin,xmax,ymax,zmax,depth)
this.QUADTREE = New QUADTREE
this\xmin = xmin
this\xmax = xmax
this\ymin = ymin
this\ymax = ymax
this\zmin = zmin
this\zmax = zmax

id = id + 1
this\id = id
this\vis = False
this\lock= False

If (depth > 1)
; =============================================
xmod = (xmin+xmax) / 2
ymod = (ymin+ymax) / 2
zmod = (zmin+zmax) / 2

depth = depth - 1
this\Child[0] = Quadtree(xmin,ymin,zmin  ,xmod,ymod,zmod ,depth) 
this\Child[1] = Quadtree(xmin,ymod,zmin  ,xmod,ymax,zmod ,depth)
this\Child[2] = Quadtree(xmod,ymod,zmin  ,xmax,ymax,zmod ,depth) 
this\Child[3] = Quadtree(xmod,ymin,zmin  ,xmax,ymod,zmod ,depth) 

this\Child[4] = Quadtree(xmin,ymin,zmod  ,xmod,ymod,zmax,depth) 
this\Child[5] = Quadtree(xmin,ymod,zmod  ,xmod,ymax,zmax,depth)
this\Child[6] = Quadtree(xmod,ymod,zmod  ,xmax,ymax,zmax,depth) 
this\Child[7] = Quadtree(xmod,ymin,zmod  ,xmax,ymod,zmax,depth) 

EndIf
Return this
End Function

; =========================================
Function RenderQuadtree(this.QUADTREE,depth)

If (depth > 1)
	xmod = (xmin+xmax) / 2
	ymod = (ymin+ymax) / 2
	zmod = (zmin+zmax) / 2
		
		Color 88,88,88
			Rect this\xmin, this\ymin,this\xmax-this\xmin,this\ymax-this\ymin ,0
			

			
			
		depth = depth - 1
		RenderQuadtree(this\Child[0],depth)
		RenderQuadtree(this\Child[1],depth)
		RenderQuadtree(this\Child[2],depth)
		RenderQuadtree(this\Child[3],depth)
		
		RenderQuadtree(this\Child[4],depth)
		RenderQuadtree(this\Child[5],depth)
		RenderQuadtree(this\Child[6],depth)
		RenderQuadtree(this\Child[7],depth)
		
		If this\vis=True 
			Rect this\xmin+2, this\ymin+2,this\xmax-this\xmin-4,this\ymax-this\ymin-4 ,1
			
			xdot = (this\xmax+this\xmin)/2
			ydot = (this\ymax+this\ymin)/2
			zdot = (this\zmax+this\zmin)/2
			Color 40+zdot,40+zdot,40+zdot
			Oval 400+ (xdot -ydot*px) -13*(depth), 300+ (xdot +ydot*px )/2-zdot -13*(depth) , 26*(depth+depth),26*(depth+depth),1
			
		;	For y=this\ymin To this\ymax Step 5
		;		For x=this\xmin To this\xmax Step 5
		;		 For z=this\zmin To this\zmax Step 5
		;			Color 255,255,255
		;			Plot 400+x-y,400+(x+ y)/2-z	
		;		 Next
		;		Next
		;	Next 
			
		EndIf 
		
		

End If 

End Function

Function CalcQuadtree(this.QUADTREE,depth)

If (depth > 1)
		depth = depth - 1
		CalcQuadtree(this\Child[0],depth)
		CalcQuadtree(this\Child[1],depth)
		CalcQuadtree(this\Child[2],depth)
		CalcQuadtree(this\Child[3],depth)
		
		CalcQuadtree(this\Child[4],depth)
		CalcQuadtree(this\Child[5],depth)
		CalcQuadtree(this\Child[6],depth)
		CalcQuadtree(this\Child[7],depth)
		
		If this\Child[0]\lock= 1  And  this\Child[1]\lock= 1  And this\Child[2]\lock= 1 And  this\Child[3]\lock= 1 And  this\Child[4]\lock= 1  And  this\Child[5]\lock= 1  And this\Child[6]\lock= 1 And  this\Child[7]\lock= 1 Then		
			
			this\vis=True
			this\lock=True
			this\Child[0]\vis= False
			this\Child[1]\vis= False
			this\Child[2]\vis= False
			this\Child[3]\vis= False
			
			this\Child[4]\vis= False
			this\Child[5]\vis= False
			this\Child[6]\vis= False
			this\Child[7]\vis= False
		 
		EndIf

	If  depth =s  Then  ;depth =s  And pz > zmin And pz< zmax
	  If  mx >=this\xmin And mx < this\xmax
	    If  my >=this\ymin And my < this\ymax
	      If pz >=this\zmin And pz < this\zmax
	
			For y=this\ymin To this\ymax Step 3
			   For x=this\xmin To this\xmax Step 3
				 For z=this\zmin To this\zmax Step 3
					Color 255,5,5
					Plot 400+x-y*px,300+(x+ y*px)/2-z	
				 Next
			   Next
			Next 
			
;			xdot = (this\xmax+this\xmin)/2
;			ydot = (this\ymax+this\ymin)/2
;			zdot = (this\zmax+this\zmin)/2
;			Color 255,255,255
;			Oval 400+ xdot -ydot -6, 400+ (xdot +ydot )/2-zdot -6 , 12,12,1
	
		Rect this\xmin, this\ymin,this\xmax-this\xmin,this\ymax-this\ymin ,1
		Rect 250, 175 - this\zmin,25,this\zmax-this\zmin ,1
		Text 400,40, this\id +" visible = "+this\vis+"  Lock = "+this\lock
		If MouseDown(1) Or KeyDown(157) And this\lock= False Then ;
			this\lock=True 
			 this\vis=True 
		EndIf 
		If MouseDown(2) And this\lock= True Then ;
			this\lock=False 
			 this\vis=False 
		EndIf 
	      End If 
	    End If
	  End If
	End If		

End If 

End Function

Function EraseQuadtree(this.QUADTREE,depth)

If (depth > 1)
		depth = depth - 1
		EraseQuadtree(this\Child[0],depth)
		EraseQuadtree(this\Child[1],depth)
		EraseQuadtree(this\Child[2],depth)
		EraseQuadtree(this\Child[3],depth)

		EraseQuadtree(this\Child[4],depth)
		EraseQuadtree(this\Child[5],depth)
		EraseQuadtree(this\Child[6],depth)
		EraseQuadtree(this\Child[7],depth)
		
			this\lock=False 
			 this\vis=False 	
End If 

End Function

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

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


root.QUADTREE = Quadtree(0,0,0,QuadSize,QuadSize,QuadSize,QuadDepth)
px=1
While Not KeyHit(1) 
mx = MouseX() 
my = MouseY() 
s = Abs(MouseZ())+1

Cls 
Select True 
Case KeyHit(200) : py=py-0.1 ;Up
Case KeyHit(208) : py=py+0.1;Down
Case KeyHit(203) : px=px-0.1; Left
Case KeyHit(205) : px=px+0.1; Right
Case KeyDown(30) : pz=pz+1*15;   A key
Case KeyDown(44) : pz=pz-1*15;   Z key
Case KeyDown(57) : EraseQuadtree(root,QuadDepth)
End Select 
;	If px<0 Then px=1 
;	 If px>=180 Then px=180
	If py<0 Then py=1 
	 If py>=180 Then py=180
	If pz<0 Then mz=1 
	 If pz>=180 Then pz=180

Color 255,255,255
Rect root\xmin,root\ymin,root\xmax,root\ymax,0
Rect 250,0,25,root\ymax,0


RenderQuadtree(root,QuadDepth)
CalcQuadtree(root,QuadDepth)

Text 400,20,"S = "+s
Text 400,60,"px = "+px+"  py = "+my+"  pz = "+pz
Flip 
Wend 
End