Global id,level ,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
Field id ,vis , lock; ;vis - visible
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
this\id = id
this\vis = False
this\lock= False
If (depth > 0)
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)
EndIf
Return this
End Function
; ==================== =====================
Function RenderOctree(this.OCTREE,depth)
If (depth > 0)
xcentr = (xmin+xmax) / 2
ycentr = (ymin+ymax) / 2
zcentr = (zmin+zmax) / 2
Color 88,88,88
Rect this\xmin, this\ymin,this\xmax-this\xmin,this\ymax-this\ymin ,0
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)
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
LockBuffer BackBuffer()
For y=this\ymin To this\ymax Step 1
For x=this\xmin To this\xmax Step 1
For z=this\zmin To this\zmax Step 1
WritePixel 400+x-y,400+(x+ y)/2-z, $ffffff , BackBuffer()
; Plot 400+x-y,400+(x+ y)/2-z
Next
Next
Next
; Oval 400+ xdot -ydot -(6) , 400+ (xdot +ydot )/2-zdot -(6) ,(12+depth*2),(12),1
UnlockBuffer BackBuffer()
EndIf
Else
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
Oval 400+ xdot -ydot -(6) , 400+ (xdot +ydot )/2-zdot -(6) ,(12),(12),1
EndIf
End If
End Function
Function CalcOctree(this.OCTREE,depth)
If PointInCube(this\xmin,this\ymin,this\zmin,this\xmax,this\ymax,this\zmax,mxx,myy,pz )=True
If (depth > 0)
depth = depth - 1
CalcOctree(this\Child[1],depth)
CalcOctree(this\Child[2],depth)
CalcOctree(this\Child[3],depth)
CalcOctree(this\Child[4],depth)
CalcOctree(this\Child[5],depth)
CalcOctree(this\Child[6],depth)
CalcOctree(this\Child[7],depth)
CalcOctree(this\Child[8],depth)
If 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 And this\Child[8]\lock= 1 Then
this\vis=True
this\lock=True
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
this\Child[8]\vis= False
EndIf
Else
LockBuffer BackBuffer()
For y=this\ymin To this\ymax Step 2
For x=this\xmin To this\xmax Step 2
For z=this\zmin To this\zmax Step 2
; ;
WritePixelFast 400+x-y,400+(x+ y)/2-z, $ff0000 , BackBuffer()
;
Next
Next
Next
UnlockBuffer BackBuffer()
Color 255,5,5
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 Function
Function EraseOctree(this.OCTREE,depth)
If (depth > 0)
depth = depth - 1
EraseOctree(this\Child[1],depth)
EraseOctree(this\Child[2],depth)
EraseOctree(this\Child[3],depth)
EraseOctree(this\Child[4],depth)
EraseOctree(this\Child[5],depth)
EraseOctree(this\Child[6],depth)
EraseOctree(this\Child[7],depth)
EraseOctree(this\Child[8],depth)
this\lock=False
this\vis=False
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
Graphics 800,600,32,2
SetBuffer BackBuffer()
QuadDepth = 4;число вложений (глубина )
QuadSize = 200 ; размеры квадранта
; ???????? ????????? ?????????
root.OCTREE = Octree(0,0,0,QuadSize,QuadSize,QuadSize,QuadDepth)
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) : EraseOctree(root,QuadDepth)
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 px<0 Then px=0
If px>=180 Then px=180
If py<0 Then py=0
If py>=180 Then py=180
myy = (2*(my-400) -(mx-400))/2 + pz;-s
mxx = ((mx-400)+myy);-;s
Color 255,255,255
Rect root\xmin,root\ymin,root\xmax,root\ymax,0
Rect 250,0,25,root\ymax,0
Line 400+ (root\xmin-root\ymin) , 400+ (root\xmin+root\ymin)/2- root\zmin , 400+ (root\xmin-root\ymax),400+ (root\xmin+root\ymax)/2- root\zmin
Line 400+ (root\xmin-root\ymax),400+ (root\xmin+root\ymax)/2- root\zmin,400+ (root\xmax-root\ymax) , 400+ (root\xmax+root\ymax)/2- root\zmin
Line 400+ (root\xmax-root\ymax) , 400+ (root\xmax+root\ymax)/2- root\zmin ,400+ (root\xmax-root\ymin),400+ (root\xmax+root\ymin)/2- root\zmin
Line 400+ (root\xmax-root\ymin),400+ (root\xmax+root\ymin)/2- root\zmin , 400+ (root\xmin-root\ymin) , 400+ (root\xmin+root\ymin)/2- root\zmin
Color 255,5,5
Line 400+ (root\xmin-root\ymin) , 400+ (root\xmin+root\ymin)/2- pz , 400+ (root\xmin-root\ymax),400+ (root\xmin+root\ymax)/2-pz
Line 400+ (root\xmax-root\ymin),400+ (root\xmax+root\ymin)/2- pz , 400+ (root\xmin-root\ymin) , 400+ (root\xmin+root\ymin)/2- pz
Color 255,255,255
RenderOctree(root,QuadDepth)
CalcOctree(root,QuadDepth)
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 400,20,"S = "+s+" col-vo elements = "+id
Text 300,180-pz," Z = "+pz
Flip
Wend
End
; combine Alpha, Red, Green, Blue values to a RGB value
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