ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
Ну ,вот , наконец-то что-то получилось ...
Ошибка крылась как всегда в моей невнимательности .
Правда с удалением пришлось повозиться.
Считаю вполне рабочий вариант
код:
SeedRnd MilliSecs()
Const Points = 22 ; колличество точек
Const ConstDepth = 6 ;глубина вложений
Type Octree
Field Child.Octree[7] , Parent.Octree;8 потомков и родитель
Field xmin,ymin,zmin
;Field xcentr,ycentr,zcentr ; ????? ????
Field qred,qgreen,qblue,qalpha,qcolor
Field size , depth
End Type
Global root.Octree , sel.Octree , parent.Octree
Global id,id2,id3,mx,my ;,CubDepth ,CubSize
Global px,py,pz ,s ,mxx,myy , mmy
Global timeoutcreate# , timeintcreate , viewline
Type Point
Field x,y,z
Field x2,y2,z2
Field vx,vy,vz
End Type
Function CreateOctree.Octree(xmin,ymin,zmin ,size,depth,par.Octree)
id2=id2+1
this.Octree= New Octree
this\xmin = xmin
this\ymin = ymin
this\zmin = zmin
this\size = size
this\depth = depth
this\parent = par
For ok = 0 To 7
this\child[ok] = Null
Next
Return this
End Function
Function AddOctree.Octree( this.Octree,xmin,ymin,zmin ,size,ppx,ppy,ppz,depth)
If depth >0
If PointInCube(xmin,ymin,zmin,xmin+size,ymin+size,zmin+size,ppx,ppy,ppz )
newsize = (size Shr 1)
If this = Null
this = CreateOctree(xmin,ymin,zmin ,size,depth,this)
AddOctree(this , xmin,ymin,zmin ,size,ppx,ppy,ppz , depth)
Else
newdepth = depth -1
newxmin = xmin+newsize
newymin = ymin+newsize
newzmin = zmin+newsize
this\Child[0] = AddOctree(this\Child[0], xmin,ymin,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[1] = AddOctree(this\Child[1], xmin,newymin ,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[2] = AddOctree(this\Child[2], newxmin ,newymin ,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[3] = AddOctree(this\Child[3], newxmin ,ymin,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[4] = AddOctree(this\Child[4], xmin,ymin,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[5] = AddOctree(this\Child[5], xmin,newymin ,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[6] = AddOctree(this\Child[6], newxmin ,newymin ,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[7] = AddOctree(this\Child[7], newxmin ,ymin,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
EndIf
EndIf
EndIf
Return this
End Function
Function DelOctree.Octree( this.Octree,xmin,ymin,zmin ,size,ppx,ppy,ppz,depth)
If depth >0
newsize = (size Shr 1)
If InCube(xmin,ymin,zmin,size) = False
If this <> Null
If this\Child[0] = Null And this\Child[1] = Null And this\Child[2] = Null And this\Child[3] = Null And this\Child[4] = Null And this\Child[5] = Null And this\Child[6] = Null And this\Child[7] = Null Then
If this <> root
Delete this
id2=id2-1
EndIf
Else
newdepth = depth -1
newxmin = xmin+newsize
newymin = ymin+newsize
newzmin = zmin+newsize
If this\Child[0] <> Null Then DelOctree(this\Child[0], xmin,ymin,zmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[1] <> Null Then DelOctree(this\Child[1], xmin,newymin ,zmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[2] <> Null Then DelOctree(this\Child[2], newxmin ,newymin ,zmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[3] <> Null Then DelOctree(this\Child[3], newxmin ,ymin,zmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[4] <> Null Then DelOctree(this\Child[4], xmin,ymin,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[5] <> Null Then DelOctree(this\Child[5], xmin,newymin ,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[6] <> Null Then DelOctree(this\Child[6], newxmin ,newymin ,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[7] <> Null Then DelOctree(this\Child[7], newxmin ,ymin,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
Delete this
id2=id2-1
EndIf
EndIf
Else
newdepth = depth -1
newxmin = xmin+newsize
newymin = ymin+newsize
newzmin = zmin+newsize
If this\Child[0] <> Null Then DelOctree(this\Child[0], xmin,ymin,zmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[1] <> Null Then DelOctree(this\Child[1], xmin,newymin ,zmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[2] <> Null Then DelOctree(this\Child[2], newxmin ,newymin ,zmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[3] <> Null Then DelOctree(this\Child[3], newxmin ,ymin,zmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[4] <> Null Then DelOctree(this\Child[4], xmin,ymin,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[5] <> Null Then DelOctree(this\Child[5], xmin,newymin ,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[6] <> Null Then DelOctree(this\Child[6], newxmin ,newymin ,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
If this\Child[7] <> Null Then DelOctree(this\Child[7], newxmin ,ymin,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
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
;HidePointer
CubDepth = ConstDepth ; 8 ;число вложений (глубина )
CubSize = 128 ; размеры квадранта
v=1
root.Octree = CreateOctree(0,0,0,CubSize ,CubDepth ,Null)
While Not KeyHit(1)
start = MilliSecs()
mx = MouseX()
my = MouseY()
s = Abs(MouseZ())+5
id=0
Cls
If KeyDown(30) And pz <CubSize Then pz=pz+1 ; A key
If KeyDown(44) And pz > 0 Then pz=pz-5 ; Z key
If KeyHit(2) Then viewline = Not viewline
If KeyHit(57) Then
EndIf
For pt.POINT = Each POINT
timestart = MilliSecs()
AddOctree(root, 0,0,0,CubSize,pt\x,pt\y,pt\z ,CubDepth)
DelOctree(root, 0,0,0,CubSize,pt\x,pt\y,pt\z ,CubDepth)
timeoutcreate = (MilliSecs()-timestart)
If pt\x <= 10 Then
pt\x = Int(Rnd(10,120))
pt\y = Int(Rnd(10,120))
pt\z = Int(Rnd(10,120))
v=1
EndIf
If pt\x >= 126 Then
pt\x = Int(Rnd(10,120))
pt\y = Int(Rnd(10,120))
pt\z = Int(Rnd(10,120))
v=-1
EndIf
pt\x = pt\x +v
Next
RenderOctree(root,CubDepth )
For roots.OCTREE = Each OCTREE
If roots<>Null
id=id+1
EndIf
Next
Oval 400+(mx-my )-s,300+ ( my+mx )/2- pz -s,s*2,s*2,0
;--------------- INFO -----------------------------------
Color 255,255,255
Text 550,20,"Elements = "+id+" id2 = "+id2+" id3 = "+id3
; Text 550,40,"Radius = "+s+" - scroll mouse"
; Text 550,60,"Position Z = "+pz+" - press A or Z"
Text 550,80,"Time AddClearOctree = "+timeoutcreate
Text 550,100,"Current FPS: " + CurFPS#
; Text 550,120,"ViewBoxes = "+viewline +" - press ENTER"
; Text 550,160,"View_2d_Boxes = "+show2d +" - press key 1"
CurFPS# = 1000.0 / (MilliSecs() - Start)
Flip
Wend
Delete Each OCTREE
Delete Each POINT
End
Function RenderOctree(this.OCTREE,depth)
If this.OCTREE <> Null
If (depth >0)
If show2d = 0
Color 128,128,128
EndIf
If viewline = 0
If depth = 7 Then Color 28,28,28
If depth = 6 Then Color 128,128,1
If depth = 5 Then Color 128,1,128
If depth = 4 Then Color 1,128,128
If depth = 3 Then Color 1,1,128
If depth = 2 Then Color 1,128,1
If depth = 1 Then Color 128,1,1
If depth = 0 Then Color 128,128,128
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
; 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)
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\depth
If zz > 200 Then zz = 200
If zz < 0 Then zz = 0
Color 25+zz ,25+zz ,25+zz
LockBuffer GraphicsBuffer()
For nz = this\zmin To this\zmin+this\size
For ny = this\ymin To this\ymin+this\size
For nx = this\xmin To this\xmin+this\size
WritePixel 400+ (nx-ny) , 300+ (nx+ny)/2 - nz ,$333333, GraphicsBuffer()
Next
Next
Next
UnlockBuffer GraphicsBuffer()
EndIf
If show2d = 0
Color 128,128,128
WritePixel this\xmin , this\ymin , $333333
EndIf
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
собственно небольшое отклонение . Для чего это нужно , вот пример построение ландшафта при помощи квадро-дерева тут .
__________________
Мой проект здесь
Последний раз редактировалось polopok, 14.10.2013 в 20:16.
|