Using Shapes For Dot Particles

[kevin]

Code:

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

[kevin]

 This version using alpha addition + alpha sub to create the blur. 

Code:

#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

[kevin]

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

 This version is a bit like a fireworks display.

Code:

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]

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 PB1.68 (or so) but will work in old versions also (just slower)

Code:

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