UnderwareDESIGN

PlayBASIC => Resources => Source Codes => Topic started by: kevin on July 10, 2007, 08:27:03 AM

Title: Sinus Bob Chain
Post by: kevin on July 10, 2007, 08:27:03 AM
 
 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]