UnderwareDESIGN

PlayBASIC => Resources => Source Codes => Topic started by: kevin on April 23, 2016, 11:36:18 AM

Title: Particles Demo Using Sprites
Post by: kevin on April 23, 2016, 11:36:18 AM
   Particles Demo Using Sprites

    This is an older code snippet that was originally written by Crystal Noir, it creates a type of 3D particle explosion using animated 2d sprites.    I've tweaking the code and fixed some logic errors and this was the end result.  


  Particle Demo Video




  Particle Source Code

[pbcode]


; PROJECT : Artifice
; AUTHOR  : Crystal Noir & Kevin Picone
; CREATED : 2/23/2010
; EDITED  : 4/23/2016
; ---------------------------------------------------------------------

Setfps 60
#include "blitimage"

//Variables
GLOBAL Speed#
GLOBAL parax#
GLOBAL paray#
GLOBAL paraz#
GLOBAL Angle1#
GLOBAL Angle2#

GLOBAL switch = 0
GLOBAL NbFeu = 400
GLOBAL Temps = 0


//Types

TYPE FeuArtifice
   SpriteIndex
   x#
    y#
    z#
    vy#
    xd#
    yd#
    zd#
    size#
ENDTYPE

DIM Pouf AS FeuArtifice LIST


ParticleImage=MakeBall()

Screen=NewIMage(GetScreenWidth(),GetScreenHeight(),2)

// Boucle principale
REPEAT
   RendertoIMage Screen


      IF Temps   = 0
         parax# = RNDrange(-100,100)
          paray# = RNDRange(-100,100)
          paraz# = 200
 
         IF swith = 0
            Temps = rndrange(20,120)
         ENDIF

         ; pick a colour for this batch      
         ThisRGB=RNDRGB()
         FOR i = 1 TO NbFeu
               NewFeu(parax#,paray#,paraz#,ParticleImage,THisRGB)
         NEXT

      ENDIF
   
      t=timer()
         FOR EACH Pouf()
            if AfficheFeu()=0
                  DELETESPRITE Pouf.SpriteIndex
                  Pouf = null
            endif
         NEXT
         tt1#+=(timer()-t)
      Temps--


      ; ender sprites
      DRAWALLSPRITES   


      ; render screen to video memory    
      rendertoscreen
      BlitImageAlpha50Colour(Screen,0,0,$000000)


   SYNC
UNTIL ESCKEY() = 1



   end
   




//Sub & Functions
PSUB NewFeu(x#,y#,z#,ThisIMage,ThisRGB)

   ; Allocate new list element
   Pouf = NEW FeuArtifice

   ; assign the size of the sprite
   Pouf.size# = rnd#(0.20)*4


   ; CReate a sprite offset the screen
   ThisSprite=NEWSPRITE(-150,-150,ThisIMage)
   
   ; init the drawmode
   SPRITEDRAWMODE ThisSprite,02+16
    SPRITETINT ThisSprite,ThisRGB

   ; store sprite Id in our list     
   Pouf.SpriteIndex = ThisSprite

   ; movement angles + speed
   Angle1#   = RND#(360)
   Angle2#   = RND#(360)
   Speed#    = 0.1
   
   ; Init it's position in 3d space
   Pouf.x#  = X#
    Pouf.y#  = Y#
    Pouf.z#  = Z#
    
    Pouf.xd# = COS(Angle1#) * COS(Angle2#) * Speed#
    Pouf.yd# = COS(Angle1#) * SIN(Angle2#) * Speed#
    Pouf.zd# = SIN(Angle1#) * Speed#

   Pouf.xd# *= 10.0
   Pouf.yd# *= 10.0
   Pouf.zd# *= 10.0

ENDPSUB



PSUB AfficheFeu()

   Pouf.size# -=  0.0020
   IF Pouf.size# >0

          Pouf.x# +=  Pouf.xd#
          Pouf.z# +=  Pouf.zd#
          Pouf.y# +=  Pouf.yd#+Pouf.vy#
          Pouf.vy# += 0.02
 
         z#=500/Pouf.z#
          posY# = (600/2) + ((Pouf.y# * z#))

          PosX# = (800/2) + ((Pouf.x# *z#) )
         ThisSprite   =Pouf.SpriteIndex
            SCALESPRITE ThisSprite,Pouf.size#
          POSITIONSPRITE ThisSprite,posx#,posy#
         State=PosY#<620
   else
            State   =0
   endif
ENDPSUB State





Psub MakeBall()

 Size=32
 
 Ball=NewImage(Size,Size,2)

   rendertoimage Ball
   cls 0   
   Radius#=Size*0.6
   lockbuffer
      ThisRGB=point(0,0)
      For Ylp=0 to Size-1
         For Xlp=0 to Size-1
            Dist#=GetDistance2d(Size/2,Size/2,Xlp,Ylp)
            if Dist#<Radius#
                  Dist#=(Radius#-Dist#)/Radius#
                  Dist#*=90
                  Dist#=sin(Dist#)
                  ThisRGB=RgbAlphaBlend(0,-1,Dist#*100)
                  FastDot Xlp,ylp,THisRGB         
            endif
         next
      next
   unlockbuffer

   rendertoscreen

EndPsub Ball

[/pbcode]



   Related Examples:

      * New Years Eve 2020 -  Firework   Particle   Animation - Source Code (https://www.underwaredesign.com/forums/index.php?topic=4513.0)