forum.boolean.name

forum.boolean.name (http://forum.boolean.name/index.php)
-   2D-программирование (http://forum.boolean.name/forumdisplay.php?f=13)
-   -   Voxel (octotree) (http://forum.boolean.name/showthread.php?t=18145)

polopok 05.05.2013 07:22
Voxel (octotree)
 
Итак , пробую связать воксели в изометрии .
Код правда сырой ,да и при большей глубине(depth) уж сильно тормозит
код:
Код:
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

Nikich 05.05.2013 15:27
Ответ: Voxel (octotree)
 
Приложи демку, хочется взглянуть на результат.

polopok 05.05.2013 16:26
Ответ: Voxel (octotree)
 
Да собственно ни о каком достаточном результате ,говорить рано ,а потому и нет смысла делать даже демку . Код г. или полное г. :) тормоза жуткие ,рейкастинга нет ,даже его подобия . Всё в лоб.
Это скорее пробный вариант ,как говориться быстрый результат ,есть стимул для продолжения!

polopok 06.05.2013 07:53
Ответ: Voxel (octotree)
 
решил попробывать без Z координаты с ограничением зоны видимости и изменяемой детализацией от камеры .

КОД:

Код:
;==================================================================
;==================================================================


; 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

Кирпи4 06.05.2013 20:00
Ответ: Voxel (octotree)
 
Нехорошо присваивать себе коды французов, ой нехорошо...

polopok 07.05.2013 06:53
Ответ: Voxel (octotree)
 
А я и не утверждал что это мой код ,я взял его за основу и лишь добавил свои детали.

polopok 08.05.2013 14:35
Ответ: Voxel (octotree)
 
Несколько изменённый код первого поста .
Мышью теперь в красном ромбе создавать ,а не в квадрате , при том что менять координату z ,как и прежде клавишами A/Z.
Мышь в изометрии http://forum.boolean.name/showthread.php?t=18164

Код :
Код:
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

polopok 10.05.2013 09:43
Ответ: Voxel (octotree)
 
Итак , продолжаем. Пришлось изменить код ,так как , в первом варианте я делил весь объём куба на меньшие ,а потому память слала далеко-далеко ,когда глубина вложений превышала 7. Теперь изначально есть корневой куб ,а 4-ре его потомка = Null . При нажатии ЛМ (левой кнопки мыши) проверяется в котором потомке находиться мышь(объект) и затем делится рекурсивно если потомок = Null или не Null . И вот тут я запутался :( с родителями-потомками . Представляю сырой вариант ниже.

Код:

Код:
Global id,mx,my ,QDepth 
Global px,py,pz ,s ,mxx,myy



Type OCTREE
Field Child.OCTREE[8] ;8 потомков
Field xmin,ymin,zmin ; начальные координаты куба
Field xmax,ymax,zmax ; оконечные координаты куба
Field xcentr,ycentr,zcentr ; центр куба
Field qred,qgreen,qblue,qalpha,qcolor
End Type

Function Octree.OCTREE(xmin,ymin,zmin,xmax,ymax,zmax,depth)
        xcentr = (xmin+xmax) / 2
        ycentr = (ymin+ymax) / 2
        zcentr = (zmin+zmax) / 2

this.OCTREE = New OCTREE
        this\xmin = xmin
        this\xmax = xmax
        this\ymin = ymin
        this\ymax = ymax
        this\zmin = zmin
        this\zmax = zmax
        this\xcentr = xcentr
        this\ycentr = ycentr
        this\zcentr = zcentr
               
        id = id + 1


        For c = 1 To 8
                this\Child[c] = Null
               
                If this\Child[c] <> Null
                        Delete this\Child[c]
                        this\Child[c] = Null
                EndIf
        Next


        Return this
End Function


; ====================      =====================
Function RenderOctree(this.OCTREE,depth)

If this.OCTREE <> Null
If PointInCube(this\xmin,this\ymin,this\zmin,this\xmax,this\ymax,this\zmax,mx,my,pz )        = True
        If (depth > 0)                       
       
                      Color 128,128,128
                      Line (this\xmin+this\xmax)/2,this\ymin,(this\xmin+this\xmax)/2,this\ymax
                      Line this\xmin,(this\ymin+this\ymax)/2,this\xmax,(this\ymin+this\ymax)/2
                               
                        depth = depth - 1
       
                        RenderOctree(this\Child[1],depth)
                        RenderOctree(this\Child[2],depth)
                        RenderOctree(this\Child[3],depth)       
                        RenderOctree(this\Child[4],depth)
                        RenderOctree(this\Child[5],depth)
                        RenderOctree(this\Child[6],depth)
                        RenderOctree(this\Child[7],depth)
                        RenderOctree(this\Child[8],depth)       
                       
                        Text this\xmin+3,this\ymin+3,"+"
                              Color 6,6,196
      Rect this\xmin+1,this\ymin+1,this\xmax-this\xmin-1,this\ymax-this\ymin-1,0
        Else
      Color 196,6,6
      Rect this\xmin+1,this\ymin+1,this\xmax-this\xmin-1,this\ymax-this\ymin-1,1
        End If
End If
End If
End Function

; ====================      =====================
Function AddToOctree.OCTREE(xmin,ymin,zmin,xmax,ymax,zmax,depth)
If PointInCube(xmin,ymin,zmin,xmax,ymax,zmax,mx,my,pz )        = True
        xcentr = (xmin+xmax) / 2
        ycentr = (ymin+ymax) / 2
        zcentr = (zmin+zmax) / 2
       
this.OCTREE = New OCTREE
        this\xmin = xmin
        this\xmax = xmax
        this\ymin = ymin
        this\ymax = ymax
        this\zmin = zmin
        this\zmax = zmax
        this\xcentr = xcentr
        this\ycentr = ycentr
        this\zcentr = zcentr
               
        id = id + 1       

If (depth >= 0)       

        depth = depth - 1

        this\Child[1] = AddToOctree(xmin,ymin,zmin  ,xcentr,ycentr,zcentr ,depth)
        this\Child[2] = AddToOctree(xmin,ycentr,zmin  ,xcentr,ymax,zcentr ,depth)
        this\Child[3] = AddToOctree(xcentr,ycentr,zmin  ,xmax,ymax,zcentr ,depth)
        this\Child[4] = AddToOctree(xcentr,ymin,zmin  ,xmax,ycentr,zcentr ,depth)
        this\Child[5] = AddToOctree(xmin,ymin,zcentr  ,xcentr,ycentr,zmax,depth)
        this\Child[6] = AddToOctree(xmin,ycentr,zcentr  ,xcentr,ymax,zmax,depth)
        this\Child[7] = AddToOctree(xcentr,ycentr,zcentr  ,xmax,ymax,zmax,depth)
        this\Child[8] = AddToOctree(xcentr,ymin,zcentr  ,xmax,ycentr,zmax,depth)

EndIf
EndIf
        Return this
End Function





Graphics 800,600,32,2
SetBuffer BackBuffer()
HidePointer

QuadDepth =4    ; 8 ;число вложений (глубина )
QuadSize = 512 ; размеры квадранта

timestart = MilliSecs()
root.OCTREE = Octree(0,0,0,QuadSize,QuadSize,QuadSize,QuadDepth)
timeout = (MilliSecs()-timestart)
While Not KeyHit(1)
mx = MouseX()
my = MouseY()
s = Abs(MouseZ())
Cls
Select True
Case KeyDown(200) : py=py-1*20; Up
Case KeyDown(208) : py=py+1*20; Down
Case KeyDown(203) : px=px-1*20; Left
Case KeyDown(205) : px=px+1*20; Right
Case KeyDown(57)
End Select
If  KeyHit(30) And pz <180 Then pz=pz+10 ;  A key
If  KeyHit(44) And pz > 0 Then pz=pz-10       

                If MouseDown(1) Or KeyDown(157)  Then ;
                For c = 1 To 8
                ;If PointInCube(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,mx,my,pz )        = True
                If root\Child[c]  = Null
                        ;root.OCTREE = AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
                Text 200,200,"YES !!!"        +c
                        root\Child[c] = AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
                Else       
                        ;root.OCTREE =        AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
                        root\Child[c] = AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
                EndIf
                ;EndIf
                Next
                EndIf
                If MouseDown(2)  Then ;

                EndIf
               
       
myy = (2*(my-400) -(mx-400))/2 + pz;-s
mxx = ((mx-400)+myy);-;s


RenderStaticLine(root)       
RenderOctree(root,QuadDepth)

Color 255,255,255
Oval 400+ mxx -myy -(6) , 400+ (mxx +myy )/2-pz-(6) ,(12),(12),0

Color 255,5,5
;        Line  400+ (root\xmin-root\ymax),400+ (root\xmin+root\ymax)/2- pz,400+ (root\xmax-root\ymax) , 400+ (root\xmax+root\ymax)/2-pz
;        Line  400+ (root\xmax-root\ymax) , 400+ (root\xmax+root\ymax)/2- pz ,400+ (root\xmax-root\ymin),400+ (root\xmax+root\ymin)/2-pz
Text 550,20,"S = "+s+"  col-vo elements = "+id
Text 550,180-pz,"  Z = "+pz+"    timeout  "+timeout
Flip
Wend
Delete Each OCTREE
End 

Function RenderStaticLine(this.OCTREE)
If this.OCTREE <> Null
Color 255,255,255
        Line 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- this\zmin , 400+ (this\xmin-this\ymax),400+ (this\xmin+this\ymax)/2- this\zmin
        Line  400+ (this\xmin-this\ymax),400+ (this\xmin+this\ymax)/2- this\zmin,400+ (this\xmax-this\ymax) , 400+ (this\xmax+this\ymax)/2- this\zmin
        Line  400+ (this\xmax-this\ymax) , 400+ (this\xmax+this\ymax)/2- this\zmin ,400+ (this\xmax-this\ymin),400+ (this\xmax+this\ymin)/2- this\zmin
        Line  400+ (this\xmax-this\ymin),400+ (this\xmax+this\ymin)/2- this\zmin , 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- this\zmin
Color 255,5,5       
        Line 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- pz , 400+ (this\xmin-this\ymax),400+ (this\xmin+this\ymax)/2-pz
        Line  400+ (this\xmax-this\ymin),400+ (this\xmax+this\ymin)/2- pz , 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- pz
Color 255,255,255       
End If
End Function


Function PointInCube(pointXmin,pointYmin,pointZmin,pointXmax,pointYmax,pointZmax,pointX,pointY,pointZ )
          If  pointX  >=pointXmin And pointX < pointXmax
            If  pointY >= pointYmin And pointY < pointYmax
              If  pointZ>= pointZmin And  pointZ< pointZmax
                        Return True
              End If
            End If
          End If
        Return False
End Function



Function CombineARGB#(aa#,rr%,gg%,bb%)       
        ;Return aa*$1000000+rr*$10000+gg*$100+bb       
        Return $ff000000 Or rr Shl 16 Or gg Shl 8 Or bb
End Function


Изменённый код:

Код:
Global id,mx,my ,QuadDepth
Global px,py,pz ,s ,mxx,myy



Type OCTREE
Field Child.OCTREE[8] ;8 потомков
Field xmin,ymin,zmin ; начальные координаты куба
Field xmax,ymax,zmax ; оконечные координаты куба
Field xcentr,ycentr,zcentr ; центр куба
Field qred,qgreen,qblue,qalpha,qcolor
Field depth
End Type

Function Octree.OCTREE(xmin,ymin,zmin,xmax,ymax,zmax,depth)
        xcentr = (xmin+xmax) / 2
        ycentr = (ymin+ymax) / 2
        zcentr = (zmin+zmax) / 2

this.OCTREE = New OCTREE
        this\xmin = xmin
        this\xmax = xmax
        this\ymin = ymin
        this\ymax = ymax
        this\zmin = zmin
        this\zmax = zmax
        this\xcentr = xcentr
        this\ycentr = ycentr
        this\zcentr = zcentr
        this\depth = depth       
        id = id + 1

If (depth = QuadDepth )
        depth = depth - 1
       
        this\Child[1] = Octree(xmin,ymin,zmin  ,xcentr,ycentr,zcentr ,depth)
        this\Child[2] = Octree(xmin,ycentr,zmin  ,xcentr,ymax,zcentr ,depth)
        this\Child[3] = Octree(xcentr,ycentr,zmin  ,xmax,ymax,zcentr ,depth)
        this\Child[4] = Octree(xcentr,ymin,zmin  ,xmax,ycentr,zcentr ,depth)
        this\Child[5] = Octree(xmin,ymin,zcentr  ,xcentr,ycentr,zmax,depth)
        this\Child[6] = Octree(xmin,ycentr,zcentr  ,xcentr,ymax,zmax,depth)
        this\Child[7] = Octree(xcentr,ycentr,zcentr  ,xmax,ymax,zmax,depth)
        this\Child[8] = Octree(xcentr,ymin,zcentr  ,xmax,ycentr,zmax,depth)

End If
        Return this
End Function


; ====================      =====================
Function RenderOctree(this.OCTREE,depth)

If this.OCTREE <> Null
;If PointInCube(this\xmin,this\ymin,this\zmin,this\xmax,this\ymax,this\zmax,mx,my,pz )        = True
        If (depth >= 0)                       
       
                      Color 28,28,28
                      Line (this\xmin+this\xmax)/2,this\ymin,(this\xmin+this\xmax)/2,this\ymax
                      Line this\xmin,(this\ymin+this\ymax)/2,this\xmax,(this\ymin+this\ymax)/2
                               
                        depth = depth - 1
       
                        RenderOctree(this\Child[1],depth)
                        RenderOctree(this\Child[2],depth)
                        RenderOctree(this\Child[3],depth)       
                        RenderOctree(this\Child[4],depth)
                        RenderOctree(this\Child[5],depth)
                        RenderOctree(this\Child[6],depth)
                        RenderOctree(this\Child[7],depth)
                        RenderOctree(this\Child[8],depth)       
                       
                Color 6,6,196
                Rect this\xmin+1,this\ymin+1,this\xmax-this\xmin-2,this\ymax-this\ymin-2,0
                Color 128,128,128
                Text this\xmin+this\depth*4,this\ymin+this\depth*4,"+  " +this\depth
        Else
                Color 196,6,6
                Rect this\xmin+2,this\ymin+2,this\xmax-this\xmin-3,this\ymax-this\ymin-3,1
                Color 128,128,128
                Text this\xmin+this\depth*4,this\ymin+this\depth*4,"+  " +this\depth
        End If
End If
;End If
End Function

; ====================      =====================
Function AddToOctree.OCTREE(xmin,ymin,zmin,xmax,ymax,zmax,depth)
If PointInCube(xmin,ymin,zmin,xmax,ymax,zmax,mx,my,pz )        = True
        xcentr = (xmin+xmax) / 2
        ycentr = (ymin+ymax) / 2
        zcentr = (zmin+zmax) / 2
       
this.OCTREE = New OCTREE
        this\xmin = xmin
        this\xmax = xmax
        this\ymin = ymin
        this\ymax = ymax
        this\zmin = zmin
        this\zmax = zmax
        this\xcentr = xcentr
        this\ycentr = ycentr
        this\zcentr = zcentr
        this\depth = depth               
;        id = id + 1       

If (depth > 0)       

        depth = depth - 1

        this\Child[1] = AddToOctree(xmin,ymin,zmin  ,xcentr,ycentr,zcentr ,depth)
        this\Child[2] = AddToOctree(xmin,ycentr,zmin  ,xcentr,ymax,zcentr ,depth)
        this\Child[3] = AddToOctree(xcentr,ycentr,zmin  ,xmax,ymax,zcentr ,depth)
        this\Child[4] = AddToOctree(xcentr,ymin,zmin  ,xmax,ycentr,zcentr ,depth)
        this\Child[5] = AddToOctree(xmin,ymin,zcentr  ,xcentr,ycentr,zmax,depth)
        this\Child[6] = AddToOctree(xmin,ycentr,zcentr  ,xcentr,ymax,zmax,depth)
        this\Child[7] = AddToOctree(xcentr,ycentr,zcentr  ,xmax,ymax,zmax,depth)
        this\Child[8] = AddToOctree(xcentr,ymin,zcentr  ,xmax,ycentr,zmax,depth)

EndIf
EndIf
        Return this
End Function





Graphics 800,600,32,2
SetBuffer BackBuffer()
HidePointer

QuadDepth =5    ; 8 ;число вложений (глубина )
QuadSize = 512 ; размеры квадранта

timestart = MilliSecs()
root.OCTREE = Octree(0,0,0,QuadSize,QuadSize,QuadSize,QuadDepth)
timeout = (MilliSecs()-timestart)
While Not KeyHit(1)
mx = MouseX()
my = MouseY()
s = Abs(MouseZ())
Cls
Select True
Case KeyDown(200) : py=py-1*20; Up
Case KeyDown(208) : py=py+1*20; Down
Case KeyDown(203) : px=px-1*20; Left
Case KeyDown(205) : px=px+1*20; Right
Case KeyDown(57)
End Select
If  KeyHit(30) And pz <180 Then pz=pz+10 ;  A key
If  KeyHit(44) And pz > 0 Then pz=pz-10       

                If MouseDown(1) Or KeyDown(157)  Then ;
                If root.OCTREE <> Null
                ;If root\Child[c] <> Null
                For c = 1 To 8
                If PointInCube(root\Child[c]\xmin,root\Child[c]\ymin,root\Child[c]\zmin,root\Child[c]\xmax,root\Child[c]\ymax,root\Child[c]\zmax,mx,my,pz )        = True
               
                        ;root.OCTREE = AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
                Text 200,200,"YES !!!    "        +c
                        root\Child[c] = AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
                ;Else       
                        ;root.OCTREE =        AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
                        ;root\Child[c] = AddToOctree(root\xmin,root\ymin,root\zmin,root\xmax,root\ymax,root\zmax,QuadDepth)
                EndIf
               
                Next
                EndIf
                ;EndIf
                EndIf
                If MouseDown(2)  Then ;

                EndIf
               
       
myy = (2*(my-400) -(mx-400))/2 + pz;-s
mxx = ((mx-400)+myy);-;s


;RenderStaticLine(root)       
RenderOctree(root,QuadDepth)

Color 255,255,255
Oval 400+ mxx -myy -(6) , 400+ (mxx +myy )/2-pz-(6) ,(12),(12),0

Color 255,5,5
;        Line  400+ (root\xmin-root\ymax),400+ (root\xmin+root\ymax)/2- pz,400+ (root\xmax-root\ymax) , 400+ (root\xmax+root\ymax)/2-pz
;        Line  400+ (root\xmax-root\ymax) , 400+ (root\xmax+root\ymax)/2- pz ,400+ (root\xmax-root\ymin),400+ (root\xmax+root\ymin)/2-pz
Text 550,20,"S = "+s+"  col-vo elements = "+id
Text 550,180-pz,"  Z = "+pz+"    timeout  "+timeout
Flip
Wend
Delete Each OCTREE
End 

Function RenderStaticLine(this.OCTREE)
If this.OCTREE <> Null
Color 255,255,255
        Line 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- this\zmin , 400+ (this\xmin-this\ymax),400+ (this\xmin+this\ymax)/2- this\zmin
        Line  400+ (this\xmin-this\ymax),400+ (this\xmin+this\ymax)/2- this\zmin,400+ (this\xmax-this\ymax) , 400+ (this\xmax+this\ymax)/2- this\zmin
        Line  400+ (this\xmax-this\ymax) , 400+ (this\xmax+this\ymax)/2- this\zmin ,400+ (this\xmax-this\ymin),400+ (this\xmax+this\ymin)/2- this\zmin
        Line  400+ (this\xmax-this\ymin),400+ (this\xmax+this\ymin)/2- this\zmin , 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- this\zmin
Color 255,5,5       
        Line 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- pz , 400+ (this\xmin-this\ymax),400+ (this\xmin+this\ymax)/2-pz
        Line  400+ (this\xmax-this\ymin),400+ (this\xmax+this\ymin)/2- pz , 400+ (this\xmin-this\ymin) , 400+ (this\xmin+this\ymin)/2- pz
Color 255,255,255       
End If
End Function


Function PointInCube(pointXmin,pointYmin,pointZmin,pointXmax,pointYmax,pointZmax,pointX,pointY,pointZ )
          If  pointX  >=pointXmin And pointX < pointXmax
            If  pointY >= pointYmin And pointY < pointYmax
              If  pointZ>= pointZmin And  pointZ< pointZmax
                        Return True
              End If
            End If
          End If
        Return False
End Function



Function CombineARGB#(aa#,rr%,gg%,bb%)       
        ;Return aa*$1000000+rr*$10000+gg*$100+bb       
        Return $ff000000 Or rr Shl 16 Or gg Shl 8 Or bb
End Function

polopok 13.05.2013 12:45
Ответ: Voxel (octotree)
 
Итак ,кажись получилось разобраться с родителями-потомками ,дабы не запутаться написал пример без Z координаты .
Если у кого есть идеи улучшения ,буду рад ознакомиться.

Код:
Global id,mx,my ,CubDepth
Global px,py,pz ,s ,mxx,myy



Type OCTREE
Field Child.OCTREE[8] ;8 потомков
Field xmin,ymin,zmin
Field xcentr,ycentr,zcentr ; центр куба
Field qred,qgreen,qblue,qalpha,qcolor
Field size , depth , block=False
End Type

;Global root.OCTREE

Function RootOctree.OCTREE(xmin,ymin,zmin ,size,depth)
       
               
        newsize = size / 2
       
        this.OCTREE = New OCTREE
        this\xmin = xmin
        this\ymin = ymin
        this\zmin = 0
        this\size = size
        this\depth = depth
       
       
        id = id + 1
        If depth = CubDepth
        depth = depth - 1
                this\Child[0] = Null
                this\Child[1] = Null
                this\Child[2] = Null
                this\Child[3] = Null

        EndIf
        Return this
End Function




Function AddOctree.OCTREE( this.OCTREE,xmin,ymin,zmin ,size,depth)

If PointInCube(xmin,ymin,zmin,xmin+size,ymin+size,zmin+size,mx,my,0 )       
newsize = size / 2
                If depth >0
                        depth = depth - 1
If this <> Null

        For cub = 0 To 3
        If this\Child[cub] <> Null

                If PointInCube( this\Child[cub]\xmin,this\Child[cub]\ymin,this\Child[cub]\zmin,this\Child[cub]\xmin+this\Child[cub]\size,this\Child[cub]\ymin+this\Child[cub]\size,this\Child[cub]\zmin+this\Child[cub]\size,mx,my,0 )       
                        AddOctree(this\Child[cub], this\Child[cub]\xmin ,this\Child[cub]\ymin ,0,newsize, depth)       
                EndIf
       
        EndIf
        Next

        If this\Child[0] = Null
        If this\Child[1] = Null
        If this\Child[2] = Null
        If this\Child[3] = Null
               
               
                this0.OCTREE = New OCTREE
                this0\xmin = xmin + newsize
                this0\ymin = ymin
                this0\size = newsize
                this0\depth = depth               

                this1.OCTREE = New OCTREE
                this1\xmin = xmin
                this1\ymin = ymin + newsize
                this1\size = newsize
                this1\depth = depth                       
               
                this2.OCTREE = New OCTREE
                this2\xmin = xmin
                this2\ymin = ymin
                this2\size = newsize
                this2\depth = depth                               
                       
                this3.OCTREE = New OCTREE
                this3\xmin = xmin + newsize
                this3\ymin = ymin + newsize
                this3\size = newsize
                this3\depth = depth                               
                       
                       
                       
                id = id + 4
               
                this\Child[0] = this0
                this\Child[1] =  this1
                this\Child[2] =  this2
                this\Child[3] =  this3
                                       
        EndIf
        EndIf
        EndIf
        EndIf
       

               
                EndIf
        EndIf       
EndIf
        Return this
End Function



Graphics 800,600,32,2
SetBuffer BackBuffer()
;HidePointer
CubDepth =6  ; 8 ;число вложений (глубина )
CubSize = 512 ; размеры квадранта

root.OCTREE = RootOctree(0,0,0,CubSize ,CubDepth )
While Not KeyHit(1)
mx = MouseX()
my = MouseY()
s = Abs(MouseZ())
Cls

                If MouseDown(1) Or KeyDown(157)  Then ;
                timestart = MilliSecs()       
                        ; FindChildOctree(root)
                        AddOctree(root, 0,0,0,CubSize ,CubDepth)
                timeout = (MilliSecs()-timestart)       
                EndIf
               

RenderOctree(root,CubDepth )

Color 255,255,255
;Rect 0 , 0  , CubSize , CubSize ,0       
Text 550,20,"S = "+s+"  col-vo elements = "+id
Text 550,180-pz,"  Z = "+pz+"    timeout  "+timeout
Flip
Wend
Delete Each OCTREE
End 

Function RenderOctree(this.OCTREE,depth)
If this.OCTREE <> Null
        If (depth > 0)                       
               
               
                Color 128,128,128
                Rect this\xmin , this\ymin , this\size , this\size , 0
                Text this\xmin +this\depth*6, this\ymin +this\depth*6 , this\depth
                        depth = depth - 1
                        RenderOctree(this\Child[0],depth)
                        RenderOctree(this\Child[1],depth)
                        RenderOctree(this\Child[2],depth)
                        RenderOctree(this\Child[3],depth)       
               
        Else       
                                Color 128,128,128
                Rect this\xmin , this\ymin , this\size , this\size , 1                               
        End If
EndIf
End Function

Function PointInCube(pointXmin#,pointYmin#,pointZmin#,pointXmax#,pointYmax#,pointZmax#,pointX#,pointY#,pointZ# )
          If  pointX  >=pointXmin And pointX < pointXmax
            If  pointY >= pointYmin And pointY < pointYmax
              If  pointZ>= pointZmin And  pointZ< pointZmax
                        Return True
              End If
            End If
          End If
        Return False
End Function


Вот несколько улучшил код ...
но всё-же ,далеко до "идеала"

Код:
Global id,mx,my ,CubDepth
Global px,py,pz ,s ,mxx,myy



Type OCTREE
Field Child.OCTREE[8] ;8 потомков
Field xmin,ymin,zmin
Field xcentr,ycentr,zcentr ; центр куба
Field qred,qgreen,qblue,qalpha,qcolor
Field size , depth , block=False
End Type

;Global root.OCTREE

Function RootOctree.OCTREE(xmin,ymin,zmin ,size,depth)
       
               
        newsize = size / 2
       
        this.OCTREE = New OCTREE
        this\xmin = xmin
        this\ymin = ymin
        this\zmin = 0
        this\size = size
        this\depth = depth
       
       
        id = id + 1
        If depth = CubDepth
        depth = depth - 1
                this\Child[0] = Null
                this\Child[1] = Null
                this\Child[2] = Null
                this\Child[3] = Null

        EndIf
        Return this
End Function




Function AddOctree.OCTREE( this.OCTREE,xmin,ymin,zmin ,size,depth)

If PointInCube(xmin,ymin,zmin,xmin+size,ymin+size,zmin+size,mx,my,0 )       
newsize = size / 2
                If depth >0
                        depth = depth - 1
If this <> Null

        For cub = 0 To 3
        If this\Child[cub] <> Null

                If PointInCube( this\Child[cub]\xmin,this\Child[cub]\ymin,this\Child[cub]\zmin,this\Child[cub]\xmin+this\Child[cub]\size,this\Child[cub]\ymin+this\Child[cub]\size,this\Child[cub]\zmin+this\Child[cub]\size,mx,my,0 )       
                        AddOctree(this\Child[cub], this\Child[cub]\xmin ,this\Child[cub]\ymin ,0,newsize, depth)       
                EndIf
       
        EndIf
        Next
       
        For cub = 0 To 3
       
        If this\Child[cub ] = Null

        Select cub       
                Case 0
                this0.OCTREE = New OCTREE
                this0\xmin = xmin + newsize
                this0\ymin = ymin
                this0\size = newsize
                this0\depth = depth               
                this\Child[0] = this0
                Case 1
                this1.OCTREE = New OCTREE
                this1\xmin = xmin
                this1\ymin = ymin + newsize
                this1\size = newsize
                this1\depth = depth                       
                this\Child[1] =  this1
                Case 2
                this2.OCTREE = New OCTREE
                this2\xmin = xmin
                this2\ymin = ymin
                this2\size = newsize
                this2\depth = depth                               
                this\Child[2] =  this2
                Case 3       
                this3.OCTREE = New OCTREE
                this3\xmin = xmin + newsize
                this3\ymin = ymin + newsize
                this3\size = newsize
                this3\depth = depth                       
                this\Child[3] =  this3       
                End Select       
                       
                       
                id = id + 1
               
               
                AddOctree( this,xmin,ymin,zmin ,size,depth)
               
        EndIf
        Next

               
                EndIf
        EndIf       
EndIf
End Function



Graphics 800,600,32,2
SetBuffer BackBuffer()
;HidePointer
CubDepth =8  ; 8 ;число вложений (глубина )
CubSize = 512 ; размеры квадранта

root.OCTREE = RootOctree(0,0,0,CubSize ,CubDepth )
While Not KeyHit(1)
mx = MouseX()
my = MouseY()
s = Abs(MouseZ())
Cls

                If MouseDown(1) Or KeyDown(157)  Then ;
                timestart = MilliSecs()       
                        ; FindChildOctree(root)
                        AddOctree(root, 0,0,0,CubSize ,CubDepth)
                timeout = (MilliSecs()-timestart)       
                EndIf
               

RenderOctree(root,CubDepth )

Color 255,255,255
;Rect 0 , 0  , CubSize , CubSize ,0       
Text 550,20,"S = "+s+"  col-vo elements = "+id
Text 550,180-pz,"  Z = "+pz+"    timeout  "+timeout
Flip
Wend
Delete Each OCTREE
End 

Function RenderOctree(this.OCTREE,depth)
If this.OCTREE <> Null
        If (depth > 0)                       
               
               
                Color 128,128,128
                Rect this\xmin , this\ymin , this\size , this\size , 0
                Text this\xmin +this\depth*6, this\ymin +this\depth*6 , this\depth
                        depth = depth - 1
                        RenderOctree(this\Child[0],depth)
                        RenderOctree(this\Child[1],depth)
                        RenderOctree(this\Child[2],depth)
                        RenderOctree(this\Child[3],depth)       
               
        Else       
                                Color 128,128,128
                Rect this\xmin , this\ymin , this\size , this\size , 1                               
        End If
EndIf
End Function

Function PointInCube(pointXmin#,pointYmin#,pointZmin#,pointXmax#,pointYmax#,pointZmax#,pointX#,pointY#,pointZ# )
          If  pointX  >=pointXmin And pointX < pointXmax
            If  pointY >= pointYmin And pointY < pointYmax
              If  pointZ>= pointZmin And  pointZ< pointZmax
                        Return True
              End If
            End If
          End If
        Return False
End Function

polopok 16.05.2013 15:33
Ответ: Voxel (octotree)
 
Итак, опять доработки. Теперь ещё меньше разбиений ,улучшен алгоритм добавления вокселя.

Код:
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

polopok 17.05.2013 14:47
Ответ: Voxel (octotree)
 
Сново ,немного говно кода :-D .
Теперь ещё задействовано колёсико мыши .
В этой разработке использовал данные из этой статьи , конечно переделал по своему, но вдруг кому будет интересно.
Так же 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


А теперь несколько упорядоченный говно-код с элементами извращениями ... :blink:
Код:
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 06.10.2013 08:52
Ответ: Voxel (octotree)
 
Вот ,после долгого отсутствия ...
Накатал новый пример ...
собственно здесь создаются две структуры ,самого октри и точек . В зависимости от перемещения точек меняется структура октри .

код:
Код:
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

polopok 07.10.2013 19:43
Ответ: Voxel (octotree)
 
Ну ,вот , наконец-то что-то получилось ...
Ошибка крылась как всегда в моей невнимательности .
Правда с удалением пришлось повозиться.
Считаю вполне рабочий вариант :cool: :crazy:
код:
Код:
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


собственно небольшое отклонение . Для чего это нужно , вот пример построение ландшафта при помощи квадро-дерева тут .

Reizel 10.10.2013 12:24
Ответ: Voxel (octotree)
 
ты б лучше свои размышления в виде статейки like habrahabr выложил, я б с удовольствием почитал, нежели код..

polopok 13.10.2013 12:09
Ответ: Voxel (octotree)
 
Не которое отклонение от темы , создавать новую не считаю нужным .
Проверьте ,код на тормазнутость ,пожалуйста .

Проверка попадают ли точки в зону видимости
Код:




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

polopok 27.05.2014 01:44
Ответ: Voxel (octotree)
 
Давно хотел выложить приемлемый вариант динамического октодерева ,
но нужно ещё пахать и пахать :-D
за одно ссылка на модуль *js Octree
Код:
time = CreateTimer(120)
Const Points = 200
Global id,id2,mx,my ,CubDepth ,CubSize 
Global px,py,pz ,s ,mxx,myy , mmy
Global timeoutcreate# , timeintcreate
Global viewline ,v=3


Type OCTREE
Field Child.OCTREE[7] ;8 потомков
Field xmin,ymin,zmin
;Field xcentr,ycentr,zcentr ;
Field  emply
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 , one.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
        this\emply =1
        id2=id2+1
       
        Return this
End Function




Function AddOctree.OCTREE( this.OCTREE,xmin,ymin,zmin ,size,depth )

If  InCube(xmin,ymin,zmin,size) =  True
        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\emply = 1
        Else               
        this\emply = 1
                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 ,newdepth )
                this\Child[1] = AddOctree(this\Child[1], xmin,newymin  ,zmin  ,newsize ,newdepth )
                this\Child[2] = AddOctree(this\Child[2], newxmin ,newymin ,zmin  ,newsize  ,newdepth )
                this\Child[3] = AddOctree(this\Child[3], newxmin ,ymin,zmin  ,newsize  ,newdepth )
               
                this\Child[4] = AddOctree(this\Child[4], xmin,ymin,newzmin ,newsize,newdepth )
                this\Child[5] = AddOctree(this\Child[5], xmin,newymin ,newzmin ,newsize ,newdepth )
                this\Child[6] = AddOctree(this\Child[6], newxmin ,newymin ,newzmin ,newsize ,newdepth )
                this\Child[7] = AddOctree(this\Child[7], newxmin ,ymin,newzmin ,newsize ,newdepth )
               
                EndIf
        EndIf
Else
        If  this<>Null
        this\emply = 0       
        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 ,newdepth )
                this\Child[1] = AddOctree(this\Child[1], xmin,newymin  ,zmin  ,newsize  ,newdepth )
                this\Child[2] = AddOctree(this\Child[2], newxmin ,newymin ,zmin  ,newsize  ,newdepth )
                this\Child[3] = AddOctree(this\Child[3], newxmin ,ymin,zmin  ,newsize ,newdepth )
               
                this\Child[4] = AddOctree(this\Child[4], xmin,ymin,newzmin ,newsize ,newdepth )
                this\Child[5] = AddOctree(this\Child[5], xmin,newymin ,newzmin ,newsize ,newdepth )
                this\Child[6] = AddOctree(this\Child[6], newxmin ,newymin ,newzmin ,newsize ,newdepth )
                this\Child[7] = AddOctree(this\Child[7], newxmin ,ymin,newzmin ,newsize ,newdepth )
               
        EndIf
        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

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 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 =5  ; 8 ;число вложений (глубина )
CubSize = 128 ; размеры квадранта

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
;EraseOctree(root)
;root.OCTREE = RootOctree(0,0,0,CubSize ,CubDepth )
If KeyHit(28)  Then viewline = Not viewline


WaitTimer(time)

timestart = MilliSecs()

        AddOctree(root, 0,0,0,CubSize ,CubDepth)       

For pt2.POINT = Each POINT       

        If pt2\x <-250 Then

        v=3
        EndIf
        If pt2\x >= 226 Then

        v=-3
        EndIf
        pt2\x = pt2\x +v       
Next

For roots.OCTREE = Each OCTREE
        If roots<>Null
                id=id+1
                If roots\emply = 0  And roots <> First OCTREE
                Delete roots
                id2=id2-1
                EndIf
        EndIf
Next


RenderOctree(root,CubDepth )

timeout = (MilliSecs()-timestart)       




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
        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
Delete Each POINT
FreeTimer time
End 

Function RenderOctree(this.OCTREE,depth)
If this.OCTREE <> Null
        If (depth >0)        And this\emply = 1
                If show2d = 0
                        ;Color 255,255,255
                ;        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
                        ;If this\emply = 1 Then Color 255,0,255
                        If this\emply = 0 Then Color 255,0,255
                        If this= First OCTREE  Then Color 0,0,255 Else Color 200,200,200
                       
                                               
                        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()
                                                WritePixel 400+ ( this\xmin -this\ymin) , 300+ ( this\xmin +this\ymin)/2 - this\zmin,$ffffff, GraphicsBuffer()
                ;                        Next       
                ;                Next               
                ;        Next       
                        UnlockBuffer GraphicsBuffer()
                EndIf       
               
                If show2d = 0
                       
                        LockBuffer GraphicsBuffer()
                        WritePixel this\xmin , this\ymin , $ffffff       
                        UnlockBuffer GraphicsBuffer()
                EndIf
        EndIf
EndIf
End Function

Function EraseOctree(this.OCTREE)
        For this.OCTREE = Each OCTREE
        Delete this
        Next
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

moka 27.05.2014 05:23
Ответ: Voxel (octotree)
 
Ссылка на JS версию octree у тебя не та, ты скорее всего имел ввиду вот эту?
http://mrdoob.github.io/three.js/examples/#webgl_octree

polopok 29.05.2014 09:00
Ответ: Voxel (octotree)
 
Я тут подумал , если точки в вокселе нет ,то он удаляется ,но в динамике точки перемещаются , а потому могут сново попасть в удалённый узел ,значит нужно удалять только те воксели при премещении точек оказались пусты :crazy: . Так что я ввёл дополнительный параметр ,как жизнь вокселя . Думаю понятней будет в коде ( добавленые/изменённые строки ,помечены так ;///
Код:
time = CreateTimer(120)
SeedRnd(MilliSecs())
Const Points = 200
Global id,id2,mx,my ,CubDepth ,CubSize 
Global px,py,pz ,s ,mxx,myy , mmy
Global timeoutcreate# , timeintcreate
Global viewline ,v=3


Type OCTREE
Field Child.OCTREE[7] ;8 потомков
Field xmin,ymin,zmin
Field  emply , timeLive, isView        ;///
;Field qred,qgreen,qblue,qalpha,qcolor
Field size , depth
End Type

Type Point
Field x,y,z
Field x2,y2,z2
Field vx,vy,vz
End Type

Global root.OCTREE , one.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
        this\emply =0
        id2=id2+1
       
        Return this
End Function




Function AddOctree.OCTREE( this.OCTREE,xmin,ymin,zmin ,size,depth )

If  InCube(xmin,ymin,zmin,size) =  True
        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\emply = 1
        Else               
        this\emply = 1
        this\timelive = 0        ;///
                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 ,newdepth )
                this\Child[1] = AddOctree(this\Child[1], xmin,newymin  ,zmin  ,newsize ,newdepth )
                this\Child[2] = AddOctree(this\Child[2], newxmin ,newymin ,zmin  ,newsize  ,newdepth )
                this\Child[3] = AddOctree(this\Child[3], newxmin ,ymin,zmin  ,newsize  ,newdepth )
               
                this\Child[4] = AddOctree(this\Child[4], xmin,ymin,newzmin ,newsize,newdepth )
                this\Child[5] = AddOctree(this\Child[5], xmin,newymin ,newzmin ,newsize ,newdepth )
                this\Child[6] = AddOctree(this\Child[6], newxmin ,newymin ,newzmin ,newsize ,newdepth )
                this\Child[7] = AddOctree(this\Child[7], newxmin ,ymin,newzmin ,newsize ,newdepth )
               
                EndIf
        EndIf
Else
        If  this<>Null
        this\emply = 0       
        this\timelive = 1        ;///
        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 ,newdepth )
                this\Child[1] = AddOctree(this\Child[1], xmin,newymin  ,zmin  ,newsize  ,newdepth )
                this\Child[2] = AddOctree(this\Child[2], newxmin ,newymin ,zmin  ,newsize  ,newdepth )
                this\Child[3] = AddOctree(this\Child[3], newxmin ,ymin,zmin  ,newsize ,newdepth )
               
                this\Child[4] = AddOctree(this\Child[4], xmin,ymin,newzmin ,newsize ,newdepth )
                this\Child[5] = AddOctree(this\Child[5], xmin,newymin ,newzmin ,newsize ,newdepth )
                this\Child[6] = AddOctree(this\Child[6], newxmin ,newymin ,newzmin ,newsize ,newdepth )
                this\Child[7] = AddOctree(this\Child[7], newxmin ,ymin,newzmin ,newsize ,newdepth )
               
        EndIf
        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
CubDepth =6 ; 8 ;число вложений (глубина )
CubSize = 128 ; размеры квадранта

root.OCTREE = RootOctree(0,0,0,CubSize ,CubDepth )
While Not KeyHit(1)
start  = MilliSecs()
id=0
Cls

If KeyHit(28)  Then viewline = Not viewline


WaitTimer(time)

timestart = MilliSecs()

        AddOctree(root, 0,0,0,CubSize ,CubDepth)       

For pt2.POINT = Each POINT       

        If pt2\x <-250 Then

        v=3
        EndIf
        If pt2\x >= 226 Then

        v=-3
        EndIf
        pt2\x = pt2\x +v       
Next

For roots.OCTREE = Each OCTREE
        If roots<>Null       
                id=id+1
                If roots\timelive = 1 Then roots\timelive = roots\timelive +1  ;///
                If roots\emply = 0 And roots\timelive = 2 And roots <> First OCTREE  ;///
                Delete roots
                id2=id2-1
                EndIf
        EndIf
Next


RenderOctree(root,CubDepth )

timeout = (MilliSecs()-timestart)       


;--------------- INFO -----------------------------------
        Color 255,255,255
        Text 550,20,"Elements = "+id+"  id2  = "+id2
        Text 550,80,"Time AddOctree = "+timeout 
        timeoutvis = (MilliSecs()-timeinvis)       
        Text 550,100,"Current FPS: " + CurFPS# 
        Text 550,120,"ViewBoxes = "+viewline +"      - press ENTER"
        CurFPS# = 1000.0 / (MilliSecs() - Start)
Flip
Wend
Delete Each OCTREE
Delete Each POINT
FreeTimer time
End 

Function RenderOctree(this.OCTREE,depth)
If this.OCTREE <> Null
        If (depth >0)        And this\emply = 1
                If viewline = 0                       
                        If this\emply = 0 Then Color 255,0,255
                        If this= First OCTREE  Then Color 0,0,255 Else Color 200,200,200
                       
                                               
                        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
                        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()
                                                WritePixel 400+ ( this\xmin -this\ymin) , 300+ ( this\xmin +this\ymin)/2 - this\zmin,$ffffff, GraphicsBuffer()
                        UnlockBuffer GraphicsBuffer()
                EndIf       
               

                       
                        LockBuffer GraphicsBuffer()
                        WritePixel this\xmin , this\ymin , $ffffff       
                        UnlockBuffer GraphicsBuffer()

        EndIf
EndIf
End Function

Function PointInCube(pointXmin#,pointYmin#,pointZmin#,pointXmax#,pointYmax#,pointZmax#,pointX#,pointY#,pointZ )
          If  pointX  >=pointXmin And pointX < pointXmax
            If  pointY >= pointYmin And pointY < pointYmax
              If  pointZ>= pointZmin And  pointZ< pointZmax
                        Return True
              End If
            End If
          End If
        Return False
End Function

polopok 20.08.2015 20:40
Ответ: Voxel (octotree)
 
В продолжении темы ... Другой подход к добавлению и получению вокселей (подход в коде разработан не мною , но скорость впечатляет ;) )
Код:
;        [depthMax = X*Y*Z]
;        1 = 2
;        2 = 4
;        3 = 8
;        4 = 16
;        5 = 32
;        6 = 64
;        7 = 128
;        8 = 256
;        9 = 512
;        10 = 1024
;        11 = 2048
Const depthMax = 6 ; [0 - 64 OR 64*64*64]
;Const depthMax = 8 ; [0 - 255 OR 255*255*255]
Const v = 100 , ConstCubSize =63 , s = 2
time = CreateTimer(60)
Global id , Objects
Global levelOctree

Type oct
Field pok.oct[8]  , cvet , level;depth
Field parent.oct
Field name$ , group
End Type


Global ppp.oct = New oct
Global ccc.oct
Local ddd.oct
colors% = $ff0000
level% =4

Graphics 800,600,32,2
SetBuffer BackBuffer()
ppp\name = " ROOT"

map=LoadImage("D:\vitalii\blitz\hmap5.jpg")

DrawBlock map,0,0       
LockBuffer BackBuffer()
For y0=0 To ConstCubSize ;Step 1
        For x0=0 To ConstCubSize ;Step 1
                rgb = ReadPixel(x0,y0) And $FFFFFF
        ;        If rgb = $000000 rgb =$111111
                rr= GetR(rgb )
                gg= GetG(rgb )
                bb= GetB(rgb )       
               
                z0=Int(Floor ((  ((rr*v)/100) + ((gg*v)/100) +((bb*v)/100)  )/ 90))
                If z0 <=0 z0 =1
        ;        z0 =1
;                AddOctree(root, 0,0,0,CubSize,x0,y0,z0 ,CubDepth , rr ,gg ,bb)
                z1 = 0
                While z1 < z0
                add(ppp,x0,y0,z1,1 ,rgb,0," SECOND")
                z1=z1+1
                Wend
Next
Next
UnlockBuffer BackBuffer()

Restore sold
For z= 0 To 9
For y = 0 To 2
For x = 0 To 6
        Read dat
        If dat >0 dat = $ff0000 Else dat = $000000
        add(ppp,20+x,20+y,20+z,1 ,dat,1," SOLDER")
Next :Next :Next
For z= 0 To 4
For y = 0 To 4
For x = 0 To 4
        add(ppp,50+x,50+y,50+z,1 ,$0000ff,2," CUBE")
Next :Next :Next

;        add(ppp,62,60,63,4 ,$ff0000," SECOND") ; Add Octree
;        add(ppp,32,60,63,3 ,$0000ff," SECOND")
While Not KeyHit(1)
Cls
DrawBlock map,65,65       
mx = MouseX() : my=MouseY()

;        ddd =get(ppp,62,255,255,3) ; Get Octree


render(ppp,64,64,64,depthMax,64 )


Color 255,255,255
AppTitle "    id  -  "+id +" Object  -  "+Objects 


;DebugLog  "id  -  "+id +" Object  -  "+Objects 
Flip
Wend
Delete Each oct
FreeTimer (time)
End

; __ FUNCTIONS__

Function render(ooo.oct,xmin,ymin,zmin,depth,size)
        If ooo <> Null
               
        If depth >= 0                               
                newdepth = depth -1
                        newsize = (size Shr 1)
                        newxmin = xmin+newsize
                        newymin = ymin+newsize
                        newzmin = zmin+newsize                       

               
                If ooo\cvet >$000000
                x_min =  (xmin - ymin)
                y_min =  (xmin + ymin)/2 -  zmin               
                        Color ooo\cvet Shr 16 And %11111111,ooo\cvet Shr 8 And %11111111,ooo\cvet And %11111111
                ;        Oval  400+x_min*s-1,300+y_min*s-1,size*s+2,size*s+2,1
                ;        Rect 400+x_min*s,300+y_min*s,size*s+1,size*s+1,1
                        WritePixel 400+x_min,300+y_min,ooo\cvet
                ;        Color 255,255,255
                        Rect xmin-63,ymin-63,size,size,1
                Else
                        Color 255,255,255
                ;        Rect xmin-63,ymin-63,size,size,0
                EndIf       
               
                        If ooo\pok[0] <> Null render(ooo\pok[0] ,xmin,ymin,zmin,newdepth,newsize)
                        If ooo\pok[1] <> Null render(ooo\pok[1] ,newxmin,ymin,zmin,newdepth,newsize)
                        If ooo\pok[2] <> Null render(ooo\pok[2] ,xmin,newymin,zmin,newdepth,newsize)
                        If ooo\pok[3] <> Null render(ooo\pok[3] ,newxmin,newymin,zmin,newdepth,newsize)
                       
                        If ooo\pok[4] <> Null render(ooo\pok[4] ,xmin,ymin,newzmin,newdepth,newsize)
                        If ooo\pok[5] <> Null render(ooo\pok[5] ,xmin,newymin,newzmin,newdepth,newsize)
                        If ooo\pok[6] <> Null render(ooo\pok[6] ,newxmin,ymin,newzmin,newdepth,newsize)
                        If ooo\pok[7] <> Null render(ooo\pok[7] ,newxmin,newymin,newzmin,newdepth,newsize)
        EndIf       
        EndIf
End Function

Function get.oct(ooo.oct,x,y,z,levelOctree)
Local tx,ty,tz

        depth = depthMax -1
       
        tx = x Shr depth
        ty = y Shr depth
        tz = z Shr depth
;DebugLog  " "+x+" "+y+" "+z+" "
;DebugLog  " "+tx+" "+ty+" "+tz+" "       

        k= tx+ ty Shl 1 + tz Shl 2
        ccc = ooo\pok[k]
       
                If ccc = Null Then
                        Return Null
                Else
                        If depth = levelOctree Return ccc
                EndIf
       
        While Not depth = 1
                x = x - tx Shl depth
                y = y - ty Shl depth
                z = z - tz Shl depth
       
                depth = depth -1
               
                tx = x Shr depth
                ty = y Shr depth
                tz = z Shr depth
;DebugLog  " "+x+" "+y+" "+z+" "
;DebugLog  " "+tx+" "+ty+" "+tz+" "                       
               
                k= tx+ ty Shl 1 + tz Shl 2
                ccc = ccc\pok[k]
               
                If ccc = Null Then
                        Return Null
                Else
                        If depth = levelOctree Return ccc
                EndIf
               
        Wend
       
        x = x - tx Shl depth
        y = y - ty Shl depth
        z = z - tz Shl depth
       
        depth = depth -1

        tx = x Shr depth
        ty = y Shr depth
        tz = z Shr depth
;DebugLog  " "+x+" "+y+" "+z+" "
;DebugLog  " "+tx+" "+ty+" "+tz+" "       

        k= tx+ ty Shl 1 + tz Shl 2
        ccc = ccc\pok[k]
       
        If ccc = Null Then Return Null
        levelOctree = depth       
Return ccc 
End Function

Function add.oct(ooo.oct,x,y,z,levelOctree ,cvet,group ,name$ )       
Local tx,ty,tz, ar.oct
        ar = ooo
        depth = depthMax -1
       
        tx = x Shr depth
        ty = y Shr depth
        tz = z Shr depth

        k= tx+ ty Shl 1 + tz Shl 2
        ccc = ooo\pok[k]
       
        If ccc = Null Then
                ccc = New oct :id= id +1
                ccc\name = " ROOT "+Str( depth)
                ccc\group = group
                ccc\parent = ar
                ccc\level = depth
        EndIf
        ooo\pok[k] = ccc
        ooo = ccc
        ar = ooo
       
While Not depth = levelOctree ;depth > 1

        x = x - tx Shl depth
        y = y - ty Shl depth
        z = z - tz Shl depth

        depth = depth -1
       
        tx = x Shr depth
        ty = y Shr depth
        tz = z Shr depth

        k= tx+ ty Shl 1 + tz Shl 2
        ccc = ooo\pok[k]
       
        If ccc = Null Then
                ccc = New oct :id= id +1
                ccc\name = " ROOT " +Str( depth)
                ccc\group = group
                ccc\parent = ar
                ccc\level = depth
        EndIf
        ooo\pok[k] = ccc
        ooo = ccc
        ar = ooo
Wend

        ar = ooo
        x = x - tx Shl depth
        y = y - ty Shl depth
        z = z - tz Shl depth
       
        depth = depth -1

        tx = x Shr depth
        ty = y Shr depth
        tz = z Shr depth
       
        k= tx+ ty Shl 1 + tz Shl 2
        ccc = ooo\pok[k]

        If ccc = Null Then
                ccc = New oct :id= id +1
                ccc\name = name
                ccc\group = group
                ccc\level = depth
                ccc\parent = ar
                ccc\cvet = cvet
                Objects  = Objects  +1
        EndIf
       
        ooo\pok[k] = ccc
End Function

Function GetR(RGB)
    Return RGB Shr 16 And %11111111
End Function

; return Green value out of a RGB value
Function GetG(RGB)
        Return RGB Shr 8 And %11111111       
End Function

; return Blue value out of a RGB value
Function GetB(RGB)       
        Return RGB And %11111111       
End Function

.sold
Data 0,0,0,0,0,0,0
Data 0,0,1,0,1,0,0
Data 0,0,0,0,0,0,0

Data 0,0,0,0,0,0,0
Data 0,0,1,0,1,0,0
Data 0,0,0,0,0,0,0

Data 0,0,0,0,0,0,0
Data 0,0,1,0,1,0,0
Data 0,0,0,0,0,0,0

Data 0,0,1,1,1,0,0
Data 1,0,1,1,1,0,1
Data 0,0,1,1,1,0,0

Data 0,0,1,1,1,0,0
Data 1,0,1,1,1,0,1
Data 0,0,1,1,1,0,0

Data 0,0,1,1,1,0,0
Data 1,1,1,1,1,1,1
Data 0,0,1,1,1,0,0

Data 0,0,0,0,0,0,0
Data 0,0,0,1,0,0,0
Data 0,0,0,0,0,0,0

Data 0,0,1,1,1,0,0
Data 0,0,1,1,1,0,0
Data 0,0,1,1,1,0,0

Data 0,0,1,1,1,0,0
Data 0,0,1,1,1,0,0
Data 0,0,1,1,1,0,0

Data 0,0,1,1,1,0,0
Data 0,0,1,1,1,0,0
Data 0,0,0,1,0,0,0


Часовой пояс GMT +4, время: 04:53.

vBulletin® Version 3.6.5.
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Перевод: zCarot