Demo - Asteroide V2

Généralités sur la programmation 3D
Avatar de l’utilisateur
Guillot
Messages : 522
Inscription : jeu. 25/juin/2015 16:18

Demo - Asteroide V2

Message par Guillot »

Image

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()
Avatar de l’utilisateur
SPH
Messages : 4722
Inscription : mer. 09/nov./2005 9:53

Re: Demo - Asteroide V2

Message par SPH »

Top, comme dab 8)
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Demo - Asteroide V2

Message par Kwai chang caine »

Je dirais même plus :
Top, comme dab 8)

Image

Un univers de Chocapic quoi 8O

Image

Merci pour ce voyage interstellaire 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
SPH
Messages : 4722
Inscription : mer. 09/nov./2005 9:53

Re: Demo - Asteroide V2

Message par SPH »

...meme si j'ai ete + impressionné par : https://www.purebasic.fr/french/viewtop ... 13&t=17634
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Demo - Asteroide V2

Message par Kwai chang caine »

C'est vrai que toutes les réalisations de Maitre "Guim'sllot" sont époustouflantes.
Et comme un certain barbu, on est toujours près à prendre une nouvelle tarte sur l'autre joue, tellement c'est bon.... 8O
Ce travail est un réel atout de démonstration pour PB..

Bientôt, il pourra ouvrir une exposition...après Picasso...voilà Guillot 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Répondre