![](images/chestnut/misc/left.gif) |
2D-программирование Вопросы, касающиеся двумерного программирования |
05.05.2013, 07:22
|
#1
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Voxel (octotree)
Итак , пробую связать воксели в изометрии .
Код правда сырой ,да и при большей глубине(depth) уж сильно тормозит
код:
![](images/chestnut/misc/code_html.gif)
Global id,level ,mx,my ,QDepth
Global px#,py,pz ,s
Type QUADTREE
Field Child.QUADTREE[7] ;8 потомков
Field xmin,ymin,zmin ; начальные координаты квадранта
Field xmax,ymax,zmax ; оконечные координаты квадранта
Field id ,vis , lock; ;vis - visible , lock - bloked
End Type
Function Quadtree.QUADTREE(xmin,ymin,zmin,xmax,ymax,zmax,depth)
this.QUADTREE = New QUADTREE
this\xmin = xmin
this\xmax = xmax
this\ymin = ymin
this\ymax = ymax
this\zmin = zmin
this\zmax = zmax
id = id + 1
this\id = id
this\vis = False
this\lock= False
If (depth > 1)
; =============================================
xmod = (xmin+xmax) / 2
ymod = (ymin+ymax) / 2
zmod = (zmin+zmax) / 2
depth = depth - 1
this\Child[0] = Quadtree(xmin,ymin,zmin ,xmod,ymod,zmod ,depth)
this\Child[1] = Quadtree(xmin,ymod,zmin ,xmod,ymax,zmod ,depth)
this\Child[2] = Quadtree(xmod,ymod,zmin ,xmax,ymax,zmod ,depth)
this\Child[3] = Quadtree(xmod,ymin,zmin ,xmax,ymod,zmod ,depth)
this\Child[4] = Quadtree(xmin,ymin,zmod ,xmod,ymod,zmax,depth)
this\Child[5] = Quadtree(xmin,ymod,zmod ,xmod,ymax,zmax,depth)
this\Child[6] = Quadtree(xmod,ymod,zmod ,xmax,ymax,zmax,depth)
this\Child[7] = Quadtree(xmod,ymin,zmod ,xmax,ymod,zmax,depth)
EndIf
Return this
End Function
; =========================================
Function RenderQuadtree(this.QUADTREE,depth)
If (depth > 1)
xmod = (xmin+xmax) / 2
ymod = (ymin+ymax) / 2
zmod = (zmin+zmax) / 2
Color 88,88,88
Rect this\xmin, this\ymin,this\xmax-this\xmin,this\ymax-this\ymin ,0
depth = depth - 1
RenderQuadtree(this\Child[0],depth)
RenderQuadtree(this\Child[1],depth)
RenderQuadtree(this\Child[2],depth)
RenderQuadtree(this\Child[3],depth)
RenderQuadtree(this\Child[4],depth)
RenderQuadtree(this\Child[5],depth)
RenderQuadtree(this\Child[6],depth)
RenderQuadtree(this\Child[7],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
Color 40+zdot,40+zdot,40+zdot
Oval 400+ (xdot -ydot*px) -13*(depth), 300+ (xdot +ydot*px )/2-zdot -13*(depth) , 26*(depth+depth),26*(depth+depth),1
; For y=this\ymin To this\ymax Step 5
; For x=this\xmin To this\xmax Step 5
; For z=this\zmin To this\zmax Step 5
; Color 255,255,255
; Plot 400+x-y,400+(x+ y)/2-z
; Next
; Next
; Next
EndIf
End If
End Function
Function CalcQuadtree(this.QUADTREE,depth)
If (depth > 1)
depth = depth - 1
CalcQuadtree(this\Child[0],depth)
CalcQuadtree(this\Child[1],depth)
CalcQuadtree(this\Child[2],depth)
CalcQuadtree(this\Child[3],depth)
CalcQuadtree(this\Child[4],depth)
CalcQuadtree(this\Child[5],depth)
CalcQuadtree(this\Child[6],depth)
CalcQuadtree(this\Child[7],depth)
If this\Child[0]\lock= 1 And 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 Then
this\vis=True
this\lock=True
this\Child[0]\vis= False
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
EndIf
If depth =s Then ;depth =s And pz > zmin And pz< zmax
If mx >=this\xmin And mx < this\xmax
If my >=this\ymin And my < this\ymax
If pz >=this\zmin And pz < this\zmax
For y=this\ymin To this\ymax Step 3
For x=this\xmin To this\xmax Step 3
For z=this\zmin To this\zmax Step 3
Color 255,5,5
Plot 400+x-y*px,300+(x+ y*px)/2-z
Next
Next
Next
; xdot = (this\xmax+this\xmin)/2
; ydot = (this\ymax+this\ymin)/2
; zdot = (this\zmax+this\zmin)/2
; Color 255,255,255
; Oval 400+ xdot -ydot -6, 400+ (xdot +ydot )/2-zdot -6 , 12,12,1
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 If
End If
End If
End Function
Function EraseQuadtree(this.QUADTREE,depth)
If (depth > 1)
depth = depth - 1
EraseQuadtree(this\Child[0],depth)
EraseQuadtree(this\Child[1],depth)
EraseQuadtree(this\Child[2],depth)
EraseQuadtree(this\Child[3],depth)
EraseQuadtree(this\Child[4],depth)
EraseQuadtree(this\Child[5],depth)
EraseQuadtree(this\Child[6],depth)
EraseQuadtree(this\Child[7],depth)
this\lock=False
this\vis=False
End If
End Function
Graphics 800,600,32,2
SetBuffer BackBuffer()
QuadDepth = 5;число вложений (глубина ) : Level 's
QuadSize = 200 ; размеры квадранта
root.QUADTREE = Quadtree(0,0,0,QuadSize,QuadSize,QuadSize,QuadDepth)
px=1
While Not KeyHit(1)
mx = MouseX()
my = MouseY()
s = Abs(MouseZ())+1
Cls
Select True
Case KeyHit(200) : py=py-0.1 ;Up
Case KeyHit(208) : py=py+0.1;Down
Case KeyHit(203) : px=px-0.1; Left
Case KeyHit(205) : px=px+0.1; Right
Case KeyDown(30) : pz=pz+1*15; A key
Case KeyDown(44) : pz=pz-1*15; Z key
Case KeyDown(57) : EraseQuadtree(root,QuadDepth)
End Select
; If px<0 Then px=1
; If px>=180 Then px=180
If py<0 Then py=1
If py>=180 Then py=180
If pz<0 Then mz=1
If pz>=180 Then pz=180
Color 255,255,255
Rect root\xmin,root\ymin,root\xmax,root\ymax,0
Rect 250,0,25,root\ymax,0
RenderQuadtree(root,QuadDepth)
CalcQuadtree(root,QuadDepth)
Text 400,20,"S = "+s
Text 400,60,"px = "+px+" py = "+my+" pz = "+pz
Flip
Wend
End
__________________
Мой проект здесь
Последний раз редактировалось polopok, 08.05.2013 в 14:37.
|
(Offline)
|
|
05.05.2013, 15:27
|
#2
|
Бывалый
Регистрация: 22.12.2011
Сообщений: 844
Написано 150 полезных сообщений (для 275 пользователей)
|
Ответ: Voxel (octotree)
Приложи демку, хочется взглянуть на результат.
|
(Offline)
|
|
05.05.2013, 16:26
|
#3
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
Да собственно ни о каком достаточном результате ,говорить рано ,а потому и нет смысла делать даже демку . Код г. или полное г. ![:)](images/smilies/smile.gif) тормоза жуткие ,рейкастинга нет ,даже его подобия . Всё в лоб.
Это скорее пробный вариант ,как говориться быстрый результат ,есть стимул для продолжения!
__________________
Мой проект здесь
|
(Offline)
|
|
06.05.2013, 07:53
|
#4
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
решил попробывать без Z координаты с ограничением зоны видимости и изменяемой детализацией от камеры .
КОД:
![](images/chestnut/misc/code_html.gif)
;==================================================================
;==================================================================
; Definit le Frustum
Global p1x#,p1y#
Global p2x#,p2y#
; Enfants du Quadtree
Const CHILD00 = 0
Const CHILD01 = 1
Const CHILD11 = 2
Const CHILD10 = 3
; CAMERA
Type CAMERA
Field x#,y# ; Position de la camera
Field fov# ; Angle de vue
End Type
; creation d'une camera
Function Camera.CAMERA(x,y,fov)
this.CAMERA = New CAMERA
this\x = x : this\y = y : this\fov = fov
Return this
End Function
; Renvoie True si un point est dans le plan Left du Frustum
Function PointInFrustumL(this.CAMERA,x,y)
Return ( -(x - this\x) * (p1y - this\y) + (y - this\y) * (p1x - this\x) >= 0)
End Function
; Renvoie True si un point est dans le plan Right du Frustum
Function PointInFrustumR(this.CAMERA,x,y)
Return ( -(x - this\x) * (p2y - this\y) + (y - this\y) * (p2x - this\x) <= 0)
End Function
; Renvoie True si un point est dans le plan Front du Frustum (pas utilise' ici)
Function PointInFrustumF(this.CAMERA,x,y)
Return ( -(x - this\x) * (p3y - this\y) + (y - this\y) * (p3x - this\x) >= 0)
End Function
; QUADTREE
Type QUADTREE
Field Child.QUADTREE[3] ; Les 4 enfants du quadtree
Field xmin#,ymin# ; Coordonne'es du sommet haut gauche
Field xmax#,ymax# ; Coordonne'es du sommet bas droite
Field dist%
Field qred,qgreen,qblue,qcolor
End Type
; Creation d'un quadtree de profondeur depth
; et associe' a` un carre' de cote's xmax-xmin, ymax-ymin
Function Quadtree.QUADTREE(xmin,ymin,xmax,ymax,depth)
this.QUADTREE = New QUADTREE
this\xmin = xmin
this\xmax = xmax
this\ymin = ymin
this\ymax = ymax
this\dist = 1
; this\qred = Rand(0,255)
; this\qgreen = Rand(0,255)
; this\qblue = Rand(0,255)
qcolor = CombineARGB#(0,Rand(0,255),Rand(0,255),Rand(0,255))
this\qcolor = Int( qcolor)
If (depth > 0)
; On cre'e 4 enfants
xmoy = (xmin+xmax) / 2
ymoy = (ymin+ymax) / 2
depth = depth - 1
this\Child[CHILD00] = Quadtree(xmin,ymin,xmoy,ymoy,depth) ; Haut gauche
this\Child[CHILD01] = Quadtree(xmin,ymoy,xmoy,ymax,depth) ; Bas gauche
this\Child[CHILD11] = Quadtree(xmoy,ymoy,xmax,ymax,depth) ; Bas droite
this\Child[CHILD10] = Quadtree(xmoy,ymin,xmax,ymoy,depth) ; Haut droite
EndIf
Return this
End Function
; On teste si un des 4 sommets du carre' associe' au quadtree
; est visible par la camera
Function QuadInFrustum(this.QUADTREE,cam.CAMERA)
Local nbPlansInterieur
; Plan de gauche
nbPlansInterieur = 0
nbPlansInterieur = nbPlansInterieur + PointInFrustumL(cam,this\xmin,this\ymin)
nbPlansInterieur = nbPlansInterieur + PointInFrustumL(cam,this\xmin,this\ymax)
nbPlansInterieur = nbPlansInterieur + PointInFrustumL(cam,this\xmax,this\ymin)
nbPlansInterieur = nbPlansInterieur + PointInFrustumL(cam,this\xmax,this\ymax)
If nbPlansInterieur = 0 Return False
; Plan de droite
nbPlansInterieur = 0
nbPlansInterieur = nbPlansInterieur + PointInFrustumR(cam,this\xmin,this\ymin)
nbPlansInterieur = nbPlansInterieur + PointInFrustumR(cam,this\xmin,this\ymax)
nbPlansInterieur = nbPlansInterieur + PointInFrustumR(cam,this\xmax,this\ymin)
nbPlansInterieur = nbPlansInterieur + PointInFrustumR(cam,this\xmax,this\ymax)
If nbPlansInterieur = 0 Return False
Return True
End Function
; Rendu du Quadtree
Function RenderQuadtree(this.QUADTREE,cam.CAMERA,depth)
this\dist = (Dist#( cam\x, cam\y, this\xmin, this\ymin )/100)
If this\dist<1 Then this\dist=1
If QuadInFrustum(this,cam)
If (depth > this\dist)
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
RenderQuadtree(this\Child[CHILD00],cam,depth)
RenderQuadtree(this\Child[CHILD01],cam,depth)
RenderQuadtree(this\Child[CHILD11],cam,depth)
RenderQuadtree(this\Child[CHILD10],cam,depth)
Else
LockBuffer BackBuffer()
; Color this\qred,this\qgreen,this\qblue
For b= this\ymin To this\ymax ;Step 1
For a= this\xmin To this\xmax ;Step 1
WritePixelFast a,b, this\qcolor , BackBuffer() ;this\qcolor
Next
Next
UnlockBuffer BackBuffer()
EndIf
EndIf
End Function
;==============================================================================================
; EXAMPLE
;==============================================================================================
AppTitle "Simple Quadtree Demo - Seyhajin"
Graphics 512,512,0,2
SetBuffer BackBuffer()
; Variables de configuration
QuadDepth = 10 ; Profondeur du quadtree (nb de fois qu'on decoupe le plan)
QuadSize = 512 ; Taille initiale du quadtree
CamSpeed# = 2 ; Vitesse de deplacement de la camera
CamFOV# = 60.0 / 2.0 ; Angle de vue de la camera (default = 90)
ViewLine = 300 ; Taille de la ligne des plans 300
; Creation de la camera
cam.CAMERA = Camera(QuadSize/2,QuadSize/2,CamFOV)
; Creation du Quadtree principale
root.QUADTREE = Quadtree(0,0,QuadSize,QuadSize,QuadDepth)
;----------------------------------
; BOUCLE PRINCIPALE
;----------------------------------
While Not KeyHit(1)
Cls
; Update Camera position
If KeyDown(200) ; Up
cam\y = cam\y - CamSpeed#
ElseIf KeyDown(208) ; Down
cam\y = cam\y + CamSpeed#
EndIf
If KeyDown(203) ; Left
cam\x = cam\x - CamSpeed#
ElseIf KeyDown(205) ; Right
cam\x = cam\x + CamSpeed#
EndIf
; Rendu du quadtree
Color 255,255,255
Rect root\xmin,root\ymin,root\xmax,root\ymax,1
RenderQuadtree(root,cam,QuadDepth)
; Dessine la pyramide de vue (Frustum)
x# = MouseX() - cam\x
y# = MouseY() - cam\y
angle# = 180+ATan2(-y#,-x#)
Color 255,255,0
Line cam\x,cam\y,cam\x+(ViewLine)*Cos(angle#),cam\y+(ViewLine)*Sin(angle#)
Color 255,0,0
; Plan gauche
p1x = cam\x+ViewLine*Cos(angle#-CamFOV)
p1y = cam\y+ViewLine*Sin(angle#-CamFOV)
Line cam\x,cam\y,p1x,p1y
; Plan droit
p2x = cam\x+ViewLine*Cos(angle#+CamFOV)
p2y = cam\y+ViewLine*Sin(angle#+CamFOV)
Line cam\x,cam\y,p2x,p2y
; Dessine la camera
Color 0,0,255
Oval cam\x-3,cam\y-3,6,6,True
d =Dist#( cam\x, cam\y, mx, my )
Text 400,400,(d/100)
Flip
Wend
Delete Each CAMERA
Delete Each QUADTREE
End
Function Dist#( X1#, Y1#, X2#, Y2# )
Return Abs(( (X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2) )^0.5)
End Function
; 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
__________________
Мой проект здесь
|
(Offline)
|
|
06.05.2013, 20:00
|
#5
|
Социал-сычевист
Регистрация: 24.06.2011
Сообщений: 611
Написано 342 полезных сообщений (для 1,359 пользователей)
|
Ответ: Voxel (octotree)
Нехорошо присваивать себе коды французов, ой нехорошо...
|
(Offline)
|
|
07.05.2013, 06:53
|
#6
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
А я и не утверждал что это мой код ,я взял его за основу и лишь добавил свои детали.
__________________
Мой проект здесь
|
(Offline)
|
|
08.05.2013, 14:35
|
#7
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
Несколько изменённый код первого поста .
Мышью теперь в красном ромбе создавать ,а не в квадрате , при том что менять координату z ,как и прежде клавишами A/Z.
Мышь в изометрии http://forum.boolean.name/showthread.php?t=18164
Код :
![](images/chestnut/misc/code_html.gif)
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
__________________
Мой проект здесь
|
(Offline)
|
|
10.05.2013, 09:43
|
#8
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
Итак , продолжаем. Пришлось изменить код ,так как , в первом варианте я делил весь объём куба на меньшие ,а потому память слала далеко-далеко ,когда глубина вложений превышала 7. Теперь изначально есть корневой куб ,а 4-ре его потомка = Null . При нажатии ЛМ (левой кнопки мыши) проверяется в котором потомке находиться мышь(объект) и затем делится рекурсивно если потомок = Null или не Null . И вот тут я запутался ![Mad](images/smilies/mad.gif) с родителями-потомками . Представляю сырой вариант ниже.
Код:
![](images/chestnut/misc/code_html.gif)
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
Изменённый код:
![](images/chestnut/misc/code_html.gif)
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
__________________
Мой проект здесь
Последний раз редактировалось polopok, 10.05.2013 в 11:39.
|
(Offline)
|
|
13.05.2013, 12:45
|
#9
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
Итак ,кажись получилось разобраться с родителями-потомками ,дабы не запутаться написал пример без Z координаты .
Если у кого есть идеи улучшения ,буду рад ознакомиться.
![](images/chestnut/misc/code_html.gif)
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
Вот несколько улучшил код ...
но всё-же ,далеко до "идеала"
![](images/chestnut/misc/code_html.gif)
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.
|
(Offline)
|
|
16.05.2013, 15:33
|
#10
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
Итак, опять доработки. Теперь ещё меньше разбиений ,улучшен алгоритм добавления вокселя.
![](images/chestnut/misc/code_html.gif)
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
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,depth)
If PointInCube(xmin,ymin,zmin,xmin+size,ymin+size,zmin+size,mx,my,pz )
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
EndIf
If depth >0
newdepth = depth -1
this\Child[0] = AddOctree(this\Child[0], xmin,ymin,zmin ,newsize ,newdepth )
this\Child[1] = AddOctree(this\Child[1], xmin,ymin+newsize ,zmin ,newsize ,newdepth )
this\Child[2] = AddOctree(this\Child[2], xmin+newsize,ymin+newsize,zmin ,newsize ,newdepth )
this\Child[3] = AddOctree(this\Child[3], xmin+newsize,ymin,zmin ,newsize ,newdepth )
this\Child[4] = AddOctree(this\Child[4], xmin,ymin,zmin+newsize,newsize ,newdepth )
this\Child[5] = AddOctree(this\Child[5], xmin,ymin+newsize,zmin+newsize,newsize ,newdepth )
this\Child[6] = AddOctree(this\Child[6], xmin+newsize,ymin+newsize,zmin+newsize,newsize ,newdepth )
this\Child[7] = AddOctree(this\Child[7], xmin+newsize,ymin,zmin+newsize,newsize ,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-1 ; Z key
myy = (2*(my-300) -(mx-400))/2 + pz;-s
mxx = ((mx-400)+myy);-;s
If MouseDown(1) Or KeyDown(57) Then ;
timestart = MilliSecs()
AddOctree(root, 0,0,0,CubSize ,CubDepth)
timeout = (MilliSecs()-timestart)
EndIf
RenderOctree(root,CubDepth )
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
Text 550,180," Z = "+pz+" Time Create "+timeout
timeoutvis = (MilliSecs()-timestartvis)
Text 550,200," Time Visualization "+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)
RenderOctree(this\Child[4],depth)
RenderOctree(this\Child[5],depth)
RenderOctree(this\Child[6],depth)
RenderOctree(this\Child[7],depth)
If depth=0
Color 228,28,28
; Rect 400+ this\xmin-this\ymin , 300+ (this\ymin+ this\xmin)/2 -this\zmin , this\size , this\size , 0
; Line 400+ (this\xmin-this\ymin), 300+ (this\ymin+ this\xmin)/2 +this\zmin , 400+ ((this\xmin+this\size )-this\ymin), 300+ ((this\xmin+this\size )+ this\xmin)/2 +this\zmin
EndIf
Else
Color 228,28,28
Rect 400+ (this\xmin-this\ymin) , 300+ (this\ymin+ this\xmin)/2 -this\zmin , this\size , this\size , 0
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
__________________
Мой проект здесь
|
(Offline)
|
|
17.05.2013, 14:47
|
#11
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
Сново ,немного говно кода ![Laught](images/smilies/DDD.gif) .
Теперь ещё задействовано колёсико мыши .
В этой разработке использовал данные из этой статьи , конечно переделал по своему, но вдруг кому будет интересно.
Так же Octree
![](images/chestnut/misc/code_html.gif)
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
А теперь несколько упорядоченный говно-код с элементами извращениями ...
![](images/chestnut/misc/code_html.gif)
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.
|
(Offline)
|
|
06.10.2013, 08:52
|
#12
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
Вот ,после долгого отсутствия ...
Накатал новый пример ...
собственно здесь создаются две структуры ,самого октри и точек . В зависимости от перемещения точек меняется структура октри .
код:
![](images/chestnut/misc/code_html.gif)
SeedRnd MilliSecs()
Global id,id2,id3,mx,my ,CubDepth ,CubSize
Global px,py,pz ,s ,mxx,myy , mmy
Global timeoutcreate# , timeintcreate
Type OCTREE
Field Child.OCTREE[7] ;8 потомков
Field xmin,ymin,zmin
;Field xcentr,ycentr,zcentr ; ????? ????
Field qred,qgreen,qblue,qalpha,qcolor
Field size , depth , parent
End Type
Type POINT
Field x,y,z
Field x2,y2,z2
Field vx,vy,vz
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
id2=id2+1
Return this
End Function
Function AddClearOctree.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
id2=id2+1
;this\parent = this
Else
If depth >0
newdepth = depth -1
newxmin = xmin+newsize
newymin = ymin+newsize
newzmin = zmin+newsize
this\Child[0] = AddClearOctree(this\Child[0], xmin,ymin,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[1] = AddClearOctree(this\Child[1], xmin,newymin ,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[2] = AddClearOctree(this\Child[2], newxmin ,newymin ,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[3] = AddClearOctree(this\Child[3], newxmin ,ymin,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[4] = AddClearOctree(this\Child[4], xmin,ymin,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[5] = AddClearOctree(this\Child[5], xmin,newymin ,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[6] = AddClearOctree(this\Child[6], newxmin ,newymin ,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[7] = AddClearOctree(this\Child[7], newxmin ,ymin,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
EndIf
EndIf
Else
newsize = size / 2
If this <> Null
If depth < CubDepth -1
newdepth = depth -1
newxmin = xmin+newsize
newymin = ymin+newsize
newzmin = zmin+newsize
this\Child[0] = AddClearOctree(this\Child[0], xmin,ymin,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[1] = AddClearOctree(this\Child[1], xmin,newymin ,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[2] = AddClearOctree(this\Child[2], newxmin ,newymin ,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[3] = AddClearOctree(this\Child[3], newxmin ,ymin,zmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[4] = AddClearOctree(this\Child[4], xmin,ymin,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[5] = AddClearOctree(this\Child[5], xmin,newymin ,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[6] = AddClearOctree(this\Child[6], newxmin ,newymin ,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
this\Child[7] = AddClearOctree(this\Child[7], newxmin ,ymin,newzmin ,newsize ,ppx,ppy,ppz,newdepth )
Delete this
this = Null
id2=id2-1
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()
For p = 0 To 2
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 =5 ; 8 ;число вложений (глубина )
CubSize = 128 ; размеры квадранта
v=1
root.OCTREE = RootOctree(0,0,0,CubSize ,CubDepth )
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(57) Then
EndIf
For pt.POINT = Each POINT
If pt\x <= 0 Then
v=1
pt\x=Int(Rnd(10,120))
pt\y=Int(Rnd(10,120))
pt\z=Int(Rnd(10,120))
EndIf
If pt\x >= 128 Then
v=-1
pt\x=Int(Rnd(10,120))
pt\y=Int(Rnd(10,120))
pt\z=Int(Rnd(10,120))
EndIf
pt\x = pt\x +v
If PointInCube(0,0,0,CubSize,CubSize,CubSize,pt\x,pt\y,pt\z )
timestart = MilliSecs()
AddClearOctree(root, 0,0,0,CubSize,pt\x,pt\y,pt\z ,CubDepth)
timeoutcreate = (MilliSecs()-timestart)
EndIf
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 50,10,"Total MEMORY : "+ TotalVidMem () + "байт. MEMORY : " + AvailVidMem()
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\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)
For this.OCTREE = Each OCTREE
Delete this
Next
End Function
Function ClearOctree.OCTREE( this.OCTREE,xmin,ymin,zmin ,size,depth)
newsize = size / 2
If this <> Null
If depth >0
newdepth = depth -1
newxmin = xmin+newsize
newymin = ymin+newsize
newzmin = zmin+newsize
this\Child[0] = ClearOctree(this\Child[0], xmin,ymin,zmin ,newsize ,newdepth )
this\Child[1] = ClearOctree(this\Child[1], xmin,newymin ,zmin ,newsize ,newdepth )
this\Child[2] = ClearOctree(this\Child[2], newxmin ,newymin ,zmin ,newsize ,newdepth )
this\Child[3] = ClearOctree(this\Child[3], newxmin ,ymin,zmin ,newsize ,newdepth )
this\Child[4] = ClearOctree(this\Child[4], xmin,ymin,newzmin ,newsize ,newdepth )
this\Child[5] = ClearOctree(this\Child[5], xmin,newymin ,newzmin ,newsize ,newdepth )
this\Child[6] = ClearOctree(this\Child[6], newxmin ,newymin ,newzmin ,newsize ,newdepth )
this\Child[7] = ClearOctree(this\Child[7], newxmin ,ymin,newzmin ,newsize ,newdepth )
EndIf
Delete this
id2=id2-1
EndIf
Return this
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
__________________
Мой проект здесь
|
(Offline)
|
|
07.10.2013, 19:43
|
#13
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
Ну ,вот , наконец-то что-то получилось ...
Ошибка крылась как всегда в моей невнимательности .
Правда с удалением пришлось повозиться.
Считаю вполне рабочий вариант
код:
![](images/chestnut/misc/code_html.gif)
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
собственно небольшое отклонение . Для чего это нужно , вот пример построение ландшафта при помощи квадро-дерева тут .
![](http://www.zephyrosanemos.com/images/Terrain/784/JPEG/Flight2.jpg)
__________________
Мой проект здесь
Последний раз редактировалось polopok, 14.10.2013 в 20:16.
|
(Offline)
|
|
10.10.2013, 12:24
|
#14
|
Задрот
Регистрация: 24.07.2009
Адрес: Ивановская область, г. Кинешма
Сообщений: 1,574
Написано 407 полезных сообщений (для 863 пользователей)
|
Ответ: Voxel (octotree)
ты б лучше свои размышления в виде статейки like habrahabr выложил, я б с удовольствием почитал, нежели код..
|
(Offline)
|
|
13.10.2013, 12:09
|
#15
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
Не которое отклонение от темы , создавать новую не считаю нужным .
Проверьте ,код на тормазнутость ,пожалуйста .
Проверка попадают ли точки в зону видимости
![](images/chestnut/misc/code_html.gif)
Graphics 800,600,32,2
SetBuffer BackBuffer()
q = 500
cc = q*q
Dim fx(cc) :Dim fy(cc)
x=200 :y=200
For b= 0 To q
For a= 0 To q
c = a*b
If Rand(0,4)=0 Then
fx(c)=100+a
fy(c)=50+b
col =col +1
EndIf
Next
Next
While Not KeyHit(1)
mx# = MouseX()
my# = MouseY()
If KeyDown(205) Then x=x+10
If KeyDown(203) Then x=x-10
If KeyDown(208) Then y=y+10
If KeyDown(200) Then y=y-10
If MouseDown(1) Then x=mx : y=my
Cls
Color 50,55,50
Line x,y,mx,my
LockBuffer BackBuffer()
For c= 0 To cc
d# = Dist#( x, y, mx, my )
If d = 0 Then d# = 0.0000001
dx# = (x-mx)/d
dy# = (y-my)/d
d2# = Dist#( x, y, fx(c), fy(c))
If d2 = 0 Then d2# = 0.0000001
dxv#= (x- fx(c))/d2
dyv# = (y-fy(c))/d2
ac# = ACos(dx*dxv+dy*dyv)
If ac <=30 Then WritePixel fx(c),fy(c),$666666,BackBuffer() Else WritePixel fx(c),fy(c),$fff,BackBuffer() ; угол обзора 60 градусов
Next
UnlockBuffer BackBuffer()
Text 20,20 ,"Total points "+col
Flip
Wend
End
Function Dist#( X1#, Y1#, X2#, Y2# )
Return Abs(( (X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2) )^0.5)
End Function
Function Q(ax,ay,bx,by,cx,cy) ;(cx,cy) - координаты точки
If (cy-ay)*(bx-ax)-(cx-ax)*(by-ay)=0 Then Return True Else Return False
End Function
__________________
Мой проект здесь
|
(Offline)
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 12:17.
|