sync on
sync rate 30
set display mode 1024,768,32
 
Type MagnetInfo
   Xpos
   Ypos
   Str#
endtype
type BallInfo
   Xspeed#
   Yspeed#
   Zspeed#
   Xpos#
   Ypos#
   Used
endtype
type BasicBallInfo
   AirFric#
   GndFric#
   Grav#
endtype
type MouseInfo
   Left
   Right
 
   StartX
   StartY
endtype
 
global Mouse as MouseInfo
dim Balls(0) as BallInfo
 
Setup_Ground()
Setup_Mags(20)
Setup_Ball()
 
do
   `draw the ground
   for Xpos = 0 to screen width() step 100
   for Ypos = 0 to screen height() step 100
   paste image GroundImage,Xpos,Ypos
   next Ypos
   next Xpos
 
   `draw the sky
   ink RGB(0,255,255),0
   for Xpos = 0 to screen width()
      line Xpos,0,Xpos,screen height()-GroundHeight(Xpos)
   next Xpos
 
   `draw the magnets
   for MagSlot = 0 to array count(Magnets(0))
      paste image MagImage,Magnets(MagSlot).Xpos-25,Magnets(MagSlot).Ypos-25,1
   next MagSlot
 
   `move the ball around
   Handle_Balls()
 
   `handle user clicking
   if mouseclick() = 1 and Mouse.Left = 0
      Mouse.Left = 1
 
      `rember this as the start of the click
      Mouse.StartX = MouseX()
      Mouse.StartY = MouseY()
   endif
   `handle mouse holding
   if mouseClick() = 1 and Mouse.Left = 1
      ink rgb(255,255,0),0
      line Mouse.StartX,Mouse.StartY,MouseX(),MouseY()
   endif
   `handle the end of a click
   if mouseClick() = 0 and Mouse.Left = 1
      Mouse.Left = 0
      `create a new ball
      BallSlot = Create_Ball()
 
      `set the ball to the users start post and give it new speeds
      Balls(BallSlot).Xpos# = Mouse.StartX
      Balls(BallSlot).Ypos# = Mouse.StartY
 
      Ang# = atanfull(Mouse.StartX-MouseX(),Mouse.StartY-MouseY())
      Dist# = sqrt((Mouse.StartX-MouseX())^2+(Mouse.StartY-MouseY())^2)
      Balls(BallSlot).Xspeed# = newXvalue(0,Ang#,Dist#/4.0)
      Balls(BallSlot).Yspeed# = newZvalue(0,Ang#,Dist#/4.0)
   endif
sync
loop
 
function Handle_Balls()
`go through all balls
for BallSlot = 0 to array count(Balls(0))
if Balls(BallSlot).Used = 1
   `---------------
   `handle the ball
   `---------------
   `move the ball based on speeds
   Balls(BallSlot).Xpos# = Balls(BallSlot).Xpos# + Balls(BallSlot).Xspeed#
   Balls(BallSlot).Ypos# = Balls(BallSlot).Ypos# + Balls(BallSlot).Yspeed#
 
   `apply gravity
   inc Balls(BallSlot).Yspeed#,Ball.Grav#
 
   `apply air friction
   Balls(BallSlot).Yspeed# = Balls(BallSlot).Yspeed#*Ball.AirFric#
   Balls(BallSlot).Xspeed# = Balls(BallSlot).Xspeed#*Ball.AirFric#
 
   `check for collision with all other balls
   dim TempX#(array count(Balls(0)))
   dim TempY#(array count(Balls(0)))
   for CheckSlot = 0 to array count(Balls(0))
   if Balls(CheckSlot).Used = 1 and CheckSlot <> BallSlot
   remstart
      if abs(Balls(BallSlot).Xpos#-Balls(CheckSlot).Xpos#) <= 6 and abs(Balls(BallSlot).Ypos#-Balls(CheckSlot).Ypos#) <= 6
         TempX#(BallSlot) = Balls(BallSlot).Xpos#+(Balls(BallSlot).Xpos#-Balls(CheckSlot).Xpos#)/6.0
         TempY#(BallSlot) = Balls(BallSlot).Ypos#+(Balls(BallSlot).Ypos#-Balls(CheckSlot).Ypos#)/6.0
 
         TempX#(CheckSlot) = Balls(CheckSlot).Xpos#+(Balls(CheckSlot).Xpos#-Balls(BallSlot).Xpos#)/6.0
         TempY#(CheckSlot) = Balls(CheckSlot).Ypos#+(Balls(CheckSlot).Ypos#-Balls(BallSlot).Ypos#)/6.0
      endif
 
      Dist# = sqrt((Balls(BallSlot).Xpos#-Balls(CheckSlot).Xpos#)^2+(Balls(BallSlot).Ypos#-Balls(CheckSlot).Ypos#)^2)
      Ang# = atanfull(Balls(BallSlot).Xpos#-Balls(CheckSlot).Xpos#,Balls(BallSlot).Ypos#-Balls(CheckSlot).Ypos#)+180
 
      `if it is colliding with the other ball then position in around the edge
      if Dist# <= 6
         Balls(BallSlot).Xpos# = newXvalue(Balls(BallSlot).Xpos#,Ang#,Dist#-5)
         Balls(BallSlot).Ypos# = newZvalue(Balls(BallSlot).Ypos#,Ang#,Dist#-5)
 
         `flip the speeds
         TempXSpeed# = Balls(BallSlot).Xspeed#
         TempYSpeed# = Balls(BallSlot).Yspeed#
 
         Balls(BallSlot).Xspeed# = Balls(CheckSlot).Xspeed#
         Balls(BallSlot).Yspeed# = Balls(CheckSlot).Yspeed#
 
         Balls(CheckSlot).Xspeed# = TempXSpeed#
         Balls(CheckSlot).Yspeed# = TempYSpeed#
 
      endif
remend
   endif
   next CheckSlot
 
   `apply magnets
   for MagSlot = 0 to array count(Magnets(0))
      `get the distance to this magnet
      Dist# = sqrt((Balls(BallSlot).Xpos#-Magnets(MagSlot).Xpos)^2+(Balls(BallSlot).Ypos#-Magnets(MagSlot).Ypos)^2)
      `calculate force
      Force# = (8.5*Magnets(MagSlot).Str#*10)/Dist#^2
 
      `turn the force into x/y speeds
      Ang# = atanfull(Balls(BallSlot).Xpos#-Magnets(MagSlot).Xpos,Balls(BallSlot).Ypos#-Magnets(MagSlot).Ypos)+180
      Balls(BallSlot).Xspeed# = Balls(BallSlot).Xspeed#+newXvalue(0,Ang#,Force#)
      Balls(BallSlot).Yspeed# = Balls(BallSlot).Yspeed#+newZvalue(0,Ang#,Force#)
 
      `if it is colliding with the magnet then position in around the edge
      if Dist# <= 12
         Balls(BallSlot).Xpos# = newXvalue(Balls(BallSlot).Xpos#,Ang#,Dist#-11)
         Balls(BallSlot).Ypos# = newZvalue(Balls(BallSlot).Ypos#,Ang#,Dist#-11)
 
         `apply magnet friction
         Balls(BallSlot).Yspeed# = Balls(BallSlot).Yspeed#*0
         Balls(BallSlot).Xspeed# = Balls(BallSlot).Xspeed#*0
      endif
   next MagSlot
 
   `don't let the ball go below ground
   if Balls(BallSlot).Ypos# > screen height()-Get_GroundHeight(Balls(BallSlot).Xpos#)-2
      `position in at ground level
      Balls(BallSlot).Ypos# = screen height()-Get_GroundHeight(Balls(BallSlot).Xpos#)-2
 
      `-----------------
      `calculate rolling
      `-----------------
      `get ground height difference
      Height# = Get_GroundHeight(Balls(BallSlot).Xpos#+2)
      Height# = Get_GroundHeight(Balls(BallSlot).Xpos#-2)-Height#
      Ang# = atanfull(4,Height#)
      Ang# = (Ang#-180)
      Pcnt# = Ang#/180.0
      Pcnt# = (1-(Pcnt#/0.5))-2
 
      `ajust the X and Y speeds based on height and gravity
      Balls(BallSlot).Yspeed# = Pcnt#*Ball.Grav#
      Balls(BallSlot).Xspeed# = Balls(BallSlot).Xspeed# + Pcnt#*Ball.Grav#
 
      `apply ground friction
      Balls(BallSlot).Yspeed# = Balls(BallSlot).Yspeed#*Ball.GndFric#
      Balls(BallSlot).Xspeed# = Balls(BallSlot).Xspeed#*Ball.GndFric#
   endif
 
   paste image BallImage,Balls(BallSlot).Xpos#-5,Balls(BallSlot).Ypos#-5,1
endif
next BallSlot
endfunction
 
function Setup_Ground()
   `make a ground image
   global GroundImage
   GroundImage = Get_FreeImg()
   Create_GroundImage(GroundImage)
 
   `dim the array
   Dim GroundHeight(screen width())
 
   `make rnd sin rates
   global Rate1
   global Rate2
   global Rate3
   Rate1 = rnd(4)+1
   Rate2 = rnd(4)+1
   Rate3 = rnd(4)+1
 
   `set all the heights
   for Xpos = 0 to screen width()
      GroundHeight(Xpos) = sin(Xpos*Rate1)*4+sin(Xpos*Rate2)*4+sin(Xpos*Rate3)*4+(Xpos/5.0)
   next Xpos
endfunction
 
function Setup_Mags(MagAmount)
   `dim the Mag array
   dim Magnets(MagAmount) as MagnetInfo
 
   `setup the image
   global MagImage
   MagImage = Get_FreeImg()
   Create_MagImage(MagImage,0,0,255)
 
   `randomly position the magnets
   for MagSlot = 0 to MagAmount
      Magnets(MagSlot).Xpos = rnd(screen width())
      Magnets(MagSlot).Ypos = rnd(screen height()-GroundHeight(Magnets(MagSlot).Xpos)-50)
      Magnets(MagSlot).Str# = rnd(5)+5
   next MagSlot
endfunction
 
function Setup_Ball()
   `make the image
   global BallImage
   BallImage = Get_FreeImg()
   Create_BallImage(BallImage)
 
   `setup the ball
   global Ball as BasicBallInfo
 
   Ball.AirFric# = 0.99
   Ball.GndFric# = 0.95
   Ball.Grav# = 0.5
endfunction
 
function Create_Ball()
   `find/make a ball
   for BallSlot = 0 to array count(Balls(0))
      if Balls(BallSlot).Used = 0 then exit
   next BallSlot
   if BallSlot > array count(Balls(0)) then array insert at bottom Balls(0)
 
   `setup the ball
   Balls(BallSlot).Used = 1
endfunction BallSlot
 
function Create_GroundImage(ImgNum)
   TempBmp = Get_FreeBmp()
   create bitmap TempBmp,100,100
   cls RGB(128,64,0)
 
   `draw the dirt
   for X = 0 to 100 step 10
   for y = 0 to 100 step 10
      `make the box a random shade of brown
      Pcnt# = rnd(100)/100.0
      ink RGB(150*Pcnt#,100*Pcnt#,0),0
      box X,Y,X+10,Y+10
   next y
   next x
 
   `go through twice and make shades of green for grass
   for Num = 1 to 2
   for X = -10 to 100
   for y = -10 to 100
      `get a shade
      ink RGB(0,rnd(100)+50,0),0
      inc sin#
      box X,Y,X+(sin(sin#)*2)*(rnd(7)+1),Y+(cos(sin#)*2)*(rnd(7)+1)
   next y
   next x
   blur bitmap TempBmp,2
   next Num
 
   `save the image
   get image ImgNum,0,0,100,100
   delete bitmap TempBmp
endfunction
 
function Create_MagImage(ImgNum,Red,Green,Blue)
make memblock 1,4*50*50+12
write memblock dword 1,0,50
write memblock dword 1,4,50
write memblock dword 1,8,32
 
for X = 0 to 50
for y = 0 to 50
 
Dist# = sqrt((X-25)^2+(Y-25)^2)
if Dist# < 10
   Pcnt# = 1-(Dist#/20.0)
   `Pcnt# = abs(sin(Pcnt#*45))
 
   MemPos = (Y*50+X)*4+12
 
   write memblock byte 1,MemPos,Red*Pcnt#
   write memblock byte 1,MemPos+1,Green*Pcnt#
   write memblock byte 1,MemPos+2,Blue*Pcnt#
 
   `get a differnt percent for alpha
   Pcnt# = 1-(Dist#/20.0)
   Pcnt# = abs(sin(Pcnt#*90))
   write memblock byte 1,MemPos+3,255
endif
next Y
next X
 
make image from memblock ImgNum,1
delete memblock 1
endfunction
 
function Create_BallImage(ImgNum)
make memblock 1,4*10*10+12
write memblock dword 1,0,10
write memblock dword 1,4,10
write memblock dword 1,8,32
 
for X = 0 to 10
for Y = 0 to 10
   MemPos = (Y*10+X)*4+12
 
   `make shure its within a certan dist from center
   Dist# = sqrt((X-5)^2+(Y-5)^2)
   if Dist# < 2.5
      Pcnt# = 1-(Dist#/5.0)
      `Pcnt# = abs(sin(Pcnt#*90))
 
      write memblock byte 1,MemPos,128*Pcnt#
      write memblock byte 1,MemPos+1,255*Pcnt#
      write memblock byte 1,MemPos+2,0*Pcnt#
      write memblock byte 1,MemPos+3,255
   endif
 
next Y
next X
 
make image from memblock ImgNum,1
delete memblock 1
endfunction
 
function Get_GroundHeight(Xpos#)
  Height# = sin(Xpos#*Rate1)*4+sin(Xpos#*Rate2)*4+sin(Xpos#*Rate3)*4+(Xpos#/5.0)
endfunction Height#
 
`get the first open ID
function Get_FreeBmp()
   repeat
      inc BmpID
   until Bitmap exist(BmpID) = 0
endfunction BmpID
function Get_FreeImg()
   repeat
      inc ImgID
   until Image exist(ImgID) = 0
endfunction ImgID
function Get_FreeObj()
   repeat
      inc ObjID
   until Object exist(ObjID) = 0
endfunction ObjID