|
2D-программирование Вопросы, касающиеся двумерного программирования |
27.05.2014, 01:44
|
#16
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
Давно хотел выложить приемлемый вариант динамического октодерева ,
но нужно ещё пахать и пахать
за одно ссылка на модуль *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
__________________
Мой проект здесь
Последний раз редактировалось polopok, 27.05.2014 в 02:54.
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
27.05.2014, 05:23
|
#17
|
.
Регистрация: 05.08.2006
Сообщений: 10,429
Написано 3,454 полезных сообщений (для 6,863 пользователей)
|
Ответ: Voxel (octotree)
Ссылка на JS версию octree у тебя не та, ты скорее всего имел ввиду вот эту?
http://mrdoob.github.io/three.js/examples/#webgl_octree
|
(Offline)
|
|
29.05.2014, 09:00
|
#18
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: Voxel (octotree)
Я тут подумал , если точки в вокселе нет ,то он удаляется ,но в динамике точки перемещаются , а потому могут сново попасть в удалённый узел ,значит нужно удалять только те воксели при премещении точек оказались пусты . Так что я ввёл дополнительный параметр ,как жизнь вокселя . Думаю понятней будет в коде ( добавленые/изменённые строки ,помечены так ;///
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
__________________
Мой проект здесь
|
(Offline)
|
|
20.08.2015, 20:40
|
#19
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: 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
__________________
Мой проект здесь
|
(Offline)
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 01:14.
|