PureBasic
https://www.purebasic.fr/french/

Demo - Asteroide V2
https://www.purebasic.fr/french/viewtopic.php?f=13&t=17639
Page 1 sur 1

Auteur:  Guillot [ Mar 02/Avr/2019 23:36 ]
Sujet du message:  Demo - Asteroide V2

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

Auteur:  SPH [ Mer 03/Avr/2019 14:33 ]
Sujet du message:  Re: Demo - Asteroide V2

Top, comme dab 8)

Auteur:  Kwai chang caine [ Sam 06/Avr/2019 19:15 ]
Sujet du message:  Re: Demo - Asteroide V2

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

Image

Un univers de Chocapic quoi 8O

Image

Merci pour ce voyage interstellaire 8)

Auteur:  SPH [ Sam 06/Avr/2019 20:07 ]
Sujet du message:  Re: Demo - Asteroide V2

...meme si j'ai ete + impressionné par : https://www.purebasic.fr/french/viewtopic.php?f=13&t=17634

Auteur:  Kwai chang caine [ Lun 08/Avr/2019 14:37 ]
Sujet du message:  Re: Demo - Asteroide V2

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)

Page 1 sur 1 Heures au format UTC + 1 heure
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/