Graphics 800,600,16,2
ClsColor 10,50,10
SeedRnd MilliSecs()

Const Radi=20 , RadiSqr#=(Radi*Radi)*0.5

Type body
   Field I%
   Field x#,y#
   
   Field fix
End Type
Type food
   Field x,y
End Type

Const grS = Radi * 1
Const grX = 800 / grS
Const grY = 600 / grS
Global b1.body

Dim GridBody.Body(grX + 1,grY + 1 , 24)
Dim GridCount(0 , 0)

AutoMidHandle True

Global Image = CreateImage(Radi , Radi , 30)
SetBuffer ImageBuffer(Image , 0) : Color   0,250, 50 : Oval 0 , 0 , Radi , Radi
SetBuffer ImageBuffer(Image , 1) : Color  50, 10,250 : Oval 0 , 0 , Radi , Radi
For t = 2 To 29
   SetBuffer ImageBuffer(Image , t):Color 255 , t*5 , t*5 : Oval 0 , 0 , Radi , Radi
Next   
Color 255 , 255 , 255
SetBuffer BackBuffer()

For t=1 To 10
   b1 = New body
   b1\x = Rand(80,720): b1\y = Rnd(80,520) : b1\fix = 1 : b1\i=1
Next

b1 = New body
b1\x = 400 : b1\y = 300 : b1\i = 2
f.food=New food
f\x=50 : f\y=50

Function TestCollisions()
   ;Setup collision grid
   Dim GridCount(grX + 1 , grY + 1)
   For b.body = Each body
      gx = Floor(b\x / GrS)
      gy = Floor(b\y / GrS)
      GridBody(gx , gy , GridCount(gx , gy)) = b
      GridCount(gx , gy) = GridCount(gx , gy) + 1
   Next

   ;test bodies in each cell against bodies in neighbour cells
   For y1 = 1 To grY - 1
   For x1 = 1 To grX - 1
      For c1 = 0 To GridCount(x1 , y1) - 1
         bodyA.body = GridBody(x1 , y1 , c1)

         If bodyA\fix = 0
         For x2 = x1 - 1 To x1 + 1
         For y2 = y1 - 1 To y1 + 1
            If x2 > -1 And x2 < grX And y2 > -1 And y2 < grY
               For c2 = 0 To GridCount(x2 , y2) - 1
                  bodyB.body = GridBody(x2 , y2 , c2)

                  If bodyA<>bodyB And (bodyA\fix = 0 Or bodyB\fix = 0)
                     dx# = bodyA\x - bodyB\x
                     dy# = bodyA\y - bodyB\y
                     d# = (dx * dx + dy * dy)
                     If d > 0 And d < (RadiSqr * 1.8) - 2
                        d = Sqr(d)
                        dx = dx / d
                        dy = dy / d
                        bodyA\x = bodyA\x + dx
                        bodyA\y = bodyA\y + dy
                        If bodyB\fix = 0
                           bodyB\x = bodyB\x - dx
                           bodyB\y = bodyB\y - dy
                        EndIf   

                        Exit
                     EndIf
                  EndIf
               Next
            EndIf   
         Next
         Next
         EndIf
      Next
   Next
   Next
End Function

Function AnimateBody()
   ;move to cursor
   mx# = (MouseX() - b1\x)
   my# = (MouseY() - b1\y)
   s# = Sqr(mx * mx + my * my) * 2
   If s > 0   
      b1\x = b1\x + (mx / s) : If b1\x<Radi b1\x=Radi : mx = 0 Else If b1\x>800-Radi b1\x=800-Radi : mx=0
      b1\y = b1\y + (my / s) : If b1\y<Radi b1\y=Radi : my = 0 Else If b1\y>600-Radi b1\y=600-Radi : my=0
   EndIf

   ;each bodypart is moving to the following bodypart
   For b.body = Each body
      bb.body = Before b
      If bb <> Null
      If bb\fix=0
         dx# = (b\x - bb\x)
         dy# = (b\y - bb\y)
         d# = (dx * dx + dy * dy)
         If d > (RadiSqr * 2)
            d = Sqr(d)
            bb\x = bb\x + (dx / d)
            bb\y = bb\y + (dy / d)
         EndIf
      EndIf
      EndIf
      
      If b\x<Radi b\x=Radi Else If b\x>800-Radi b\x=800-Radi
      If b\y<Radi b\y=Radi Else If b\y>600-Radi b\y=600-Radi
   
      DrawImage Image , b\x , b\y , b\i
   Next
End Function

Function TestFood()
   For f.food = Each food
      DrawImage Image , f\x , f\y , 0
      Text f\x , f\y - Radi , "eat me!" , 1 , 1

      If Abs(f\x - b1\x) < Radi And Abs(f\y - b1\y) < Radi
         For b.body=Each body
            If b\fix=0 bf.body=b:Exit
         Next
         bn.body = New body
         Insert bn Before bf
         bn\x = bf\x
         bn\y = bf\y
         bn\i = Rand(2 , 29)
         b1 = Last body

         f\x=Rand(30,770)
         f\y=Rand(30,570)
      EndIf
   Next
End Function


While Not KeyHit(1)

   AnimateBody()   
   
   TestCollisions()

   TestFood()

   fp = fp + 1:If MilliSecs() > mt  AppTitle fp: fp = 0:mt = MilliSecs() + 1000
   Text 0,0,"Maussteuerung"
   Flip 0
   Cls
Wend