REM ***********************************************
REM Title: spinning coins
REM Author: Phaelax
REM Downloaded from: http://dbcc.zimnox.com/
REM ***********************************************
 
sync on
sync rate 0
 
rem "speed" and "acc" attributes are only used
rem for the falling coins demonstration and can
rem be removed from the UDT
type Coin
   x as integer
   y as float
   timestamp as integer
   width as integer
   radius as integer
   side as integer
   color as dword
   speed as float
   acc as float
endtype
 
dim coins(10) as Coin
 
for c = 1 to array count(coins())
   coins(c).x = rnd(640)
   coins(c).y = 0-rnd(100)
   coins(c).radius = 10
   coins(c).width = rnd(8)+2
   coins(c).side = rnd(1)
   coins(c).color = rgb(150,150,30)
   coins(c).timestamp = timer()
   coins(c).acc = 0.5
next c
 
do
   cls
 
   rem drop those coins!
   for c = 1 to array count(coins())
      coins(c).speed = coins(c).speed + coins(c).acc
      coins(c).y = coins(c).y + coins(c).speed
      if coins(c).y >= screen height()-coins(c).radius
         coins(c).y = screen height()-coins(c).radius
         coins(c).speed = coins(c).speed*-0.8
      endif
   next c
 
   animateCoins()
   text 2,2, str$(screen fps())
 
sync
loop
 
 
 
function animateCoins()
   lock pixels
   time = timer()
   for c = 1 to array count(coins())
      if time > coins(c).timestamp+20
         if coins(c).side = 0
            coins(c).width = coins(c).width - 1
         else
            coins(c).width = coins(c).width + 1
         endif
         if coins(c).width >= coins(c).radius
            coins(c).side = 0
            coins(c).width = coins(c).radius
         endif
         if coins(c).width <= 2
            coins(c).side = 1
            coins(c).width = 2
            if coins(c).color = rgb(150,150,30)
               coins(c).color = rgb(240,200,0)
            else
               coins(c).color = rgb(150,150,30)
            endif
         endif
         coins(c).timestamp = timer()
      endif
      ink coins(c).color, 0
      for xrad = 1 to coins(c).width
         ellipse coins(c).x, coins(c).y, xrad, coins(c).radius
      next xrad
   next c
   unlock pixels
endfunction