demo - feu d'artifice

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

demo - feu d'artifice

Message par Guillot »

Image

salut l'équipe,

pour fêter l'arrivée tant attendue de la 5.70 je vous ai fait un petit feu d'artifice
ça montre les nouvelles fonctions pour les particules (ParticleScaleRate et ParticleAngle) et CreateDataMesh
voili voilou

Code : Tout sélectionner

; feu d'artifice - pf shadoko 2018 (PB 5.70)

EnableExplicit

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


Procedure.f POM(v.f)
  ProcedureReturn (Random(v*1000)-v*500)/500
EndProcedure

Macro add3d(p,p1,p2)
  p\x=p1\x+p2\x
  p\y=p1\y+p2\y
  p\z=p1\z+p2\z
EndMacro

Procedure interpol3D(*R.Vector3, *V1.Vector3, *V2.Vector3, r.f)
  *R\x = *V1\x + r * (*V2\x - *V1\x)
  *R\y = *V1\y + r * (*V2\y - *V1\y)
  *R\z = *V1\z + r * (*V2\z - *V1\z)
EndProcedure

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 vec3d(v,vx,vy,vz)
  v\x=vx
  v\y=vy
  v\z=vz
EndMacro

;============================================================================================================

Structure sfusee
  p.vector3
  v.vector3
  a.vector3
  mat.i
EndStructure

#nbfusee=15     ; nombre de fusée                
#exp0=100       ; étapes de l'explosion (en 1/60 s)
#exp1=5
#exp2=10
#exp3=120

Global Dim f.sfusee(#nbfusee)

Procedure matiereparticule(num0,nb,dx,dy,nbp,l,rep.f,rlum.f,blendingmode=#PB_Material_AlphaBlend)
  Macro disradial(x,y,rmax,p) ; distribution radial
    Define.f a,r
    a=Random(6283)/1000
    r=Pow(Random(100000)/100000,p)*rmax
    x=Cos(a)*r
    y=Sin(a)*r
  EndMacro
  
  Structure spt:x.l:y.l:numi.l:EndStructure
  Protected.l i,j,ii.f,jj.f,c,num,lum,rx,ry
  Protected Dim p.spt(nbp)
  
  For i=0 To nbp
    disradial(rx,ry,dx/2-2-l,rep)
    p(i)\x=dx/2+rx
    p(i)\y=dy/2+ry
    p(i)\numi=Random(nb-1)
  Next
  For j=0 To nb-1 
    num=num0+j
    CreateTexture(num,dx,dy)
    StartDrawing(TextureOutput(num))
    DrawingMode(#PB_2DDrawing_AlphaBlend)
    Select 1
      Case 1
        For i=0 To nbp
          lum=(255-((j+p(i)\numi) % nb)*255/nb)*rlum
          LineXY(p(i)\x-l*2,p(i)\y,p(i)\x+l*2,p(i)\y,$01010101*lum)
          LineXY(p(i)\x,p(i)\y-l*2,p(i)\x,p(i)\y+l*2,$01010101*lum)
        Next
    EndSelect
    StopDrawing()
    CreateMaterial(num, TextureID(num))
    DisableMaterialLighting(num, 1)
    SetMaterialAttribute(num,#PB_Material_TAM,#PB_Material_ClampTAM)
    MaterialBlendingMode(num, blendingmode)
  Next
EndProcedure

Procedure PBrelief()
  Protected i,j,dx,dy,c,h.f
  
  LoadFont(0,"arial",32)
  CreateImage(0,256,128,32)
  StartDrawing(ImageOutput(0))
  Box(1,1,256-2,128-2,$ff0000ff)
  For i=0 To 20000:Plot(Random(253)+1,Random(125)+1,$ff0000fc):Next
  DrawingMode(#PB_2DDrawing_Outlined )
  Box(4,4,256-8,128-8,$ff0000dd)
  DrawingMode(#PB_2DDrawing_AlphaBlend)
  DrawingFont(FontID(0))
  #n=1
  For j=-#n To #n
    For i=-#n To #n  
      DrawText(16+i,14+j,"Pure Basic",$44000088,0)
      DrawText(90+i,70+j,"5.70",$44000088,0)
    Next
  Next
  DrawingMode(#PB_2DDrawing_AllChannels)
  dx=ImageWidth(0)-1
  dy=ImageHeight(0)-1
  Dim t.PB_MeshVertexV(dx,dy)
  For j=0 To dy
    For i=0 To dx
      c=Point(i,j)
      With t(i,j)
        vec3d(\p,-(i-dx/2)/4,-(j-dy)/4,20-Red(c)/128)
        \u=i/32
        \v=j/32
        \color=c
      EndWith
    Next
  Next
  StopDrawing()
  
  LoadTexture(2,"terrain_detail.jpg")  
  CreateMaterial(2, TextureID(2))
  SetMaterialColor(2,#PB_Material_SpecularColor,$ffffff)
  MaterialShininess(2,$80)
  CreateDataMesh(2,t())
  NormalizeMesh(2)
  CreateEntity(2,MeshID(2),MaterialID(2))
EndProcedure

Procedure init()
Protected ex,ey,i
ExamineDesktops()
ex=DesktopWidth(0)
ey=DesktopHeight(0)
InitEngine3D():InitSprite():InitKeyboard():InitMouse()
;OpenWindow(0, 0, 0, ex,ey, "",#PB_Window_Maximize|#PB_Window_BorderLess):OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)
OpenScreen(ex,ey,32,"")

Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures",#PB_3DArchive_FileSystem)
Parse3DScripts()

CreateCamera(0, 0, 0, 100, 100)
MoveCamera(0,0,2,-50)
CameraLookAt(0,0,20,0)
CameraBackColor(0,$220000)
AmbientColor($0)

matiereparticule(10,8,128,128,1000  ,1,0.7,0.5,#PB_Material_Add):LoadTexture(10, "smoke2.png")

matiereparticule(20,8,128,128,200   ,1,0.3,1,#PB_Material_Add)
matiereparticule(30,8,128,128,50    ,2,0.7,1,#PB_Material_Add)
matiereparticule(40,8,128,128,400   ,4,0.8,0.1,#PB_Material_Add)
matiereparticule(50,8,128,128,20    ,4,0.8,1,#PB_Material_Add)

For i=0 To #nbfusee
  CreateParticleEmitter(i, 0,0,0, 0,0,-1000,0)
  CreateLight(i,$ffffff):LightAttenuation(i,0,0)
  SetLightColor(i, #PB_Light_SpecularColor, $ffffff)
Next

LoadTexture(1, "dirt.jpg")
CreateMaterial(1, TextureID(1))

PBrelief()
CreatePlane(1,256,256,100,100,32,32)
CreateEntity(1,MeshID(1),MaterialID(1))
EndProcedure

Procedure fusee(n,cpt)
  Protected dec,c,col
  
  With f(n)
    dec=n*(#exp0+#exp1+#exp2+#exp3)/(#nbfusee+1)
    c=(cpt+dec):If c<0: ProcedureReturn:EndIf
    c % (#exp0+#exp1+#exp2+#exp3)
    Select c
      Case 1                    ;------------------ l'emetteur affiche le panache de la fusée
        vec3d(\p,pom(20),0,0)
        vec3d(\v,pom(0.2),0.8+pom(0.2),pom(0.1))
        vec3d(\a,0,-0.006,0)
        \mat=10
        ParticleSize(n, 0.5,0.5)
        ParticleColorRange(n, $888888, $888888)
        ParticleColorFader(n, -3,-3,-3,0)
        ParticleTimeToLive  (n, 0.2,0.2)
        ParticleVelocity(n, 2,0)
        ParticleScaleRate(n,8)
        ParticleAngle(n,-180,180)
        ParticleEmissionRate(n, 120)
        LightAttenuation(n,50,1)
        SetLightColor(n,#PB_Light_DiffuseColor,$ffffff)
        SetLightColor(n,#PB_Light_SpecularColor,$ffffff)
      Case #exp0                ;------------------ l'emetteur stop
        ParticleEmissionRate(n, 0)
      Case #exp0+#exp1          ;------------------ l'emmission de particule commence
        \mat=Random(5,2)*10
        ParticleSize(n, 0.2,0.2)
        col=Random($ffffff):ParticleColorRange(n, col, col)
        ParticleColorFader(n, 0,0,0,0)
        ParticleEmitterAngle(n,180)
        ParticleTimeToLive  (n, 1,1.5)
        ParticleAcceleration(n, 0, -0.05, 0)
        ParticleVelocity(n, 2,10)
        ParticleScaleRate(n,2)
        ParticleAngle(n,-180,180,-90,90)
        ParticleEmissionRate(n, 8000)
        LightAttenuation(n,100,1)
        SetLightColor(n,#PB_Light_DiffuseColor,col)
        SetLightColor(n,#PB_Light_SpecularColor,col)
      Case #exp0+#exp1+#exp2    ;------------------ l'emmission de particule stop, elles resteront 1.5 s (cf ParticleTimeToLive)
        LightAttenuation(n,0,1)
        ParticleEmissionRate(n, 0)
    EndSelect
    
    If \mat 
      If c< #exp0
        add3d(\v,\v,\a)
        add3d(\p,\p,\v)
        MoveParticleEmitter(n, \p\x+pom(0.1),\p\y,\p\z+pom(0.1),#PB_Absolute)
        MoveLight(n,\p\x,\p\y,\p\z,#PB_Absolute)
      EndIf
      ParticleMaterial(n, MaterialID(\mat+(c>>2) % 8))
    EndWith
  EndIf
EndProcedure

Procedure rendu()
  Protected.l i,cpt=0,col
  Protected.f keyx,keyz,MouseX,Mousey
  Repeat
    cpt+1
    ExamineMouse()
    ExamineKeyboard()
    For i=0 To #nbfusee:fusee(i,cpt):Next
    MouseX = -MouseDeltaX() *  0.05
    MouseY = -MouseDeltaY() *  0.05
    keyx=(-Bool(KeyboardPushed(#PB_Key_Left)<>0)+Bool(KeyboardPushed(#PB_Key_Right)<>0))*0.1
    keyz=(-Bool(KeyboardPushed(#PB_Key_Down)<>0)+Bool(KeyboardPushed(#PB_Key_Up   )<>0))*0.1+MouseWheel()*2
    RotateCamera(0, MouseY, MouseX, 0, #PB_Relative):MoveCamera  (0, keyx, 0, -keyz,#PB_Local ):MoveCamera(0,CameraX(0), 2,CameraZ(0),#PB_Absolute )
    
    RenderWorld()
    FlipBuffers()    
  Until KeyboardPushed(#PB_Key_Escape) Or KeyboardReleased(#PB_Key_Escape)
EndProcedure

init()
rendu()
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: demo - feu d'artifice

Message par Micoute »

Merci infiniment professeur pour le partage de ce grandiose spectacle.

J'adore.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: demo - feu d'artifice

Message par Ar-S »

C'est beau et hyper fluide.
Merci et bonne année à toi.
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: demo - feu d'artifice

Message par djes »

Très chouette, et en plus, bien dans l'esprit demo avec la création du bump en direct. Bravo ! :o
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: demo - feu d'artifice

Message par Kwai chang caine »

Splendide...comme tout ce que tu fais 8O
Merci 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
venom
Messages : 3071
Inscription : jeu. 29/juil./2004 16:33
Localisation : Klyntar
Contact :

Re: demo - feu d'artifice

Message par venom »

Merci du partage. très joli.






@++
Windows 10 x64, PureBasic 5.73 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz
Mouillard
Messages : 77
Inscription : mer. 13/sept./2017 14:35
Localisation : Picardie (Somme)

Re: demo - feu d'artifice

Message par Mouillard »

Bravo ...^=^ - pf shadoko
C'est artificieusement Boooooooo...... :!: :!: :!: :!:
Dommage que mon écran soit trop petit.... :D
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: demo - feu d'artifice

Message par Micoute »

Bonjour Mouillarf et à l'occasion Bonne et heureuse année, il y a belle lurette que je ne t'avais pas lu, cette nuit je pensais justement à toi.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Répondre