PureBasic

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