rem Falling Objects by Caleb Stewart
rem DBC Challenge entry
Sync on
Sync rate 100
set display mode 640,480,16
 
rem Dot Information
dim maxDot(0)
maxDot(0) = 10000
m = maxDot(0)
dim dots(m)
dim dotx#(m)
dim doty#(m)
dim dotType(m)
dim dotWeight#(m)
dim dotVolX#(m)
dim dotVolY#(m)
dim dotTimer(m)
dim dotData(m, 5)
dim freeDot(0) : freeDot(0) = 1
dim maxUpdate(0)
dim DotCount(0)
 
rem Environment information
dim gravx#(0) : gravx#(0) = 0.0
dim gravy#(0) : gravy#(0) = 0.8
dim windAng#(0) : windAng#(0) = 0.0
dim windForce#(0) : windForce#(0) = 0.0
MAP_WIDTH = bitmap width(0) : map_height = bitmap height(0)
dim map_width(0) : map_width(0) = map_width
dim map_height(0) : map_height(0) = map_height
 
rem Screen Map for collision
dim Screen(map_width, map_height)
 
rem different types of dots
dim TYPE_BALL(0) : TYPE_BALL(0) = 1
dim TYPE_FIRE(0) : TYPE_FIRE(0) = 2
dim TYPE_GLASS(0) : TYPE_GLASS(0) = 3
dim TYPE_DUST(0) : TYPE_DUST(0) = 4
dim TYPE_NORM(0) : TYPE_NORM(0) = 5
dim TYPE_WATER(0) : TYPE_WATER(0) = 6
dim TYPE_WALL(0) : TYPE_WALL(0) = 7
 
dropType = 1
 
set text size 5
 
do
 
   ink rgb(255,255,255),0
   print "Screen FPS: "; Screen FPS()
   print "Number of dots on screen: "; dotCount(0)
   print "Press 1 - 7 to select a tool"
   print "Press backspace to use the delete tool."
   PrintInstructions(dropType)
 
   if mouseclick() = 1
      if hold = 0
         select dropType
            case TYPE_FIRE(0)
               for x=1 to 10
                  CreateDot(mousex()+rnd(20)-10.0,mousey()+rnd(20)-10.0, TYPE_FIRE(0))
               next x
            endcase
            case TYPE_WATER(0)
               for x=1 to 10
                  CreateDot(mousex()+rnd(20)-10.0,mousey()+rnd(20)-10.0, TYPE_WATER(0))
               next x
            endcase
            case TYPE_GLASS(0)
               for x=0 to 10
                   CreateDot(mousex()+x+0.0,mousey()+y+0.0, TYPE_GLASS(0))
               next x
               Hold = 1
            endcase
            case TYPE_WALL(0)
               for x=-2 to 2
                  for y=-2 to 2
                     CreateDot(mousex()+x+0.0,mousey()+y+0.0, TYPE_WALL(0))
                  next y
               next x
            endcase
            case 150
               for x=-2 to 2
                  for y=-2 to 2
                     if (mousex()+x) >= 0 and (mousex()+x) =< map_width(0) and (mousey()+y) >= 0 and (mousey()+y) <= map_height(0)
                        DestroyDot(safecheck(mousex()+x+0.0,mousey()+y+0.0))
                     endif
                  next y
               next x
            endcase
            case default
               if dropType ! 5 then CreateDot(mousex()+0.0,mousey()+0.0,dropType)
            endcase
         endselect
      endif
   else
      hold = 0
   endif
 
   if dropType = 5
      x2 = sin(windAng#(0)) * 30
      y2 = cos(windAng#(0)) * 30
      line map_width(0)/2,map_height(0)/2,map_width(0)/2+x2,map_height(0)/2+y2
 
      o# = mouseX() - map_width(0)/2 : a# = mousey() - map_height(0)/2
      windAng#(0) = wrapvalue(atanfull(o#,a#))
      if mouseclick() = 1
         if rlDown = 0 and windForce#(0) < 10.0
            windForce#(0) = windForce#(0) + 0.1
            rlDown = 1
         endif
      endif
      if mouseclick() = 2 and rlDown = 0 and windForce#(0) >= 0.0
         windForce#(0) = windForce#(0) - 0.1
      endif
      if mousemovez() > 0
         windForce#(0) = windForce#(0) + (mousemovez()/10)
      endif
      rlDown = 0
   endif
 
   if val(inkey$()) >= 1 and val(inkey$()) <= 7
      dropType = val(inkey$())
   endif
 
   if keystate(14) = 1 then dropType = 150
 
   updateDots()
   sync
   cls
loop
 
function PrintInstructions(Type)
 
   select Type
      case 5
         print
         Print "Wind Tool:"
         print
         Print "Use up and down keys to change direction."
         Print "Use left and right mouse buttons or mouse wheel to change the force."
         print "Wind Angle = "; WindAng#(0)
         print "Wind Force = "; WindForce#(0)
         print
      endcase
      case TYPE_GLASS(0)
         print
         print "Glass Tool:"
         print
         print "Click to drop a plate of glass and watch it shatter!"
         print
      endcase
      case TYPE_FIRE(0)
         print
         print "Fire Tool:"
         print
         print "Click to send fire through the air!"
         print "Fire will burn up other dots!"
         print
      endcase
      case TYPE_BALL(0)
         print
         print "Ball Tool:"
         print
         print "Unlease the power of the super ball!"
         print "The higher you drop it from, the Higher it will go!"
         print
      endcase
      case TYPE_DUST(0)
         print
         print "Dust Tool:"
         print
         print "Drop the dust and  watch it stack."
         print "Use the wind tool to make it fly across the screen!"
         print
      endcase
      case TYPE_WALL(0)
         print
         print "Wall Tool:"
         print
         print "Click to place 4x4 walls."
         print "The walls will hold in other dots."
         print
      endcase
   endselect
 
endfunction
 
rem Draw and update all the dots
function UpdateDots()
   for i = 0 to maxUpdate(0)
      if dots(i) = 1
         findDotFunction(i)
      endif
   next i
endfunction
 
rem Find the correct dot controller by type
function findDotFunction(i)
 
   select dotType(i)
      case TYPE_BALL(0)
         controlBall(i)
      endcase
      case TYPE_DUST(0)
         controlDust(i)
      endcase
      case TYPE_NORM(0)
         controlNorm(i)
      endcase
      case TYPE_FIRE(0)
         controlFire(i)
      endcase
      case TYPE_WATER(0)
         controlWater(i)
      endcase
      case TYPE_GLASS(0)
         controlGlass(i)
      endcase
      case TYPE_WALL(0)
         controlWall(i)
      endcase
      case default
         controlNorm(i)
      endcase
   endselect
 
endfunction
 
function StartCollisionMatters(type)
 
   select type
      case default
         exitfunction 1
      endcase
   endselect
 
endfunction 1
 
rem Create a dot. ready for updating.
function CreateDot(x#, y#, type)
   rem check to see if position is on screen
   if x# < 0 or x# > map_width(0)-1 or y# < 0 or y# > map_height(0)-1 then exitfunction
   rem if there is already a dot at this position, don't create it
   if screen(x#,y#) > 0 and StartCollisionMatters(type) = 1 then exitfunction
   rem if there are no more dots exit the function
   if freeDot(0) = -1 then exitfunction
 
   DotCount(0) = DotCount(0) + 1
 
   weight# = findTypeWeight(type)
   index = freeDot(0)
   dots(index) = 1
   dotx#(index) = x#
   doty#(index) = y#
   dotType(index) = type
   dotWeight#(index) = weight#
 
   rem Set the screen collision coordanet to the dot index
   screen(x#,y#) = index
 
   rem Set Dot timer to the current time
   dotTimer(index) = timer()
 
   rem If the max updated dot is less then this dot
   rem set it to this dot
   if maxUpdate(0) < index then maxUpdate(0) = index
 
   rem search up
   while index < maxDot(0) and dots(index) = 1
      index = index + 1
   endwhile
   rem if no free spaces up
   if index = maxDot(0)
      rem then search down
      while index > 0
         if dots(index) = 0 then exit
         index = index - 1
      endwhile
      rem if no free spaces. set freeDot(0) to -1
      if index = 0 then index = -1
   endif
   freeDot(0) = index
 
endfunction
 
function DestroyDot(i)
   rem if the dot doesn't exist the exit the function
   if dots(i) = 0 then exitfunction
 
   DotCount(0) = DotCount(0) - 1
 
   rem set collision position to 0
   screen(dotx#(i),doty#(i)) = 0
   rem set all values to 0
   dots(i) = 0
   dotx#(i) = 0.0
   doty#(i) = 0.0
   dotType(i) = 0
   dotWeight#(i) = 0.0
   dotTimer(i) = 0
   for x=i to maxUpdate(0)
      dots(x) = dots(x+1)
      dotx#(x) = dotx#(x+1)
      doty#(x) = doty#(x+1)
      dotType(x) = dotType(x+1)
      dotWeight#(x) = dotWeight#(x+1)
      dotTimer(x) = dotTimer(x+1)
   next x
   freeDot(0) = maxUpdate(0)
   maxUpdate(0) = freeDot(0) - 1
endfunction
 
rem Find the weight of the ball according to its type
function findTypeWeight(type)
 
   select type
      case TYPE_BALL(0)
         weight# = 0.5
      endcase
      case TYPE_FIRE(0)
         weight# = -0.5
      endcase
      case TYPE_NORM(0)
         weight# = 0.8
      endcase
      case TYPE_DUST(0)
         weight# = 0.2
      endcase
      case TYPE_WATER(0)
         weight# = 1.2
      endcase
      case TYPE_GLASS(0)
         weight# = 0.3
      endcase
      case TYPE_WALL(0)
         weight# = 0.0
      endcase
      case TYPE_ICE
      endcase
      case default
         weight# = 0.0
      endcase
   endselect
 
endfunction weight#
 
rem Type Controller functions
function controlDust(i)
 
   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
 
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))
 
 
   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if ny# < 0 then ny# = 0 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = -1 : dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
 
   rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      if ny# ! y#
         if nx# ! x#
            collision = 3
         else
            collision = 2
         endif
      else
         if nx# ! x#
            collision = 1
         endif
      endif
      dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
      c = screen(nx#, ny#)
   else
      collision = 0
   endif
 
   if collision ! 0 then dotVolX#(i) = 0.0 : dotVolY#(i) = 0.0
 
   screen(x#,y#) = 0
   if (collision | 1) ! collision
      dotx#(i) = nx#
   endif
   if (collision | 2) ! collision
      doty#(i) = ny#
   endif
   screen(dotx#(i),doty#(i)) = i
 
   ink rgb(255,255,255),0
   dot dotx#(i),doty#(i)
endfunction
 
function controlBall(i)
   rem will eventually control a bouncy ball type of dot
 
   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   if dotData(i, 0) = 0 then dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   if dotData(i, 1) = 0 then dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))
 
   if dotVolY#(i) > 10.0 then dotVolY#(i) = 10.0
   if dotVolY#(i) < -10.0 then dotVolY#(i) = -10.0
   if dotVolX#(i) > 10.0 then dotVolX#(i) = 10.0
   if dotVolX#(i) < -10.0 then dotVolX#(i) = -10.0
 
   collision = 0
 
   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = collision | 1
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = collision | 1
   if ny# < 0 then ny# = 0 : collision = collision | 2
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = collision | 2
 
   rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      if ny# ! y#
         if nx# ! x#
            collision = collision | 3
         else
            collision = collision | 2
         endif
      else
         if nx# ! x#
            collision = collision | 1
         endif
      endif
   endif
 
 
   screen(x#,y#) = 0
   if (collision | 1) ! collision
      dotx#(i) = nx#
   else
      dotVolX#(i) = dotVolX#(i) * -1
      dotData(i, 0) = 1
   endif
   if (collision | 2) ! collision
      doty#(i) = ny#
   else
      dotVolY#(i) = dotVolY#(i) * -1
      dotData(i, 1) = 1
   endif
   screen(dotx#(i),doty#(i)) = i
 
   ink rgb(0,0,255),0
   dot dotx#(i),doty#(i)
endfunction
 
function controlFire(i)
   rem will eventually control a fire type of dot(burns through other dots)
   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))
 
   if dotVolY#(i) > 3.0 then dotVolY#(i) = 3.0
   if dotVolY#(i) < -3.0 then dotVolY#(i) = -3.0
   if dotVolX#(i) > 3.0 then dotVolX#(i) = 3.0
   if dotVolX#(i) < -3.0 then dotVolX#(i) = -3.0
 
   collision = 0
 
   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = -1
 
   rem check for collision
   if screen(nx#, ny#) > 0 and screen(nx#, ny#) ! i
      collision = screen(nx#, ny#)
   endif
 
   screen(x#,y#) = 0
   if collision ! 0 or (timer()-dotTimer(i)) > 500
      if collision > 0
         DestroyDot(i)
         if dotType(collision) ! TYPE_FIRE(0)
            DestroyDot(collision)
         endif
      else
         DestroyDot(i)
      endif
   else
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(dotx#(i), doty#(i)) = i
   endif
 
   ink rgb(255,0,0),0
   dot dotx#(i),doty#(i)
endfunction
 
function controlWater(i)
 
 
   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
   dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))
 
   Collision = 0
 
   if safecheck(nx#,ny#) > 0 and safecheck(nx#,ny#) ! i
      collision = 1
      nx# = x# : ny# = y#
   endif
 
   if collision <> 0
      if safecheck(nx#+1, ny#) = 0
         nx# = nx# + 1
      else
         if safecheck(nx#-1, ny#) = 0
            nx# = nx# - 1
         endif
      endif
      if safecheck(nx#,ny#+1) = 0
         ny# = ny# + 1
      endif
   endif
 
   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = -1
 
      screen(x#,y#) = 0
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(nx#,ny#) = i
 
   ink rgb(0,0,255),0
   dot dotx#(i),doty#(i)
 
endfunction
 
function controlGlass(i)
 
   rem get new and old dot positions
   x# = dotx#(i) : y# = doty#(i)
   nx# = x# + dotVolX#(i)
   ny# = y# + dotVolY#(i)
   if windForce#(0) > 0.0
      movX# = sin(windAng#(0)) * windForce#(0)
      movY# = cos(windAng#(0)) * windForce#(0)
      nx# = nx# + movX#
      ny# = ny# + movY#
   endif
 
   collision = 0
 
   rem check if new x and new y is off screen.
   if nx# < 0 then nx# = 0 : collision = -1
   if nx# > map_width(0)-1 then nx# = map_width(0)-1 : collision = -1
   if ny# < 0 then ny# = 0 : collision = -1
   if ny# > map_height(0)-1 then ny# = map_height(0)-1 : collision = -1
 
   if screen(nx#,ny#) > 0 and screen(nx#,ny#) ! i or collision ! 0
 
      if dotVolY#(i) > 10 or dotVolX#(i) > 10
         if dotData(i, 0) = 0
            dotVolY#(i) = rnd(10)-5.0
            dotVolX#(i) = rnd(10)-5.0
            dotData(i, 0) = 1
            dotData(i, 1) = timer()
         endif
      else
      endif
 
      collision = 1
 
   else
      if collision = 0
         dotVolY#(i) = dotVolY#(i) + (gravy#(0)*dotWeight#(i))
         dotVolX#(i) = dotVolX#(i) + (gravx#(0)*dotWeight#(i))
      endif
   endif
 
 
   if collision = 0
      screen(x#,y#) = 0
      dotx#(i) = nx#
      doty#(i) = ny#
      screen(nx#,ny#) = i
   endif
 
   ink rgb(210, 205, 220),0
   dot dotx#(i),doty#(i)
 
endfunction
 
function controlNorm(i)
   rem Idk
endfunction
 
function controlWall(i)
 
   ink rgb(100, 100, 100),0
   dot dotx#(i),doty#(i)
 
endfunction
 
function safecheck(x#,y#)
   if x# < 0 or x# > map_Width(0)-1 or y# < 0 or y# > map_Height(0)-1 then exitfunction 1
endfunction screen(x#,y#)