UnderwareDESIGN

PlayBASIC => Resources => Source Codes => Topic started by: stef on March 06, 2007, 05:20:08 PM

Title: Starfire
Post by: stef on March 06, 2007, 05:20:08 PM
Hi!

Some firepaint code! :)

needs PBFX V1.65 or above !

move around with mouse
change particles with mousebuttons

[pbcode]
; PROJECT : Starfire    linked list
; AUTHOR  : stef
; CREATED : 02.03.2007
; EDITED  : 06.03.2007
; ---------------------------------------------------------------------

;Particledemo
;made with PB 1.67f

;move around with mouse
;click LMB or RMB to change particles


Constant SCREENW=640
Constant SCREENH=480

OpenScreen SCREENW,SCREENH,32,2

MakeBitmapFont 0,RGB(255,255,255)

   Type particle
      x#,y#
      dx#,dy#
      angle
      rotangle
      drotangle
      im
      sp
      speed#
      alpha#
   EndType
   
   
   Dim Object As particle List
   
   Global backim
   Global starshape
      
   Global NumbOfParticles
   Global MaxParticles=1000
   Global size =30
   Global grav#=0.05
   Global r=255
   Global g=0
   Global b=0
   Global colfactor=5
   Global count
   Global switch
   
   drawstuff()


   Do
      RenderToScreen
      
      DrawImage backim,0,a,1
      DrawImage backim,0,-SCREENH+a,1
      
      ;cls 0
      a=a+5
      If a=SCREENH Then a=0
      
      Ink RGB(255,255,255)
      
      Text 0,0,Str$(FPS())
      Text 0,10,Str$(MaxParticles)
      Text 0,20,Str$(NumbOfParticles)
      Text 0,30,Str$(GetArrayElements(object(),0))
   
      
   If NumbOfParticles<MaxParticles   
   Addpart()
   EndIf

   
   calcparticles()
   
   
      Sync         
Loop
   
Function drawstuff()
   
   backim= GetFreeImage()
   CreateImage backim, SCREENW,SCREENH
   RenderToImage backim
   
   Cls 70
   For x= 0 To 500
      col=RndRange(70,255)   
      CircleC Rnd(SCREENW),Rnd(SCREENH),2,1,RGB(col,col,col)
   Next
   

starshape = GetFreeShape()
CreateShape starshape,10,10

ang#=0
For x= 0 To 8 Step 2
   SetShapeVertex starshape,x,Cos(ang#)*17,Sin(ang#)*17
   SetShapeVertex starshape,x+1,Cos(ang#+36)*7,Sin(ang#+36)*7
   ang#=ang#+72
Next

For x= 0 To 8
   SetShapeEdge starshape,x,x,x+1
   ang#=ang#+72
Next

SetShapeEdge starshape,9,9,0
   
EndFunction
   


Function Addpart()
   
   If LeftMouseButton()=1 Then switch=0
   If RightMouseButton()=1 Then switch=1
   
   If (r<255) And (g =0) And (b =255)  Then r=r+colfactor
   If (r=255) And (g=0) And (b >0) Then   b=b-colfactor
   If (r=255) And (g < 255) And (b =0) Then g=g+colfactor
   If (r>0) And (g = 255) And (b =0) Then r=r-colfactor
   If (r=0) And (g = 255) And (b <255) Then b=b+colfactor      
   If (r=0) And (g >0) And (b =255) Then g=g-colfactor
   
   
   
   For x= 0 To 5

   Object = New particle
   Object.X#      =MouseX()
   Object.y#      =MouseY()
   Object.Angle   =Rnd(360)
   Object.Speed#   =RndRange#(1,3)
   Object.dx#      =(Cos(Object.angle))*object.speed#
   Object.dy#      =(Sin(Object.angle))*object.speed#
   Object.alpha#  =1- Object.y#/SCREENH
   Object.drotangle   =RndRange(-36,36)
   
   object.im=GetFreeImage()
   Create3DImage object.im,size,size
   RenderToImage object.im
   
   If switch = 0
   Ink RGB(r,g,b)
   DrawShape starshape,size/2,size/2,2
   EndIf
   
   If switch =1
   RenderToImage object.im
   Cls RGB(r,g,b)
   EndIf
   
   
   object.sp=GetFreeSprite()
   CreateSprite object.sp
   SpriteImage object.sp,object.im
   SpriteDrawMode object.sp,2+4
   AutoCenterSpriteHandle object.sp,True

   Next


EndFunction


Function calcparticles()
   
      RenderToScreen
      
      NumbOfParticles=0
      
      For Each Object()

         Object.x#=Object.x#+Object.dx#
         Object.dy#=Object.dy#+grav#   
         Object.y#=Object.y#+Object.dy#
         Object.rotangle=Object.rotangle+Object.drotangle      
         Object.alpha#  =1- Object.y#/SCREENH
         
               
         If PointInBox(Object.x#,Object.y#,0,0,SCREENW,SCREENH)=False
            
            DeleteImage object.im
            DeleteSprite object.sp
            Object = NULL
                  
            Continue           
         
         Else
      
            RotateSprite object.sp,Object.rotangle
            SpriteAlphaLevel object.sp, Object.alpha#
            PositionSprite object.sp,Object.x#,Object.y#
            
            DrawSprite object.sp
      
         EndIf   
                              
         Inc NumbOfParticles

      Next

   
EndFunction



[/pbcode]