This is a revamped version of the Sinus Bob demo for example pack. This version has alpha blended sprites, apart from that it's the same.
This is an updated version of PlayBASIC V1.64 revisions.
[pbcode]
OpenScreen 800,600,32,2
#INCLUDE "bLITIMAGE"
; turn type caching on
optexpressions 3
; convert the default True type font to a bitmap version
MakeBitmapFont 1,$ff0000,8
; define the Ball type
Type tBall
Xpos#
Ypos#
CosAngle#
SinAngle#
Colour
Sprite
EndType
; declare the BALL as list of tBALL objects
Dim Ball(0) as tBall
Screen=Newfximage(GetScreenWidth(),GetScreenHeight())
Do
; Clear the Screen to black
rendertoimage Screen
CurrentFps=Fps()
BallCount=GetArrayElements(Ball(),1)
; Draw all the oebjcts in the BALL list
For lp=1 to BallCount
ca#=wrapangle(Ball(lp).CosAngle#,0.54)
sa#=wrapangle(Ball(lp).SinAngle#,0.29)
x#=SinNewValue(Ball(lp).xpos#,Ball(lp).SinAngle#,1.8)
y#=CosNewValue(Ball(lp).ypos#,Ball(lp).CosAngle#,2.7)
positionsprite Ball(lp).sprite,x#,y#
Ball(lp).xpos=x#
Ball(lp).ypos=y#
Ball(lp).CosAngle#=ca#
Ball(lp).SinAngle#=sa#
next
drawallsprites
; Add a new ball every 6 frames
if Framedelay=>6
; Keep Adding Bobs till either the FPS rate drops bellow 30
; or there's 1000.
; The sinus will resolve before that though. So new sprites
; be follow the same path.. but ya get that Smiley
if CurrentFps>30
if BallCount<2000
lp=GetFreeCell(Ball())
Ball(lp).xpos=40
Ball(lp).ypos=getscreenheight()/2
Ball(lp).colour=rndrgb()
img=MakeParticle(24,Ball(lp).colour)
Ball(lp).Sprite=NewSprite(Ball(lp).xpos,Ball(lp).Ypos,img)
CenterSpriteHandle Ball(lp).Sprite
; Spritetransparent Ball(lp).Sprite,off
SpriteMaskColourCompression Ball(lp).Sprite,Off
SpriteDrawMode Ball(lp).Sprite,2+16
endif
endif
Framedelay=0
else
inc Framedelay
endif
inkmode 1
rendertoscreen
BlitImageClear(Screen,0,0,0)
text 0,0,"Fps:"+Str$(CurrentFps)+" Balls:"+str$(BallCount)
Sync
loop
Function MakeParticle(Size,Col)
ThisImage=NewFXImage(Size,Size)
RenderPhongImage ThisImage,Size/2,Size/2,col,255,260/(size/2)
EndFunction ThisImage
[/pbcode]
This is the legacy version of PlayBASIC V1.63 revisions.
[pbcode]
OpenScreen 800,600,16,2
#INCLUDE "bLITIMAGE"
; convert the default True type font to a bitmap version
MakeBitmapFont 1,$ff0000
; define the Ball type
Type tBall
Xpos#
Ypos#
CosAngle#
SinAngle#
Colour
Sprite
EndType
; declare the BALL as list of tBALL objects
Dim Ball(0) as tBall
Screen=Newfximage(GetScreenWidth(),GetScreenHeight())
Do
; Clear the Screen to black
rendertoimage Screen
CurrentFps=Fps()
BallCount=GetArrayElements(Ball(),1)
; Draw all the oebjcts in the BALL list
For lp=1 to BallCount
ca#=wrapangle(Ball(lp).CosAngle#,0.54)
sa#=wrapangle(Ball(lp).SinAngle#,0.29)
x#=SinNewValue(Ball(lp).xpos#,Ball(lp).SinAngle#,1.8)
y#=CosNewValue(Ball(lp).ypos#,Ball(lp).CosAngle#,2.7)
positionsprite Ball(lp).sprite,x#,y#
Ball(lp).xpos=x#
Ball(lp).ypos=y#
Ball(lp).CosAngle#=ca#
Ball(lp).SinAngle#=sa#
next
drawallsprites
; Add a new ball every 6 frames
if Framedelay=>6
; Keep Adding Bobs till either the FPS rate drops bellow 30
; or there's 1000.
; The sinus will resolve before that though. So new sprites
; be follow the same path.. but ya get that :)
if CurrentFps>30
if BallCount<2000
lp=GetFreeCell(Ball())
Ball(lp).xpos=40
Ball(lp).ypos=getscreenheight()/2
Ball(lp).colour=rndrgb()
img=MakeParticle(24,Ball(lp).colour)
Ball(lp).Sprite=NewSprite(Ball(lp).xpos,Ball(lp).Ypos,img)
SpriteDrawMode Ball(lp).Sprite,2+16
CenterSpriteHandle Ball(lp).Sprite
Spritetransparent Ball(lp).Sprite,off
endif
endif
Framedelay=0
else
inc Framedelay
endif
inkmode 1
rendertoscreen
BlitImageClear(Screen,0,0,0)
text 0,0,"Fps:"+Str$(CurrentFps)+" Balls:"+str$(BallCount)
Sync
loop
Function MakeParticle(Size,Col)
ThisImage=NewFXImage(Size,Size)
RenderToImage ThisImage
RenderPhongImage ThisImage,Size/2,Size/2,col,255,260/(size/2)
RenderToScreen
EndFunction ThisImage
[/pbcode]