Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   www.boolean.name > Программирование игр для компьютеров > Blitz3D > 2D-программирование

2D-программирование Вопросы, касающиеся двумерного программирования

Ответ
 
Опции темы
Старый 26.05.2014, 21:44   #16
polopok
ПроЭктировщик
 
Регистрация: 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, 26.05.2014 в 22:54.
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
LLI.T.A.L.K.E.R. (26.05.2014)
Старый 27.05.2014, 01:23   #17
moka
.
 
Регистрация: 04.08.2006
Сообщений: 10,429
Написано 3,453 полезных сообщений
(для 6,859 пользователей)
Ответ: Voxel (octotree)

Ссылка на JS версию octree у тебя не та, ты скорее всего имел ввиду вот эту?
http://mrdoob.github.io/three.js/examples/#webgl_octree
(Offline)
 
Ответить с цитированием
Старый 29.05.2014, 05:00   #18
polopok
ПроЭктировщик
 
Регистрация: 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, 17:40   #19
polopok
ПроЭктировщик
 
Регистрация: 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)
 
Ответить с цитированием
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +1, время: 03:10.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com