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 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, время: 09:28.

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