Ответ: Voxel (octotree)
Итак , продолжаем. Пришлось изменить код ,так как , в первом варианте я делил весь объём куба на меньшие ,а потому память слала далеко-далеко ,когда глубина вложений превышала 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
|