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()