|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
|
Ответ: Voxel (octotree)
Итак ,кажись получилось разобраться с родителями-потомками ,дабы не запутаться написал пример без Z координаты .
Если у кого есть идеи улучшения ,буду рад ознакомиться.
 Global id,mx,my ,CubDepth
Global px,py,pz ,s ,mxx,myy
Type OCTREE
Field Child.OCTREE[8] ;8 потомков
Field xmin,ymin,zmin
Field xcentr,ycentr,zcentr ; центр куба
Field qred,qgreen,qblue,qalpha,qcolor
Field size , depth , block=False
End Type
;Global root.OCTREE
Function RootOctree.OCTREE(xmin,ymin,zmin ,size,depth)
newsize = size / 2
this.OCTREE = New OCTREE
this\xmin = xmin
this\ymin = ymin
this\zmin = 0
this\size = size
this\depth = depth
id = id + 1
If depth = CubDepth
depth = depth - 1
this\Child[0] = Null
this\Child[1] = Null
this\Child[2] = Null
this\Child[3] = Null
EndIf
Return this
End Function
Function AddOctree.OCTREE( this.OCTREE,xmin,ymin,zmin ,size,depth)
If PointInCube(xmin,ymin,zmin,xmin+size,ymin+size,zmin+size,mx,my,0 )
newsize = size / 2
If depth >0
depth = depth - 1
If this <> Null
For cub = 0 To 3
If this\Child[cub] <> Null
If PointInCube( this\Child[cub]\xmin,this\Child[cub]\ymin,this\Child[cub]\zmin,this\Child[cub]\xmin+this\Child[cub]\size,this\Child[cub]\ymin+this\Child[cub]\size,this\Child[cub]\zmin+this\Child[cub]\size,mx,my,0 )
AddOctree(this\Child[cub], this\Child[cub]\xmin ,this\Child[cub]\ymin ,0,newsize, depth)
EndIf
EndIf
Next
If this\Child[0] = Null
If this\Child[1] = Null
If this\Child[2] = Null
If this\Child[3] = Null
this0.OCTREE = New OCTREE
this0\xmin = xmin + newsize
this0\ymin = ymin
this0\size = newsize
this0\depth = depth
this1.OCTREE = New OCTREE
this1\xmin = xmin
this1\ymin = ymin + newsize
this1\size = newsize
this1\depth = depth
this2.OCTREE = New OCTREE
this2\xmin = xmin
this2\ymin = ymin
this2\size = newsize
this2\depth = depth
this3.OCTREE = New OCTREE
this3\xmin = xmin + newsize
this3\ymin = ymin + newsize
this3\size = newsize
this3\depth = depth
id = id + 4
this\Child[0] = this0
this\Child[1] = this1
this\Child[2] = this2
this\Child[3] = this3
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
Return this
End Function
Graphics 800,600,32,2
SetBuffer BackBuffer()
;HidePointer
CubDepth =6 ; 8 ;число вложений (глубина )
CubSize = 512 ; размеры квадранта
root.OCTREE = RootOctree(0,0,0,CubSize ,CubDepth )
While Not KeyHit(1)
mx = MouseX()
my = MouseY()
s = Abs(MouseZ())
Cls
If MouseDown(1) Or KeyDown(157) Then ;
timestart = MilliSecs()
; FindChildOctree(root)
AddOctree(root, 0,0,0,CubSize ,CubDepth)
timeout = (MilliSecs()-timestart)
EndIf
RenderOctree(root,CubDepth )
Color 255,255,255
;Rect 0 , 0 , CubSize , CubSize ,0
Text 550,20,"S = "+s+" col-vo elements = "+id
Text 550,180-pz," Z = "+pz+" timeout "+timeout
Flip
Wend
Delete Each OCTREE
End
Function RenderOctree(this.OCTREE,depth)
If this.OCTREE <> Null
If (depth > 0)
Color 128,128,128
Rect this\xmin , this\ymin , this\size , this\size , 0
Text this\xmin +this\depth*6, this\ymin +this\depth*6 , this\depth
depth = depth - 1
RenderOctree(this\Child[0],depth)
RenderOctree(this\Child[1],depth)
RenderOctree(this\Child[2],depth)
RenderOctree(this\Child[3],depth)
Else
Color 128,128,128
Rect this\xmin , this\ymin , this\size , this\size , 1
End If
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
Вот несколько улучшил код ...
но всё-же ,далеко до "идеала"
Global id,mx,my ,CubDepth
Global px,py,pz ,s ,mxx,myy
Type OCTREE
Field Child.OCTREE[8] ;8 потомков
Field xmin,ymin,zmin
Field xcentr,ycentr,zcentr ; центр куба
Field qred,qgreen,qblue,qalpha,qcolor
Field size , depth , block=False
End Type
;Global root.OCTREE
Function RootOctree.OCTREE(xmin,ymin,zmin ,size,depth)
newsize = size / 2
this.OCTREE = New OCTREE
this\xmin = xmin
this\ymin = ymin
this\zmin = 0
this\size = size
this\depth = depth
id = id + 1
If depth = CubDepth
depth = depth - 1
this\Child[0] = Null
this\Child[1] = Null
this\Child[2] = Null
this\Child[3] = Null
EndIf
Return this
End Function
Function AddOctree.OCTREE( this.OCTREE,xmin,ymin,zmin ,size,depth)
If PointInCube(xmin,ymin,zmin,xmin+size,ymin+size,zmin+size,mx,my,0 )
newsize = size / 2
If depth >0
depth = depth - 1
If this <> Null
For cub = 0 To 3
If this\Child[cub] <> Null
If PointInCube( this\Child[cub]\xmin,this\Child[cub]\ymin,this\Child[cub]\zmin,this\Child[cub]\xmin+this\Child[cub]\size,this\Child[cub]\ymin+this\Child[cub]\size,this\Child[cub]\zmin+this\Child[cub]\size,mx,my,0 )
AddOctree(this\Child[cub], this\Child[cub]\xmin ,this\Child[cub]\ymin ,0,newsize, depth)
EndIf
EndIf
Next
For cub = 0 To 3
If this\Child[cub ] = Null
Select cub
Case 0
this0.OCTREE = New OCTREE
this0\xmin = xmin + newsize
this0\ymin = ymin
this0\size = newsize
this0\depth = depth
this\Child[0] = this0
Case 1
this1.OCTREE = New OCTREE
this1\xmin = xmin
this1\ymin = ymin + newsize
this1\size = newsize
this1\depth = depth
this\Child[1] = this1
Case 2
this2.OCTREE = New OCTREE
this2\xmin = xmin
this2\ymin = ymin
this2\size = newsize
this2\depth = depth
this\Child[2] = this2
Case 3
this3.OCTREE = New OCTREE
this3\xmin = xmin + newsize
this3\ymin = ymin + newsize
this3\size = newsize
this3\depth = depth
this\Child[3] = this3
End Select
id = id + 1
AddOctree( this,xmin,ymin,zmin ,size,depth)
EndIf
Next
EndIf
EndIf
EndIf
End Function
Graphics 800,600,32,2
SetBuffer BackBuffer()
;HidePointer
CubDepth =8 ; 8 ;число вложений (глубина )
CubSize = 512 ; размеры квадранта
root.OCTREE = RootOctree(0,0,0,CubSize ,CubDepth )
While Not KeyHit(1)
mx = MouseX()
my = MouseY()
s = Abs(MouseZ())
Cls
If MouseDown(1) Or KeyDown(157) Then ;
timestart = MilliSecs()
; FindChildOctree(root)
AddOctree(root, 0,0,0,CubSize ,CubDepth)
timeout = (MilliSecs()-timestart)
EndIf
RenderOctree(root,CubDepth )
Color 255,255,255
;Rect 0 , 0 , CubSize , CubSize ,0
Text 550,20,"S = "+s+" col-vo elements = "+id
Text 550,180-pz," Z = "+pz+" timeout "+timeout
Flip
Wend
Delete Each OCTREE
End
Function RenderOctree(this.OCTREE,depth)
If this.OCTREE <> Null
If (depth > 0)
Color 128,128,128
Rect this\xmin , this\ymin , this\size , this\size , 0
Text this\xmin +this\depth*6, this\ymin +this\depth*6 , this\depth
depth = depth - 1
RenderOctree(this\Child[0],depth)
RenderOctree(this\Child[1],depth)
RenderOctree(this\Child[2],depth)
RenderOctree(this\Child[3],depth)
Else
Color 128,128,128
Rect this\xmin , this\ymin , this\size , this\size , 1
End If
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
__________________
Мой проект здесь
Последний раз редактировалось polopok, 13.05.2013 в 14:50.
|