Demo - Asteroide V2
Publié : mar. 02/avr./2019 23:36
Salut,
pour la v2, on est plongé dans une ceinture d’astéroïde
y'a pas mal de progrès, grâce à perlin et AddMeshManualLOD
la scene est un peu sombre, on peut la rendre plus claire (mais avec une texture moins détaillée) en commentant la ligne 263 (AddMaterialLayer)
la prochaine version de PB permettra de remédier à ce probleme
en attendant on a qu'à se dire que c'est la faute au soleil qui est pas assez brillant !
de plus pour les petites config, ça risque de ramer au niveau du processeur (là aussi, la prochaine version devrai améliorer un peu les choses)
note : j'ai remarqué un bug, si on se deplace rapidement, au bout d'un moment, ça se met à lagger, faut que je regarde ça...)
Code : Tout sélectionner
; 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=64:#Adp1=#Adp-1 ; asteroid display (64*64), must be a power of 2
#tdn=128:#Ainf1=#tdn-1 ; array size of asteroid info, must be a power of 2
Structure sAst:mesh.b:rot.vector3:pos.vector3:scale.vector3:EndStructure
Global Dim ast.sast(#Ainf1,#Ainf1)
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
CreateSprite(0,180,120,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(0))
DrawingMode(#PB_2DDrawing_AllChannels)
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")
StopDrawing()
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()
;OpenWindow(0, 0,0,800,600, "Asteroide V2",#PB_Window_Maximize):OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0), WindowHeight(0), 0, 0, 0)
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($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_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,"RustySteel.jpg")
CreateMaterial(3, TextureID(3))
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,$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)
ScaleEntity(100+n,\scale\x,\scale\y,\scale\z)
RotateEntity(100+n,pom(180),pom(180),pom(180)) ; initial rotation
EndWith
EndIf
Next:Next
For j=pj To pj+#Adp1:For i=pi To pi+#Adp1
With ast(i & #Ainf1,j & #Ainf1)\rot
n=(j & #Adp1)*#Adp+(i & #Adp1)
RotateEntity(100+n,\x,\y,\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 )
renderentityarray()
RenderWorld()
DisplayTransparentSprite(0,8,8)
FlipBuffers()
Until KeyboardReleased(#PB_Key_Escape) Or MouseButton(1)
EndProcedure
init()
rendu()
