Sinus Bob Chain

[kevin]

 
 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. 

PlayBASIC Code: [Select]

   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

 This is the legacy version of PlayBASIC V1.63 revisions.  

PlayBASIC Code: [Select]

   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