Demo - Asteroid V2

Everything related to 3D programming
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 285
Joined: Thu Jul 09, 2015 9:07 am

Demo - Asteroid V2

Post 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()
Last edited by pf shadoko on Wed Jun 23, 2021 12:10 pm, edited 5 times in total.
User avatar
Lord
Addict
Addict
Posts: 847
Joined: Tue May 26, 2009 2:11 pm

Re: Demo - Asteroid V2

Post by Lord »

Amazing!
Image
User avatar
DK_PETER
Addict
Addict
Posts: 898
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:

Re: Demo - Asteroid V2

Post 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)
Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Demo - Asteroid V2

Post 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
Egypt my love
IdeasVacuum
Always Here
Always Here
Posts: 6425
Joined: Fri Oct 23, 2009 2:33 am
Location: Wales, UK
Contact:

Re: Demo - Asteroid V2

Post by IdeasVacuum »

Very convincing scene. I ran it for five minutes, didn't notice any lag.
IdeasVacuum
If it sounds simple, you have not grasped the complexity.
User avatar
DK_PETER
Addict
Addict
Posts: 898
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:

Re: Demo - Asteroid V2

Post 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()
Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
User avatar
Psychophanta
Addict
Addict
Posts: 4975
Joined: Wed Jun 11, 2003 9:33 pm
Location: Lípetsk, Russian Federation
Contact:

Re: Demo - Asteroid V2

Post by Psychophanta »

Time for Asteroide V3 :wink:
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB :mrgreen:
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Demo - Asteroid V2

Post by davido »

@pf shadoko,
Another lovely demo. Thank you. :D
DE AA EB
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 285
Joined: Thu Jul 09, 2015 9:07 am

Re: Demo - Asteroid V2

Post 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
User avatar
Psychophanta
Addict
Addict
Posts: 4975
Joined: Wed Jun 11, 2003 9:33 pm
Location: Lípetsk, Russian Federation
Contact:

Re: Demo - Asteroid V2

Post 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
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB :mrgreen:
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 285
Joined: Thu Jul 09, 2015 9:07 am

Re: Demo - Asteroid V2

Post 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:
Fred
Administrator
Administrator
Posts: 16619
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:

Re: Demo - Asteroid V2

Post 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)
User avatar
skywalk
Addict
Addict
Posts: 3972
Joined: Wed Dec 23, 2009 10:14 pm
Location: Boston, MA

Re: Demo - Asteroid V2

Post by skywalk »

This will help a lot!
Can't wait for v6 beta 1 8)
The nice thing about standards is there are so many to choose from. ~ Andrew Tanenbaum
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Re: Demo - Asteroid V2

Post by dige »

Runs also fine with pb 6 C Backend. The initialisation time has been reduced from 51 seconds to 14 seconds! 😁
"Daddy, I'll run faster, then it is not so far..."
User avatar
StarBootics
Addict
Addict
Posts: 984
Joined: Sun Jul 07, 2013 11:35 am
Location: Canada

Re: Demo - Asteroid V2

Post 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)
The Stone Age did not end due to a shortage of stones !
Post Reply