|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
|
Ответ: Voxel (octotree)
Сново ,немного говно кода  .
Теперь ещё задействовано колёсико мыши .
В этой разработке использовал данные из этой статьи , конечно переделал по своему, но вдруг кому будет интересно.
Так же Octree
 Global id,id2,mx,my ,CubDepth ,CubSize
Global px,py,pz ,s ,mxx,myy , mmy
Global x1,y1,x2,y2
Type OCTREE
Field Child.OCTREE[8] ;8 потомков
Field xmin,ymin,zmin
;Field xcentr,ycentr,zcentr
Field qred,qgreen,qblue,qalpha,qcolor
Field size , depth
End Type
Type NODE
Field x,y,z
End Type
Function RootOctree.OCTREE(xmin,ymin,zmin ,size,depth)
newsize = size / 2
this.OCTREE = New OCTREE
this\xmin = xmin
this\ymin = ymin
this\zmin = zmin
this\size = size
this\depth = depth
id = id + 1
If depth = CubDepth
newdepth = depth -1
this\Child[0] = RootOctree(xmin,ymin,zmin ,newsize ,newdepth )
this\Child[1] = RootOctree(xmin,ymin+newsize ,zmin ,newsize ,newdepth )
this\Child[2] = RootOctree(xmin+newsize,ymin+newsize,zmin ,newsize ,newdepth )
this\Child[3] = RootOctree(xmin+newsize,ymin,zmin ,newsize ,newdepth )
this\Child[4] = RootOctree(xmin,ymin,zmin+newsize,newsize ,newdepth )
this\Child[5] = RootOctree(xmin,ymin+newsize,zmin+newsize,newsize ,newdepth )
this\Child[6] = RootOctree(xmin+newsize,ymin+newsize,zmin+newsize,newsize ,newdepth )
this\Child[7] = RootOctree(xmin+newsize,ymin,zmin+newsize,newsize ,newdepth )
EndIf
Return this
End Function
Function AddOctree.OCTREE( this.OCTREE,xmin,ymin,zmin ,size,ppx,ppy,ppz,depth)
If PointInCube(xmin,ymin,zmin,xmin+size,ymin+size,zmin+size,ppx,ppy,ppz )
newsize = size / 2
If this = Null
this.OCTREE = New OCTREE
this\xmin = xmin
this\ymin = ymin
this\zmin = zmin
this\size = size
this\depth = depth
id = id + 1
Else
If depth >=0
newdepth = depth -1
this\Child[0] = AddOctree(this\Child[0], xmin,ymin,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[1] = AddOctree(this\Child[1], xmin,ymin+newsize ,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[2] = AddOctree(this\Child[2], xmin+newsize,ymin+newsize,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[3] = AddOctree(this\Child[3], xmin+newsize,ymin,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[4] = AddOctree(this\Child[4], xmin,ymin,zmin+newsize,newsize ,ppx,ppy,ppz,newdepth )
this\Child[5] = AddOctree(this\Child[5], xmin,ymin+newsize,zmin+newsize,newsize ,ppx,ppy,ppz,newdepth )
this\Child[6] = AddOctree(this\Child[6], xmin+newsize,ymin+newsize,zmin+newsize,newsize ,ppx,ppy,ppz,newdepth )
this\Child[7] = AddOctree(this\Child[7], xmin+newsize,ymin,zmin+newsize,newsize ,ppx,ppy,ppz,newdepth )
EndIf
EndIf
EndIf
Return this
End Function
Function PoinInCircle(ox , oy ,r)
If Int((mx - ox)^2 + (my - oy)^2) <= r^2 Then
mx = ox : my = oy
EndIf
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)
timestartvis = MilliSecs()
mx = MouseX()
my = MouseY()
s = Abs(MouseZ())+5
Cls
If KeyDown(30) And pz <180 Then pz=pz+1 ; A key
If KeyDown(44) And pz > 0 Then pz=pz-5 ; Z key
If KeyHit(57) Then
EraseOctree(root)
id=0 :id2=0
root.OCTREE = RootOctree(0,0,0,CubSize ,CubDepth )
Delete Each NODE
EndIf
;myy = (2*(my-300) -(mx-400))/2 + pz;-s
;mxx = ((mx-400)+myy);-;s
For nod.NODE = Each NODE
If nod <> Null
AddOctree(root, 0,0,0,CubSize ,nod\x,nod\y,nod\z,CubDepth)
EndIf
Next
RenderOctree(root,CubDepth )
Paint()
;Oval mx -3 , my-3,6,6,0
Oval 400+(mx-my )-s,300+ ( my+mx )/2- pz -s,s*2,s*2,0
; INFO
Color 255,255,255
Text 550,20,"S = "+s+" Kolichestvo elementov = "+id+" id2 = "+id2
Text 550,180," Z = "+pz+" Time Create "+timeout
timeoutvis = (MilliSecs()-timestartvis)
Text 550,200," Time Visualization "+timeout
Flip
Wend
Delete Each OCTREE
Delete Each NODE
End
Function Paint.NODE()
If MouseHit(1) Then
For nx = mx+s To mx-s Step -5
For ny = my+s To my-s Step -5
For nz = pz+s To pz-s Step -5
this.NODE = New NODE
this\x = nx
this\y = ny
this\z = pz
id2 = id2+1
Next
Next
Next
Else
Rect mx-s , my-s , s*2,s*2,0
EndIf
Return this
End Function
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)
RenderOctree(this\Child[4],depth)
RenderOctree(this\Child[5],depth)
RenderOctree(this\Child[6],depth)
RenderOctree(this\Child[7],depth)
Else
zz = this\zmin
If zz > 200 Then zz = 200
If zz < 0 Then zz = 0
Color 25+zz ,25+zz ,25+zz
Rect 400+ (this\xmin-this\ymin) , 300+ (this\ymin+ this\xmin)/2 -this\zmin , this\size , this\size , 1
Color 128,128,128
Rect this\xmin , this\ymin , this\size , this\size , 1
End If
EndIf
End Function
Function EraseOctree(this.OCTREE)
Delete Each OCTREE
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 ,CubSize ,viewline , show2d , image
Global px,py,pz ,s ,mxx,myy , mmy
Global timeoutcreate# , timeintcreate
Type OCTREE
Field Child.OCTREE[8] ;8 потомков
Field xmin,ymin,zmin
;Field xcentr,ycentr,zcentr ;
Field octRed,octGreen,octBlue,octAlpha,octColor
Field size , depth
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 = zmin
this\size = size
this\depth = depth
id = id + 1
Return this
End Function
Function AddOctree.OCTREE( this.OCTREE,xmin,ymin,zmin ,size,ppx,ppy,ppz,depth)
If PointInCube(xmin,ymin,zmin,xmin+size,ymin+size,zmin+size,ppx,ppy,ppz )
newsize = size / 2
If this = Null
this.OCTREE = New OCTREE
this\xmin = xmin
this\ymin = ymin
this\zmin = zmin
this\size = size
this\depth = depth
id = id + 1
Else
If depth >0
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 PoinInCircle(ox , oy , oz ,r)
If Int(((mx - ox)^2 + (my - oy)^2+ (pz - oz)^2)^0.5) <= r Then Return True Else Return False
;If Int(((mx - ox)^2 + (my - oy)^2+ (pz - oz)^2)^0.5) < r And Int(((mx - ox)^2 + (my - oy)^2+ (pz - oz)^2)^0.5) > r-2 Then Return True Else Return False
End Function
Graphics 800,600,32,2
SetBuffer BackBuffer()
Dim Pix(GraphicsWidth(),GraphicsHeight())
image = CreateImage (800,600)
;HidePointer
CubDepth =7 ; 8 ;число вложений (глубина )
CubSize = 256 ; размеры квадранта
pz = 50
root.OCTREE = RootOctree(0,0,0,CubSize ,CubDepth )
While Not KeyHit(1)
Start = MilliSecs()
mx = MouseX()
my = MouseY()
s = Abs(MouseZ())+1
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(28) Then viewline = 1- viewline ; ENTER
If KeyHit(2) Then show2d = 1- show2d ; 1
If KeyHit(57) Then
EraseOctree(root)
id=0
root.OCTREE = RootOctree(0,0,0,CubSize ,CubDepth )
EndIf
;myy = (2*(my-300) -(mx-400))/2 + pz;-s
;mxx = ((mx-400)+myy);-;s
Paint()
DrawImage image,0,0
Color 128,128,128
Rect 0,0,CubSize ,CubSize ,0
Color 0,255,0
Oval mx - s, my-s,s*2,s*2,0
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 = "+
Text 550,40,"Radius = "+s+" - scroll mouse"
Text 550,60,"Position Z = "+pz+" - press A or Z"
Text 550,80,"Time AddOctree = "+timeoutcreate
timeoutvis = (MilliSecs()-timeinvis)
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
FreeImage image
End
Function Paint()
If MouseDown(1)
timeintcreate = MilliSecs()
For ny = my+s To my-s Step -1
For nx = mx+s To mx-s Step -1
For nz = pz+s To pz-s Step -1
If PoinInCircle(nx , ny , nz ,s)
AddOctree(root, 0,0,0,CubSize ,nx,ny,nz,CubDepth )
EndIf
Next
Next
Next
timeoutcreate# = (MilliSecs()-timeincreate)/100000
; End If
; If MouseHit(1)
SetBuffer ImageBuffer(image)
Cls
RenderOctree(root,CubDepth )
SetBuffer BackBuffer()
EndIf
End Function
Function RenderOctree(this.OCTREE,depth)
If this.OCTREE <> Null
If (depth >0)
If show2d = 0
Color 128,128,128
; Rect this\xmin , this\ymin , this\size , this\size , 0
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\zmin
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 EraseOctree(this.OCTREE)
Delete Each OCTREE
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, 18.05.2013 в 02:08.
|