It is currently Fri Nov 22, 2019 4:57 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 8 posts ] 
Author Message
 Post subject: Demo - Fireworks
PostPosted: Sat Jan 05, 2019 9:44 am 
Offline
User
User

Joined: Thu Jul 09, 2015 9:07 am
Posts: 75
Image

hello to the team,

to celebrate the long-awaited arrival of the 5.70 I made you a little fireworks display
it shows the new functions for particles (ParticleScaleRate and ParticleAngle) and CreateDataMesh
Here you go, here you go.
Code:
; 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()


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo - Fireworks
PostPosted: Sat Jan 05, 2019 11:01 am 
Online
Addict
Addict

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1696
Location: Uttoxeter, UK
You code some lovely graphics.
Thank you for sharing.

_________________
DE AA EB


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo - Fireworks
PostPosted: Sat Jan 05, 2019 1:24 pm 
Offline
Addict
Addict
User avatar

Joined: Sat Feb 13, 2010 3:45 pm
Posts: 939
Nice effect

_________________
sorry for my bad english


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo - Fireworks
PostPosted: Sat Jan 05, 2019 1:45 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Jun 11, 2003 9:33 pm
Posts: 4579
Location: Spa, relaxing and thinking, and learning...
Good one! :)

_________________
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo - Fireworks
PostPosted: Thu Apr 18, 2019 2:34 pm 
Offline
Moderator
Moderator
User avatar

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 1106
Location: Germany::Berlin()
Nice effect, thumbs up.

_________________
ImageImageImageImage Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo - Fireworks
PostPosted: Sat Sep 28, 2019 4:30 pm 
Offline
User
User

Joined: Mon Feb 23, 2009 4:01 pm
Posts: 98
Location: Poland
It is work

_________________
My game


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo - Fireworks
PostPosted: Sat Sep 28, 2019 5:57 pm 
Offline
Enthusiast
Enthusiast

Joined: Mon Jul 09, 2007 4:47 pm
Posts: 219
Location: Courthouse
Very impressive


Top
 Profile  
Reply with quote  
 Post subject: Re: Demo - Fireworks
PostPosted: Sun Sep 29, 2019 9:15 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4528
Location: Lyon - France
Like usually ...... :shock:

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 8 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 3 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye