PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Demo - Asteroid V2

https://www.purebasic.fr/english/viewtopic.php?t=72574

Page 1 of 2

Demo - Asteroid V2

Posted: Tue Apr 02, 2019 11:56 pm
by pf shadoko
Image

PB 5.73 Update (May 31, 2021)
(some of the comments below are no longer relevant)
remove the debugger


Hi,

for v2, we are immersed in an asteroid belt
there is a lot of progress, thanks to perlin and AddMeshManualLOD
the scene is a little dark, we can make it lighter (but with a less detailed texture) by commenting the line 263 (AddMaterialLayer)
the next version of PB will fix this problem
in the meantime, we just have to say to ourselves that it's the sun's fault that's not bright enough!
moreover for the small config, it may slow down at the processor level (here again, the next version should improve things a little)

note: I noticed a bug, if we move quickly, after a while, it starts to lag, I have to look at it...)

Code: Select all

; demo - Asteroide V2 - Pf Shadoko -2019

EnableExplicit

;{ ============================= biblio

Structure Vector2
	x.f
	y.f
EndStructure

Structure f3
	x.f
	y.f
	z.f
EndStructure

Structure PB_MeshVertexV  
	p.f3
	n.f3
	t.f3
	u.f
	v.f
	color.l
EndStructure

Macro vec3d(v,vx,vy,vz)
	v\x=vx
	v\y=vy
	v\z=vz
EndMacro

Procedure.f lng3D(*v.f3)
	ProcedureReturn Sqr(*V\x * *V\x + *V\y * *V\y + *V\z * *V\z)
EndProcedure

Procedure.f lng3D2(*v.f3)
	ProcedureReturn *V\x * *V\x + *V\y * *V\y + *V\z * *V\z
EndProcedure

Procedure Norme3D(*V.f3,l.f=1)
	Protected.f lm,ll=lng3d(*v):If ll=0:ProcedureReturn:EndIf
	lm = l / ll
	*V\x * lm
	*V\y * lm
	*V\z * lm  
EndProcedure

Macro sub3D(p,p1,p2)
	p\x=p1\x-p2\x
	p\y=p1\y-p2\y
	p\z=p1\z-p2\z
EndMacro

Macro add3d(p,p1,p2)
	p\x=p1\x+p2\x
	p\y=p1\y+p2\y
	p\z=p1\z+p2\z
EndMacro

Macro div3d(p1,v)
	p1\x/(v)
	p1\y/(v)
	p1\z/(v)
EndMacro

Macro mul3d(p1,v)
	p1\x*(v)
	p1\y*(v)
	p1\z*(v)
EndMacro

Procedure Pvectoriel3d(*r.f3,*p.f3,*q.f3)
	*r\x=*p\y * *q\z - *p\z * *q\y 
	*r\y=*p\z * *q\x - *p\x * *q\z 
	*r\z=*p\x * *q\y - *p\y * *q\x 
EndProcedure

Procedure.f POM(v.f)
	ProcedureReturn (Random(v*1000)-v*500)/500
EndProcedure

;}
Procedure NormalizeMesh2(mesh)
	#eps=0.0001
	Protected nv,ni,i,j,sm,f0,f1,f2
	Protected.f3 ps,v1,v2,ecart
	
	For sm=0 To SubMeshCount(mesh)-1
		nv=MeshVertexCount(mesh,sm)-1
		ni=MeshIndexCount(mesh,sm)-1
		Dim v.PB_MeshVertexv(nv)
		Dim f.PB_MeshFace(ni)
		Dim eq.l(nv)
		GetMeshData(mesh,sm,v(),#PB_Mesh_Vertex,0,nv)  
		GetMeshData(mesh,sm,f(),#PB_Mesh_Face,0,ni) 
		; ------------------ recherche doublon
		For i=0 To nv:eq(i)=-1:Next
		For i=0 To nv
			If eq(i)<0
				eq(i)=i
				For j=i+1 To nv
					sub3d(ecart,v(i)\p,v(j)\p)
					If lng3D2(ecart)<#eps:eq(j)=i:EndIf
				Next
			EndIf
		Next
		; ------------------ calcul normal
		For i=0 To ni Step 3
			f0=eq(f(i  )\Index)
			f1=eq(f(i+1)\Index)
			f2=eq(f(i+2)\Index)
			sub3d(v1,v(f1)\p,v(f0)\p)
			sub3d(v2,v(f2)\p,v(f0)\p)
			Pvectoriel3d(ps,v1,v2)
			add3d(v(f0)\n,v(f0)\n,ps)
			add3d(v(f1)\n,v(f1)\n,ps)
			add3d(v(f2)\n,v(f2)\n,ps)
		Next
		For i=0 To nv:Norme3D(v(i)\n,1):Next
		For i=0 To nv:If eq(i)<>i:v(i)=v(eq(i)):EndIf:Next  
		SetMeshData(mesh,sm,v(),#PB_Mesh_Normal,0,nv)
	Next
EndProcedure

;################################################################# Perlin Noise ###############################################################

Procedure InitPerlinNoise(seed=0,  fq1.f=1,amp1.f=0.5,  fq2.f=0,amp2.f=0,  fq3.f=0,amp3.f=0,  fq4.f=0,amp4.f=0,  fq5.f=0,amp5.f=0)
	#per_Size = 1023
	Global Dim per_grad.f3(#per_Size)
	Global Dim per_fq.f(9)
	Global Dim per_am.f(9)
	Global per_nb=0,per_dim
	Protected i
	
	If fq1>0:per_fq(1)=fq1:per_am(1)=amp1/fq1:per_nb=1:EndIf
	If fq2>0:per_fq(2)=fq2:per_am(2)=amp2/fq2:per_nb=2:EndIf
	If fq3>0:per_fq(3)=fq3:per_am(3)=amp3/fq3:per_nb=3:EndIf
	If fq4>0:per_fq(4)=fq4:per_am(4)=amp4/fq4:per_nb=4:EndIf 
	If fq5>0:per_fq(5)=fq4:per_am(5)=amp5/fq5:per_nb=5:EndIf 
	RandomSeed(Seed)
	For i = 0 To #per_Size
		vec3d(per_grad(i),pom(1),pom(1),pom(1)):norme3d(per_grad(i))  
	Next
EndProcedure

Procedure.f per_gr(X.i, Y.i, Z.i, *V.f3)      
	Protected Index.i= (x+y * 101+z * 241+ per_dim * 409)&#per_Size
	ProcedureReturn per_grad(Index)\X * (*V\X-X) + per_grad(Index)\Y * (*V\Y-Y) + per_grad(Index)\Z * (*V\Z-Z)
EndProcedure

Procedure.f PerlinValue(*p.f3,fq.f)      
	Protected.i X0, X1, Y0, Y1, Z0, Z1
	Protected.f WX0, WY0, WZ0, WX1, WY1, WZ1
	Protected p.f3
	
	vec3d(p,*p\x*fq,*p\y*fq,*p\z*fq)
	X0 = Int(p\X+$40000000)-$40000000:X1 = X0+1
	Y0 = Int(p\Y+$40000000)-$40000000:Y1 = Y0+1
	Z0 = Int(p\Z+$40000000)-$40000000:Z1 = Z0+1
	WX0 = X0-p\X:wx0=(2* wx0+3)* wx0 * wx0 :wx1=1-wx0
	WY0 = Y0-p\Y:wy0=(2* wy0+3)* wy0 * wy0 :wy1=1-wy0
	WZ0 = Z0-p\Z:wz0=(2* wz0+3)* wz0 * wz0 :wz1=1-wz0  
	ProcedureReturn ( (per_gr(X0, Y0, Z0, p)*WX1+per_gr(X1, Y0, Z0, p)*WX0)*wy1 +
	                  (per_gr(X0, Y1, Z0, p)*WX1+per_gr(X1, Y1, Z0, p)*WX0)*WY0 ) * wz1 +
( (per_gr(X0, Y0, Z1, p)*WX1+per_gr(X1, Y0, Z1, p)*WX0)*wy1 +
  (per_gr(X0, Y1, Z1, p)*WX1+per_gr(X1, Y1, Z1, p)*WX0)*WY0 ) * WZ0
EndProcedure

Procedure.f PerlinNoise(*p.f3,_dimension=0)
	Protected i, Noise.f
	per_dim=_dimension 
	For i = 1 To per_nb:Noise + PerlinValue(*p,per_fq(i)) * per_am(i):Next
	ProcedureReturn Noise     
EndProcedure

Procedure.f PerlinNoise3D(*p.f3,*r.f3, mode=0)  ; mode -> #PB_Absolute: return the new position,  #PB_Relative: retrun the offset
	*r\x=PerlinNoise(*p.f3,0)  
	*r\y=PerlinNoise(*p.f3,1)  
	*r\z=PerlinNoise(*p.f3,2)  
	If mode=#PB_Absolute:add3d(*r,*p,*r):EndIf 
EndProcedure

Procedure PerlinNoiseMesh(mesh,radial.f=0) ; radial -> only for spherical mesh
	Protected i,j,l.f,pn.f, p.f3, nv
	For j=0 To SubMeshCount(mesh)-1
		nv=MeshVertexCount(mesh,j)-1
		Dim v.PB_MeshVertexv(nv)
		GetMeshData(mesh,j,v(),#PB_Mesh_Vertex,0,nv)  
		If radial:For i=0 To nv:p=v(i)\p:l=lng3d(p):pn=PerlinNoise(p)*radial:norme3d(v(i)\p,l+pn):Next
			Else:     For i=0 To nv:p=v(i)\p:PerlinNoise3d(p,v(i)\p,#PB_Absolute):Next
		EndIf  
		SetMeshData(mesh,j,v(),#PB_Mesh_Vertex,0,nv)
	Next
	NormalizeMesh2(mesh)
EndProcedure

;######################################################################################################

#NbMesh=8  ; asteroids
#size=16
#spacing=128
#anb=64:#anb1=#anb-1        ;Array size of asteroid, must be a power of 2

Structure sAst:mesh.b:rot.f3:pos.f3:scale.f3:EndStructure
Global  Dim ast.sast(#anb1,#anb1)
Global ti.f=ElapsedMilliseconds()

Procedure createsphereCube(mesh,rayon.f,d)
	Protected i,j,k,kk,    d2=d/2
	Protected.f vi,vj
	
	Dim t.PB_MeshVertexv(d,d)
	CreateMesh(mesh)
	For kk=0 To 2
		For k=-1 To 1 Step 2
			For j=0 To d
				For i=0 To d
					vi=Tan((i/d2-1)*#PI/4)
					vj=Tan((j/d2-1)*#PI/4)*k    
					With t(i,j)
						Select kk
							Case 0:vec3d(\p,vi,k,vj)
							Case 1:vec3d(\p,-k,vi,vj)
							Case 2:vec3d(\p,vi,vj,-k)
						EndSelect
						norme3d(\p,rayon)
						\u=i/d
						\v=j/d
					EndWith
				Next
			Next  
			CreateDataMesh(-2,t())
		Next
	Next
	FinishMesh(1)
EndProcedure

Procedure menu()
	Protected p=4
	Macro DT(t1):DrawText(8,p,t1):p+18:EndMacro
	CreateSprite(0,180,120,#PB_Sprite_AlphaBlending)
	StartDrawing(SpriteOutput(0))
	DrawingMode(#PB_2DDrawing_AllChannels)
	DrawingFont(FontID(0))
	Box(0,0,180,120,$22ffffff)
	DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Outlined)
	Box(0,0,180,120,$44ffffff)
	BackColor($22ffffff)
	FrontColor($ffffffff)
	dt("Moving :")
	dt("Arrow keys + Mouse")
	dt("")
	dt("Controls :")
	dt("[F12] Wireframe")
	dt("[Esc] / [Click] Quit")
	DrawText(80,2,"init time: " +Str(ElapsedMilliseconds()-ti),$ff0000ff)
	StopDrawing()
EndProcedure

Procedure init() 
	Protected i,j,k,l,c,x,y,n,g.f,r.f,a.f,meshp,mesh,lod,d,d2,loddist,lum,cpt
	
	InitEngine3D():InitSprite():InitKeyboard():InitMouse()
	
	ExamineDesktops():OpenScreen(DesktopWidth(0),DesktopHeight(0),32,"Asteroide V2")
	
	LoadFont(0,"arial",10)
	
	Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures",#PB_3DArchive_FileSystem)
	Parse3DScripts()
	
	CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,0,1,-4):CameraLookAt(0,10,0,100)
	CreateLight(0,$ffffff, 70000, 0, 0):SetLightColor(0,#PB_Light_SpecularColor,$ffffff)
	AmbientColor($222222)
	
	;-------------------------------------------- stars
	createsphereCube(0,80000,4)
	CreateTexture(0,1024,1024):StartDrawing(TextureOutput(0))
	For i=0 To 5000:lum=Pow(Random(255)/255,2)*255:Plot(Random(1023),Random(1023),$010101*lum):Next
	For i=0 To 500
		l=Random(4)+1:x=Random(1023-l*2)+l:y=Random(1023-l*2)+l
		For j=0 To l
			c=(l-j)*255/l:c=RGB(c,c,c)
			Plot(x+j,y,c)
			Plot(x-j,y,c)
			Plot(x,y+j,c)
			Plot(x,y-j,c)
		Next
	Next
	StopDrawing()
	CreateMaterial(0,TextureID(0))
	MaterialCullingMode(0,#PB_Material_NoCulling)
	SetMaterialColor(0,#PB_Material_SelfIlluminationColor,$ffffff)
	CreateEntity(0,MeshID(0),MaterialID(0))
	
	;-------------------------------------------- sun
	CreateTexture(1,512,512):StartDrawing(TextureOutput(1))
	DrawingMode(#PB_2DDrawing_AlphaBlend)
	For i=0 To 20000:a=pom(#PI):r=Pow(Random(1000)/1000,10)*256:LineXY(256,256,256+Cos(a)*r,256+Sin(a)*r,$08ffffff):Next:StopDrawing()
	CreateMaterial(1,TextureID(1))
	MaterialBlendingMode(1,#PB_Material_AlphaBlend)
	SetMaterialColor(1,#PB_Material_SelfIlluminationColor,$ffffff)
	CreateBillboardGroup(0,MaterialID(1),32000,32000):AddBillboard(0,70000,0,0)
	
	;-------------------------------------------- planete
	LoadTexture(3,"clouds.jpg")
	CreateMaterial(3, TextureID(3))
	SetMaterialColor(3,#PB_Material_AmbientColor,0)
	CreateSphere(3,1,64*4,64*2)
	InitPerlinNoise(0,4,10)
	n=MeshVertexCount(3)-1
	Dim v.PB_MeshVertexv(n)
	GetMeshData(3,0,v(),#PB_Mesh_Vertex|#PB_Mesh_UVCoordinate,0,n)  
	For i=0 To n:v(i)\u=PerlinNoise(v(i)\p):v(i)\v*8:Next
	SetMeshData(3,0,v(),#PB_Mesh_UVCoordinate,0,n)
	CreateEntity(3,MeshID(3),MaterialID(3),0,0,40000)
	ScaleEntity(3,16000,16000,16000)
	
	;-------------------------------------------- asteroids
	LoadTexture(10,"Dirt.jpg")
	CreateMaterial(10,TextureID(10))
	SetMaterialColor(10,#PB_Material_SpecularColor,$888888):MaterialShininess(10,32)
	ScaleMaterial(10,1/1,1/1)
	DisableDebugger
	AddMaterialLayer(10,TextureID(10),8):ScaleMaterial(10,1/4,1/4,1) 
	EnableDebugger
	
	For i=1 To #NbMesh
		InitPerlinNoise(i,1,0.5,  4,0.5,  16,0.5)
		d=32
		loddist=512*2
		meshp=i*10
		For lod=0 To 4
			mesh=meshp+lod
			createsphereCube(mesh,1,d)
			PerlinNoiseMesh(mesh,2)
			SetMeshMaterial(mesh,MaterialID(10))
			If lod:AddMeshManualLOD(meshp,mesh,loddist):loddist*2:EndIf
			d/2
		Next   
	Next
	
	For j=0 To #anb1:For i=0 To #anb1
			With ast(i,j)
				\mesh=Random(#NbMesh,1)*10
				g=(1+pom(0.5))*#size
				r=Pow(pom(1),3)*2
				vec3d(\rot,pom(1)*r,pom(1)*r,pom(1)*r)
				vec3d(\pos,pom(#spacing*0.3),pom(200),pom(#spacing*0.3))
				vec3d(\scale,g,g*(1+pom(0.5)),g*(1+pom(0.5)))
				
				n=j*#anb+i
				CreateEntity(100+n,MeshID(\mesh),MaterialID(10))
				ScaleEntity(100+n,\scale\x,\scale\y,\scale\z)
				RotateEntity(100+n,pom(180),pom(180),pom(180))    ; initial rotation 			
			EndWith
	Next:Next
	
	menu()
EndProcedure

Procedure renderAsteroids()
	Protected i,j,  n,pi,pj
	
	pi=(CameraX(0)/#spacing-#anb/2)
	pj=(CameraZ(0)/#spacing-#anb/2)
	For j=pj To pj+#anb1:For i=pi To pi+#anb1
			With ast(i & #anb1,j & #anb1)
				n=(j & #anb1)*#anb+(i & #anb1)
				MoveEntity(100+n,i*#spacing+\pos\x,\pos\y,j*#spacing+\pos\z,#PB_Absolute)
				RotateEntity(100+n,\rot\x,\rot\y,\rot\z,#PB_Relative)   ; <- bug, it causes a lag after a while !!!
			EndWith
	Next:Next 
EndProcedure

Procedure rendu()
	Protected.f keyx,keyz,MouseX,Mousey,fdf.l
	
	Repeat
		ExamineMouse()
		ExamineKeyboard()
		If KeyboardReleased(#PB_Key_F12):fdf=1-fdf:If fdf:CameraRenderMode(0,#PB_Camera_Wireframe):Else:CameraRenderMode(0,#PB_Camera_Textured):EndIf:EndIf
		MouseX = -MouseDeltaX() *  0.05
		MouseY = -MouseDeltaY() *  0.05
		keyx=(-Bool(KeyboardPushed(#PB_Key_Left)<>0)+Bool(KeyboardPushed(#PB_Key_Right)<>0))*1
		keyz+(-Bool(KeyboardPushed(#PB_Key_Down)<>0)+Bool(KeyboardPushed(#PB_Key_Up)<>0))*0.02+MouseWheel()*0.2
		RotateCamera(0, MouseY, MouseX, 0, #PB_Relative):MoveCamera(0, keyx, 0, -keyz,#PB_Local )
		
		renderAsteroids()    
		RenderWorld()
		DisplayTransparentSprite(0,8,8)
		FlipBuffers()    
	Until KeyboardReleased(#PB_Key_Escape) Or MouseButton(1)
EndProcedure

init()
rendu()

Re: Demo - Asteroid V2

Posted: Wed Apr 03, 2019 6:54 am
by Lord
Amazing!

Re: Demo - Asteroid V2

Posted: Wed Apr 03, 2019 5:10 pm
by DK_PETER
You're right..Keeping it running does create some lag.
It's a really good example, though.
Thanks for sharing. Your work is appreciated as always. 8)

Re: Demo - Asteroid V2

Posted: Wed Apr 03, 2019 8:03 pm
by RASHAD
Hi
pf shadoko,DK_PETER,applePi & Fig
I like very much your work gentlemen
It makes me happy and much confident in PB

Re: Demo - Asteroid V2

Posted: Thu Apr 04, 2019 1:30 am
by IdeasVacuum
Very convincing scene. I ran it for five minutes, didn't notice any lag.

Re: Demo - Asteroid V2

Posted: Sat Apr 06, 2019 7:51 pm
by DK_PETER
Added some extra to pf shadoko's very nice example. (I mauled the example a bit). :)

Code: Select all

; demo - Asteroide V2 - Pf Shadoko -2019

EnableExplicit

;{ ============================= biblio

Structure Vector2
  x.f
  y.f
EndStructure

Structure Vector3
  x.f
  y.f
  z.f
EndStructure

Structure PB_MeshVertexV  
  p.vector3
  n.vector3
  t.vector3
  u.f
  v.f
  color.l
EndStructure

Macro vec3d(v,vx,vy,vz)
  v\x=vx
  v\y=vy
  v\z=vz
EndMacro

Procedure.f lng3D(*v.Vector3)
  ProcedureReturn Sqr(*V\x * *V\x + *V\y * *V\y + *V\z * *V\z)
EndProcedure

Procedure Norme3D(*V.Vector3,l.f=1)
  Protected.f lm
  lm = l / lng3d(*v)
  *V\x * lm
  *V\y * lm
  *V\z * lm  
EndProcedure

Macro sub3D(p,p1,p2)
  p\x=p1\x-p2\x
  p\y=p1\y-p2\y
  p\z=p1\z-p2\z
EndMacro

Macro add3d(p,p1,p2)
  p\x=p1\x+p2\x
  p\y=p1\y+p2\y
  p\z=p1\z+p2\z
EndMacro

Macro div3d(p1,v)
  p1\x/(v)
  p1\y/(v)
  p1\z/(v)
EndMacro

Macro mul3d(p1,v)
  p1\x*(v)
  p1\y*(v)
  p1\z*(v)
EndMacro

Procedure.f POM(v.f)
  ProcedureReturn (Random(v*1000)-v*500)/500
EndProcedure

;}

;################################################################# Perlin Noise ###############################################################

Procedure InitPerlinNoise(seed=0,  fq1.f=1,amp1.f=0.5,  fq2.f=0,amp2.f=0,  fq3.f=0,amp3.f=0,  fq4.f=0,amp4.f=0,  fq5.f=0,amp5.f=0)
  #per_Size = 1023
  Global Dim per_grad.Vector3(#per_Size)
  Global Dim per_fq.f(9)
  Global Dim per_am.f(9)
  Global per_nb=0,per_dim
  Protected i
  
  If fq1>0:per_fq(1)=fq1:per_am(1)=amp1/fq1:per_nb=1:EndIf
  If fq2>0:per_fq(2)=fq2:per_am(2)=amp2/fq2:per_nb=2:EndIf
  If fq3>0:per_fq(3)=fq3:per_am(3)=amp3/fq3:per_nb=3:EndIf
  If fq4>0:per_fq(4)=fq4:per_am(4)=amp4/fq4:per_nb=4:EndIf 
  If fq5>0:per_fq(5)=fq4:per_am(5)=amp5/fq5:per_nb=5:EndIf 
  RandomSeed(Seed)
  For i = 0 To #per_Size
    vec3d(per_grad(i),pom(1),pom(1),pom(1)):norme3d(per_grad(i))  
  Next
EndProcedure

Procedure.f per_gr(X.i, Y.i, Z.i, *V.Vector3)      
  Protected Index.i= (x+y * 101+z * 241+ per_dim * 409)&#per_Size
  ProcedureReturn per_grad(Index)\X * (*V\X-X) + per_grad(Index)\Y * (*V\Y-Y) + per_grad(Index)\Z * (*V\Z-Z)
EndProcedure

Procedure.f PerlinValue(*p.vector3,fq.f)      
  Protected.i X0, X1, Y0, Y1, Z0, Z1
  Protected.f WX0, WY0, WZ0, WX1, WY1, WZ1
  Protected p.vector3
  
  vec3d(p,*p\x*fq,*p\y*fq,*p\z*fq)
  X0 = Int(p\X+$40000000)-$40000000:X1 = X0+1
  Y0 = Int(p\Y+$40000000)-$40000000:Y1 = Y0+1
  Z0 = Int(p\Z+$40000000)-$40000000:Z1 = Z0+1
  WX0 = X0-p\X:wx0=(2* wx0+3)* wx0 * wx0 :wx1=1-wx0
  WY0 = Y0-p\Y:wy0=(2* wy0+3)* wy0 * wy0 :wy1=1-wy0
  WZ0 = Z0-p\Z:wz0=(2* wz0+3)* wz0 * wz0 :wz1=1-wz0  
  ProcedureReturn ( (per_gr(X0, Y0, Z0, p)*WX1+per_gr(X1, Y0, Z0, p)*WX0)*wy1 +
                    (per_gr(X0, Y1, Z0, p)*WX1+per_gr(X1, Y1, Z0, p)*WX0)*WY0 ) * wz1 +
                  ( (per_gr(X0, Y0, Z1, p)*WX1+per_gr(X1, Y0, Z1, p)*WX0)*wy1 +
                    (per_gr(X0, Y1, Z1, p)*WX1+per_gr(X1, Y1, Z1, p)*WX0)*WY0 ) * WZ0
EndProcedure

Procedure.f PerlinNoise(*p.vector3,_dimension=0)
  Protected i, Noise.f
  per_dim=_dimension 
  For i = 1 To per_nb:Noise + PerlinValue(*p,per_fq(i)) * per_am(i):Next
  ProcedureReturn Noise     
EndProcedure

Procedure.f PerlinNoise3D(*p.vector3,*r.vector3, mode=0)  ; mode -> #PB_Absolute: return the new position,  #PB_Relative: retrun the offset
  *r\x=PerlinNoise(*p.vector3,0)  
  *r\y=PerlinNoise(*p.vector3,1)  
  *r\z=PerlinNoise(*p.vector3,2)  
  If mode=#PB_Absolute:add3d(*r,*p,*r):EndIf 
EndProcedure

Procedure PerlinNoiseMesh(mesh,radial.f=0) ; radial -> only for spherical mesh
  Protected i,j,l.f,pn.f, p.vector3, nv
  For j=0 To SubMeshCount(mesh)-1
    nv=MeshVertexCount(mesh,j)-1
    Dim v.PB_MeshVertexv(nv)
    GetMeshData(mesh,j,v(),#PB_Mesh_Vertex,0,nv)  
    If radial:For i=0 To nv:p=v(i)\p:l=lng3d(p):pn=PerlinNoise(p)*radial:norme3d(v(i)\p,l+pn):Next
    Else:     For i=0 To nv:p=v(i)\p:PerlinNoise3d(p,v(i)\p,#PB_Absolute):Next
    EndIf  
    SetMeshData(mesh,j,v(),#PB_Mesh_Vertex,0,nv)
  Next
  NormalizeMesh(mesh)
EndProcedure

;######################################################################################################

#NbMesh=4   ; asteroids
#size=12
#spacing=64

#Adp=32:#Adp1=#Adp-1        ; asteroid display (64*64), must be a power of 2
#tdn=64:#Ainf1=#tdn-1      ; array size of asteroid info, must be a power of 2

;Negative and positive extremes allowed 
Procedure.f RandomF(Min.f, Max.f, Res.i = 100000)
  If res = 0 : res = 1 : EndIf
  ProcedureReturn (Min + (Max - Min) * Random(Res,1) / Res)
EndProcedure

Structure sAst:mesh.b:rot.vector3:pos.vector3:scale.vector3:EndStructure
Global  Dim ast.sast(#Ainf1,#Ainf1)
Global ev.i, no.i, First.i = #False


Procedure createsphereCube(mesh,rayon.f,d)
  Protected i,j,k,kk,    d2=d/2
  Protected.f vi,vj
  
  Dim t.PB_MeshVertexv(d,d)
    CreateMesh(mesh)
    For kk=0 To 2
      For k=-1 To 1 Step 2
        AddSubMesh()
        For j=0 To d
          For i=0 To d
            vi=Tan((i/d2-1)*#PI/4)
            vj=Tan((j/d2-1)*#PI/4)*k    
            With t(i,j)
              Select kk
                Case 0:vec3d(\p,vi,k,vj)
                Case 1:vec3d(\p,-k,vi,vj)
                Case 2:vec3d(\p,vi,vj,-k)
              EndSelect
              norme3d(\p,rayon)
              \u=i/d
              \v=j/d
            EndWith
          Next
        Next  
        CreateDataMesh(-2,t())
      Next
    Next
    FinishMesh(1)
EndProcedure

Procedure menu()
  Protected p=4
  Macro DT(t1):DrawText(8,p,t1):p+18:EndMacro
  If IsSprite(0) = 0
    CreateSprite(0,180,150,#PB_Sprite_AlphaBlending)
  EndIf
  StartDrawing(SpriteOutput(0))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0, 0, 180, 150, $FF000000)
  DrawingFont(FontID(0))
  Box(0,0,180,280,$22ffffff)
  DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Outlined)
  Box(0,0,180,120,$44ffffff)
  BackColor($22ffffff)
  FrontColor($ffffffff)
  dt("Moving :")
  dt("Arrow keys + Mouse")
  dt("")
  dt("Controls :")
  dt("[F12] Wireframe")
  dt("[Esc] / [Click] Quit")
  dt("Fps: " + Str(Engine3DStatus(#PB_Engine3D_CurrentFPS)))
  StopDrawing()
  TransparentSpriteColor(0, $FF000000)
EndProcedure

Procedure init() 
  Protected i,j,k,n,g.f,r.f,a.f,meshp,mesh,lod,d,d2,loddist,lum
  
  InitEngine3D():InitSprite():InitKeyboard():InitMouse()
  
  ExamineDesktops()
  ;:OpenScreen(DesktopWidth(0),DesktopHeight(0),32,"Asteroide V2")
  OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0),"Asteroide V2", #PB_Window_BorderLess)
  OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0), WindowHeight(0))
  LoadFont(0,"arial",10)

  Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures",#PB_3DArchive_FileSystem)
  Parse3DScripts()
  
  WorldGravity(0.0)
  no = CreateNode(#PB_Any, 0, 0, 0)
  CreateCamera(0, 0, 0, 100, 100)
  CreateLight(10, $FFFFFF, 0, 0, 0, #PB_Light_Directional)
  LightDirection(10, 0, 0, -1) ;Forgot this one. :-)
  AttachNodeObject(no, CameraID(0))
  AttachNodeObject(no, LightID(10))
  
  CreateLight(0,$ffffff, 70000, 0, 0):SetLightColor(0,#PB_Light_SpecularColor,$ffffff)
  AmbientColor($444444)
    
  ;-------------------------------------------- stars
  createsphereCube(0,80000,4)
  CreateTexture(0,1024,1024):StartDrawing(TextureOutput(0))
  For i=0 To 5000:lum=Pow(Random(255)/255,2)*255:Plot(Random(1023),Random(1023),$010101*lum):Next :StopDrawing()
  CreateMaterial(0,TextureID(0))
  MaterialCullingMode(0,#PB_Material_NoCulling)
  SetMaterialColor(0,#PB_Material_SelfIlluminationColor,$ffffff)
  CreateEntity(0,MeshID(0),MaterialID(0))
  
  ;-------------------------------------------- sun
  CreateTexture(1,512,512):StartDrawing(TextureOutput(1))
  DrawingMode(#PB_2DDrawing_Gradient)
  BackColor($FFFFFF) : FrontColor($0)
  GradientColor(0.6, $0)
  CircularGradient(256, 256, 200)
  Circle(256, 256, 200)
  StopDrawing()
  CreateMaterial(1,TextureID(1))
  MaterialBlendingMode(1, #PB_Material_Add)
  AddMaterialLayer(1, TextureID(1), #PB_Material_Add)
  SetMaterialColor(1,#PB_Material_SelfIlluminationColor,$ffffff)
  MaterialFilteringMode(1, #PB_Material_Anisotropic, 8)
  CreateBillboardGroup(0,MaterialID(1),32000,32000)
  AddBillboard(0,70000,0,0)
  
  ;-------------------------------------------- planete
  LoadTexture(3,"terrain_texture.jpg")
  CreateMaterial(3, TextureID(3))
  ScaleMaterial(3, 0.5, 0.5)
  ScrollMaterial(3, 0.01, 0, #PB_Material_Animated)
  CreateSphere(3, 1, 24,24)
  CreateEntity(3,MeshID(3),MaterialID(3),0,0,40000)
  ScaleEntity(3, 6000, 6000, 6000)
  
  CreateTexture(22, 512, 512, "Halo")
  StartDrawing(TextureOutput(22))
  DrawingMode(#PB_2DDrawing_Gradient)
  FrontColor($FF000000)
  GradientColor(0.8, $D1006F97)
  CircularGradient(256, 256, 200)
  Circle(256, 256, 200)
  StopDrawing()
  CreateMaterial(22, TextureID(22))
  MaterialBlendingMode(22, #PB_Material_Add)
  CreateBillboardGroup(22, MaterialID(22), 20000, 20000, 0, 0, 40000)
  AddBillboard(22, 0, 0, 0)
  ;-------------------------------------------- asteroids
  LoadTexture(10,"Dirt.jpg")
  CreateMaterial(10,TextureID(10))
  SetMaterialColor(10,#PB_Material_SpecularColor,$222222):MaterialShininess(10,20)
  ScaleMaterial(10,1/1,1/1)
  AddMaterialLayer(10,TextureID(10),#PB_Material_Modulate):ScaleMaterial(10,1/4,1/4,1)  ; comment this line for more brightness
  
  For i=1 To #NbMesh
    InitPerlinNoise(i,0.5,0.3,  2,0.4,  10,0.5)
    d=32
    loddist=256
    meshp=i*10
    For lod=0 To 4
      mesh=meshp+lod
      createsphereCube(mesh,1,d)
      PerlinNoiseMesh(mesh,2)
      SetMeshMaterial(mesh,MaterialID(10))
      If lod:AddMeshManualLOD(meshp,mesh,loddist):loddist*2:EndIf
      d/2
    Next   
  Next
  
  For j=0 To #Ainf1:For i=0 To #Ainf1
      With ast(i,j)
        \mesh=Random(#NbMesh,1)*10
        g=(1+pom(0.5))*#size
        r=Pow(pom(1),3):If r<0.1:r=0:EndIf
        vec3d(\rot,pom(1)*r,pom(1)*r,pom(1)*r)
        vec3d(\pos,pom(#spacing*0.3),pom(100),pom(#spacing*0.3))
        vec3d(\scale,g,g*(1+pom(0.5)),g*(1+pom(0.5)))
      EndWith
    Next:Next
  menu()
EndProcedure

Procedure renderentityarray()
  Static api,pi=1000,  apj,pj=1000,  i0,i1,  j0,j1
  Protected i, j, n
  
  api=pi:pi=(CameraX(0)/#spacing-#Adp/2):If pi<api:i0=pi:i1=api-1:Else:i0=api+1+#Adp1:i1=pi+#Adp1:EndIf
  apj=pj:pj=(CameraZ(0)/#spacing-#Adp/2):If pj<apj:j0=pj:j1=apj-1:Else:j0=apj+1+#Adp1:j1=pj+#Adp1:EndIf
  For j=pj To pj+#Adp1:For i=pi To pi+#Adp1
      If (i>=i0 And i<=i1) Or (j>=j0 And j<=j1) 
        With ast(i & #Ainf1,j & #Ainf1)
          n=(j & #Adp1)*#Adp+(i & #Adp1)
          CreateEntity(100+n,MeshID(\mesh),MaterialID(10),i*#spacing+\pos\x,\pos\y,j*#spacing+\pos\z)
          CreateEntityBody(100+n, #PB_Entity_BoxBody, 0.00001)
          ScaleEntity(100+n,\scale\x,\scale\y,\scale\z)
          ApplyEntityImpulse(100+n, RandomF(-0.00005, 0.00005), RandomF(-0.00005, 0.00005), RandomF(-0.00005, 0.00005))
        EndWith
      EndIf
  Next:Next 
  first = #True
EndProcedure

Procedure rendu()
  Protected.f keyx,keyz,MouseX,Mousey,fdf.l
  Repeat
    Repeat : ev = WindowEvent() : Until ev = 0
    ExamineMouse()
    ExamineKeyboard()
    If KeyboardReleased(#PB_Key_F12):fdf=1-fdf:If fdf:CameraRenderMode(0,#PB_Camera_Wireframe):Else:CameraRenderMode(0,#PB_Camera_Textured):EndIf:EndIf
    MouseX = -MouseDeltaX() *  0.05
    MouseY = -MouseDeltaY() *  0.05
    keyx=(-Bool(KeyboardPushed(#PB_Key_Left)<>0)+Bool(KeyboardPushed(#PB_Key_Right)<>0))*1
    keyz+(-Bool(KeyboardPushed(#PB_Key_Down)<>0)+Bool(KeyboardPushed(#PB_Key_Up)<>0))*0.02+MouseWheel()*0.2
    RotateNode(no, MouseY, MouseX, 0, #PB_Relative)
    MoveNode(no, keyx, 0, -keyz,#PB_Local)
    renderentityarray() 
    RenderWorld()
    menu()
    DisplayTransparentSprite(0,8,8)
    FlipBuffers()    
  Until KeyboardReleased(#PB_Key_Escape) Or MouseButton(1)
EndProcedure

init()
rendu()

Re: Demo - Asteroid V2

Posted: Sun May 30, 2021 12:52 pm
by Psychophanta
Time for Asteroide V3 :wink:

Re: Demo - Asteroid V2

Posted: Sun May 30, 2021 6:59 pm
by davido
@pf shadoko,
Another lovely demo. Thank you. :D

Re: Demo - Asteroid V2

Posted: Mon May 31, 2021 9:19 pm
by pf shadoko
um ! it's not really new (2019)

I've updated the code for 5.73 (plus some small changes), but it's not a v3...
go to the first post

Re: Demo - Asteroid V2

Posted: Tue Jun 01, 2021 8:42 pm
by Psychophanta
pf shadoko wrote: ↑Mon May 31, 2021 9:19 pm um ! it's not really new (2019)

I've updated the code for 5.73 (plus some small changes), but it's not a v3...
go to the first post
:D

Re: Demo - Asteroid V2

Posted: Wed Jun 23, 2021 12:27 pm
by pf shadoko
this demo requiring big calculation (perlin noise)
I tested with v6 to see the initialization time (displayed in red)
(disable the debugger)

on my machine
asm : 3850 ms
c : 3800
c + opt : 1260 ms

i.e. a speed x 3 at least !!!
:shock:

Re: Demo - Asteroid V2

Posted: Wed Jun 23, 2021 5:06 pm
by Fred
Yes, on heavy calcs, such differences can occurs, especially when float numbers are involved, as C optimizer will use XMM registers for floats instead of old x86 FPU (which is used by the ASM backend)

Re: Demo - Asteroid V2

Posted: Wed Jun 23, 2021 6:10 pm
by skywalk
This will help a lot!
Can't wait for v6 beta 1 8)

Re: Demo - Asteroid V2

Posted: Thu Jun 24, 2021 7:59 am
by dige
Runs also fine with pb 6 C Backend. The initialisation time has been reduced from 51 seconds to 14 seconds! 😁

Re: Demo - Asteroid V2

Posted: Thu Jun 24, 2021 8:51 am
by StarBootics
skywalk wrote: ↑Wed Jun 23, 2021 6:10 pm This will help a lot!
Can't wait for v6 beta 1 8)
Can't wait for the Linux version. 8)
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited