News:

PlayBASIC2DLL V0.99 Revision I Commercial Edition released! - Convert PlayBASIC programs to super fast Machine Code. 

Main Menu

Using Shapes For Dot Particles

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

Previous topic - Next topic

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

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


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


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