PureBasic

Forums PureBasic
Nous sommes le Mar 18/Juin/2019 12:54

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 5 messages ] 
Auteur Message
 Sujet du message: Demo - Asteroide V2
MessagePosté: Mar 02/Avr/2019 23:36 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 25/Juin/2015 16:18
Messages: 255
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()


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Demo - Asteroide V2
MessagePosté: Mer 03/Avr/2019 14:33 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 3959
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 ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Demo - Asteroide V2
MessagePosté: Sam 06/Avr/2019 19:15 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6626
Localisation: Isere
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Demo - Asteroide V2
MessagePosté: Sam 06/Avr/2019 20:07 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 3959
...meme si j'ai ete + impressionné par : https://www.purebasic.fr/french/viewtopic.php?f=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 ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Demo - Asteroide V2
MessagePosté: Lun 08/Avr/2019 14:37 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6626
Localisation: Isere
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


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 5 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: venom et 1 invité


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  
cron

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye