Using Shapes For Dot Particles

Started by kevin, March 05, 2007, 11:45:12 PM

Previous topic - Next topic
Print
Go Down Pages1
User actions

kevin

March 05, 2007, 11:45:12 PM Last Edit: May 15, 2021, 11:48:50 PM by kevin
PlayBASIC Code: [Select]
   Type tParticle
      Shape
      X#
      Y#   
      ScaleX#
      ScaleY#
      Time
      MaxTime
      Colour
   EndType

   Dim Parts(1) as tParticle

   Do
      Cls 0

         lockbuffer      
            For lp=1 to GetArrayelements(Parts(),1)
               if Parts(lp)
                  if Parts(lp).time<Parts(lp).Maxtime
                     Parts(lp).time=Parts(lp).time+1

                     C=Parts(lp).Colour

                     C=rgbfade(c,150-(100.0/Parts(lp).Maxtime)*Parts(lp).time)
                     ink c                                          

                     x#=parts(lp).x
                     y#=parts(lp).y
                     sx#=parts(lp).Scalex+0.25
                     sy#=parts(lp).Scaley+0.25
                     Shape=parts(lp).shape
                      RotateShapeXY Shape,Angle#,SX#,Sy#
                     drawshape shape,x#,y#,0
                  
                     parts(lp).Scalex=sx#                  
                     parts(lp).Scaley=sy#                  
                  else
                     DeleteParticles(lp)
                  endif   

                  
               endif
            next   
         unlockbuffer
         
         if Spacekey()
            x#=rnd(800)
            y#=rnd(600)
            AddParticles(x#,y#,rndrange(10,36))
         ;   flushkeys
         endif

      Sync   
   loop


Function DeleteParticles(index)
   DeleteShape Parts(index).shape   
   Parts(Index)=null
EndFunction


Function AddParticles(x#,y#,POints)
   index=GetFreeCell(Parts())
   Parts(index).x=x#
   Parts(index).y=y#
   Parts(index).scalex=1
   Parts(index).scaley=1
   Parts(index).colour=rndrgb()
   
   Parts(index).Maxtime=150
   Parts(index).time=0
   

      
   Shape=NewShape(Points,POints)
   angleStep#=360.0/points
      
   For lp=0 to points-1
      angle#=wrapangle(angle#,anglestep#)
      radius=rnd(10)
      SetShapeVertex Shape,lp,cosRadius(angle#,radius),SinRadius(angle#,radius)      
      SetShapeEdge Shape,lp,lp,lp
   next

   Parts(index).Shape=Shape
      
   
EndFunction







   Related Examples:


             *   Shape Star Field
             *   8Way Layered Star Field / Asteroids Style
              *    Into the Light  (Shape Tunnel Variant)

kevin

#1
March 06, 2007, 12:55:14 AM Last Edit: September 15, 2012, 09:12:00 AM by kevin
 This version using alpha addition + alpha sub to create the blur.  

PlayBASIC Code: [Select]
   #include "BlitIMage"

   OpenScreen 800,600,16,2

   MakeBitmapfont 1,$ffffff

   Type tParticle
      Shape
      X#
      Y#   
      ScaleX#
      ScaleY#
      Time
      MaxTime
      Colour
   EndType

   Dim Parts(1) as tParticle
   
   CreateFXimage 1,GetScreenWidth(),GetScreenHeight()

   
   Do
      

         rendertoimage 1
         inkmode 1+32

         angle#=angle#+2
         ActiveShapes=0
         VertCount=0
         lockbuffer      
            For lp=1 to GetArrayelements(Parts(),1)
               if Parts(lp)
                  if Parts(lp).time<Parts(lp).Maxtime
                     Parts(lp).time=Parts(lp).time+1

                     C=Parts(lp).Colour
                     ink rgbfade(c,170-(100.0/Parts(lp).Maxtime)*Parts(lp).time)

                     x#=parts(lp).x
                     y#=parts(lp).y
                     sx#=parts(lp).Scalex+0.5
                     sy#=parts(lp).Scaley+0.5
                     Shape=parts(lp).shape
                     RotateShapeXY Shape,Angle#,SX#,Sy#
                     drawshape shape,x#,y#,0
                  
                     parts(lp).Scalex=sx#                  
                     parts(lp).Scaley=sy#                  
                     VertCount=VertCount+GetShapeVerts(Shape,0) 
                     Inc ActiveShapes
                  else
                     DeleteParticles(lp)
                  endif   

                  
               endif
            next   
         unlockbuffer
         
         For lp=1 to 3
            x#=rnd(GetScreenWidth() )
            y#=rnd(GetScreenHeight() )
            AddParticles(x#,y#,rndrange(20,50))
         next

         mx=mousex()
         my=mousey()

         if MouseButton()
            AddParticles(mx,my,rndrange(20,75))
         endif         
         

         rendertoimage 0
         BlitImageAlphaSubColour(1,0,0,rgb(11,11,11))


         setcursor 0,0
         ink $ffffff   
         inkmode 1
         print "Fps:"+str$(fps())
         print "Points:"+str$(vertcount)
         print "Shapes:"+str$(ActiveShapes)
         Circle mx,my,10,false

         Sync   
   loop


Function DeleteParticles(index)
   DeleteShape Parts(index).shape   
   Parts(Index)=null
EndFunction


Function AddParticles(x#,y#,POints)
   index=GetFreeCell(Parts())
   Parts(index).x=x#
   Parts(index).y=y#
   Parts(index).scalex=1
   Parts(index).scaley=1
   Parts(index).colour=rndrgb()
   
   Parts(index).Maxtime=125
   Parts(index).time=0
   
   Shape=NewShape(Points,POints)
   angleStep#=360.0/points
      
   For lp=0 to points-1
      angle#=wrapangle(angle#,anglestep#)
      radius=rndrange(1,10)
      SetShapeVertex Shape,lp,cosRadius(angle#,radius),SinRadius(angle#,radius)      
      SetShapeEdge Shape,lp,lp,lp
   next
   Parts(index).Shape=Shape
   
EndFunction




Ian Price

#2
March 06, 2007, 01:44:14 AM
Impressive - I get 109FPS for the second demo.

Yours demos recently have certainly highlighted my lack of understanding of the PB language and what it is capable of :(
I came. I saw. I played some Nintendo.

kevin

#3
March 06, 2007, 05:09:41 AM

QuoteYours demos recently have certainly highlighted my lack of understanding of the PB language and what it is capable of

  Well, it's not like your not the only one :)


kevin

#4
March 06, 2007, 08:42:43 AM Last Edit: September 15, 2012, 09:12:40 AM by kevin
 This version is a bit like a fireworks display.

PlayBASIC Code: [Select]
   OpenScreen 800,600,16,2
   MakeBitmapfont 1,$ffffff

;    Setfps 100
 

   #include "BlitIMage"



   Type tParticle
      Shape
      X#
      Y#   
      ScaleX#
      ScaleY#
      Time
      MaxTime
      Colour
   EndType

   Dim Parts(1) as tParticle
   
   CreateFXimage 1,GetScreenWidth(),GetScreenHeight()


   Do
      
         rendertoimage 1
         inkmode 1+64

         lockbuffer      
            For lp=1 to GetArrayelements(Parts(),1)
               if Parts(lp)
                  if Parts(lp).time<Parts(lp).Maxtime
                     Parts(lp).time=Parts(lp).time+1

                     C=Parts(lp).Colour
                     ink rgbfade(c,125-(100.0/Parts(lp).Maxtime)*Parts(lp).time)

                     x#=parts(lp).x
                     y#=parts(lp).y
                     sx#=parts(lp).Scalex+0.25
                     sy#=parts(lp).Scaley+0.25
                     Shape=parts(lp).shape
                     RotateShapeXY Shape,Angle#,SX#,Sy#
                     drawshape shape,x#,y#,0
                  
                     parts(lp).Scalex=sx#                  
                     parts(lp).Scaley=sy#                  
                  else
                     DeleteParticles(lp)
                  endif   

                  
               endif
            next   
         unlockbuffer


         if Nexttime=0

            x#=rnd(GetScreenWidth() )
            y#=rnd(GetScreenHeight() )
         
            For lp=1 to 5
               AddParticles(x#,y#,rndrange(75,500))
            next
            nexttime=10
         endif   
         dec nexttime


         rendertoimage 0
         BlitImageAlphaSubColour(1,0,0,rgb($10,$10,$10))


         ink $ffffff   
         inkmode 1
         text 10,10,fps()

         Sync   
   loop


Function DeleteParticles(index)
   DeleteShape Parts(index).shape   
   Parts(Index)=null
EndFunction


Function AddParticles(x#,y#,POints)
   index=GetFreeCell(Parts())
   Parts(index).x=x#
   Parts(index).y=y#
   Parts(index).scalex=1
   Parts(index).scaley=1
   Parts(index).colour=rndrgb()
   
   Parts(index).Maxtime=125
   Parts(index).time=0
   
   Shape=NewShape(Points,POints)
   angleStep#=360.0/points
      
   For lp=0 to points-1
      angle#=wrapangle(angle#,anglestep#)
      radius#=rndrange#(1,10)
      SetShapeVertex Shape,lp,cosRadius(angle#,radius#),SinRadius(angle#,radius#)      
      SetShapeEdge Shape,lp,lp,lp
   next
   Parts(index).Shape=Shape
   
EndFunction




kevin

#5
March 19, 2007, 01:26:48 PM Last Edit: September 15, 2012, 09:13:18 AM by kevin
Particle Sprinkler

   This is variation  of the particle shape demos above and is rendering around 34,500 alpha addition dot particles.  

   The example was written in PBFX 1.68 (or so) but will work in old versions also (just slower)


PlayBASIC Code: [Select]
   OpenScreen 800,600,16,2
 

   #include "BlitIMage"



   Type tParticle
      Shape
      X#
      Y#   
      ScaleX#
      ScaleY#
      Time
      MaxTime
      Colour
   EndType

   Dim Parts(1) as tParticle
   
   CreateFXimage 1,GetScreenWidth(),GetScreenHeight()


   Do

;cls 0      
   rendertoimage 1
         inkmode 1+64
;inkmode 10
         Vertcount=0
         lockbuffer      
            For lp=1 to GetArrayelements(Parts(),1)
               if Parts(lp)
                  if Parts(lp).time<Parts(lp).Maxtime
                     Parts(lp).time=Parts(lp).time+1

                     C=Parts(lp).Colour
                     ink rgbfade(c,125-(100.0/Parts(lp).Maxtime)*Parts(lp).time)

                     x#=parts(lp).x
                     y#=parts(lp).y
                     sx#=parts(lp).Scalex+0.35
                     sy#=parts(lp).Scaley+0.35
                     Shape=parts(lp).shape
                     RotateShapeXY Shape,Angle#,SX#,Sy#
                     drawshape shape,x#,y#,0
                  
                     parts(lp).Scalex=sx#                  
                     parts(lp).Scaley=sy#                  
                     Vertcount=Vertcount+GetShapeVerts(Shape,0)

                  else
                     DeleteParticles(lp)
                  endif   

                  
               endif
            next   
         unlockbuffer

         swayangle#=wrapangle(swayangle#,1.25)
         swayangle2#=wrapangle(swayangle2#,0.5)
         if Nexttime=0

            x#=rnd(GetScreenWidth() )
            y#=rnd(GetScreenHeight() )
            x#=400+cosradius(swayangle#,200)
;            y#=300
            y#=300+cosradius(swayangle2#,100)
            For lp=1 to 5
               AddParticles(x#,y#,rndrange(75,250))
            next
            nexttime=7
         endif   
         dec nexttime

         rendertoimage 0
         BlitImageAlphaSubColour(1,0,0,rgb($10,$10,$10))


         ink $ffffff   
         inkmode 1
         text 10,10,fps()
;         text 10,35,VertCount
         
         Sync   
   loop


Function DeleteParticles(index)
   DeleteShape Parts(index).shape   
   Parts(Index)=null
EndFunction


Function AddParticles(x#,y#,POints)
   index=GetFreeCell(Parts())
   Parts(index).x=x#
   Parts(index).y=y#
   Parts(index).scalex=1
   Parts(index).scaley=1
   Parts(index).colour=rndrgb()
   
   Parts(index).Maxtime=300
   Parts(index).time=0
   
   Shape=NewShape(Points,POints)
   angleStep#=360.0/points
      
   For lp=0 to points-1
      angle#=wrapangle(angle#,anglestep#)
      radius#=rndrange#(1,10)
      SetShapeVertex Shape,lp,cosRadius(angle#,radius#),SinRadius(angle#,radius#)      
      SetShapeEdge Shape,lp,lp,lp
   next
   Parts(index).Shape=Shape
   
EndFunction






kevin

#6
April 15, 2019, 07:38:41 AM

PlayBASIC Source Code: Particle Sparkler ( 2007-10-03 )

  This effect is created by using the shape command set to plot batches of dots in rings.  The screen is then post processed to give the illusion of the particles are cooling down over time.

PlayBASIC Code: [Select]
; PROJECT : ShapeParticleSprinkler
; AUTHOR  : Kevin Picone
; CREATED : 6/03/2007
; EDITED  : 3/10/2007
; ---------------------------------------------------------------------
;   OpenScreen 800,600,16,2
;   MakeBitmapfont 1,$ffffff

   Setfps 200
 

   #include "BlitIMage"



   Type tParticle
      Shape
      X#
      Y#   
      ScaleX#
      ScaleY#
      Time
      MaxTime
      Colour
   EndType

   Dim Parts(1) as tParticle
   
   CreateFXimage 1,GetScreenWidth(),GetScreenHeight()


   Do

;cls 0      
   rendertoimage 1
         inkmode 1+64
;inkmode 10
         Vertcount=0
         lockbuffer      
            For lp=1 to GetArrayelements(Parts(),1)
               if Parts(lp)
                  if Parts(lp).time<Parts(lp).Maxtime
                     Parts(lp).time=Parts(lp).time+1

                     C=Parts(lp).Colour
                     ink rgbfade(c,125-(100.0/Parts(lp).Maxtime)*Parts(lp).time)

                     x#=parts(lp).x
                     y#=parts(lp).y
                     sx#=parts(lp).Scalex+0.35
                     sy#=parts(lp).Scaley+0.35
                     Shape=parts(lp).shape
                     RotateShapeXY Shape,Angle#,SX#,Sy#
                     drawshape shape,x#,y#,0
                  
                     parts(lp).Scalex=sx#                  
                     parts(lp).Scaley=sy#                  
                     Vertcount=Vertcount+GetShapeVerts(Shape,0)

                  else
                     DeleteParticles(lp)
                  endif   

                  
               endif
            next   
         unlockbuffer

         swayangle#=wrapangle(swayangle#,1.25)
         swayangle2#=wrapangle(swayangle2#,0.5)
         if Nexttime=0

            x#=rnd(GetScreenWidth() )
            y#=rnd(GetScreenHeight() )
            x#=400+cosradius(swayangle#,200)
;            y#=300
            y#=300+cosradius(swayangle2#,100)
            For lp=1 to 5
               AddParticles(x#,y#,rndrange(75,250))
            next
            nexttime=7
         endif   
         dec nexttime

         rendertoimage 0
         BlitImageAlphaSubColour(1,0,0,rgb($10,$10,$10))


         ink $ffffff   
         inkmode 1
         text 10,10,fps()
;         text 10,35,VertCount
         
         Sync   
   loop


Function DeleteParticles(index)
   DeleteShape Parts(index).shape   
   Parts(Index)=null
EndFunction


Function AddParticles(x#,y#,POints)
   index=GetFreeCell(Parts())
   Parts(index).x=x#
   Parts(index).y=y#
   Parts(index).scalex=1
   Parts(index).scaley=1
   Parts(index).colour=rndrgb()
   
   Parts(index).Maxtime=300
   Parts(index).time=0
   
   Shape=NewShape(Points,POints)
   angleStep#=360.0/points
      
   For lp=0 to points-1
      angle#=wrapangle(angle#,anglestep#)
      radius#=rndrange#(1,10)
      SetShapeVertex Shape,lp,cosRadius(angle#,radius#),SinRadius(angle#,radius#)      
      SetShapeEdge Shape,lp,lp,lp
   next
   Parts(index).Shape=Shape
   
EndFunction



Print
Go Up Pages1
User actions