Graphics 800,600,16,2
Dim feld(6,5)
SeedRnd MilliSecs()
Repeat

   Color 0,0,200
   Rect 10,20,640,560
   Color 0,0,0
   For x = 0 To 6
      For y = 0 To 5
         Select feld(x,y)
            Case 0
               Color 0,0,0
            Case 1
               Color 255,0,0
            Case 2
               Color 255,255,0
         End select
         Oval x*90 + 20,y*90 + 30,80,80
      Next
   Next
   
   Select p
      Case 0
         Color 255,0,0
      Case 1
         Color 255,255,0
   End Select
   Oval 700,5,80,80
   Color 255,255,255
   Text 700,100, z
   Flip   
   Cls   
   If Not win
      put(KI(p),p+1)
      p = Not p
      z = z + 1
      win = check()
   Else
      Select win
      Case 1
         Color 255,0,0
      Case 2
         Color 255,255,0
      End Select
      Text 0,0,"Spieler "+win+" gewinnt"
   End If


Until KeyHit(1)

Function put(x,t)
   For y = 5 To 0 Step -1
      If Not feld(x,y)
         feld(x,y) = t
         Return 1
      End if
   Next
End Function

Function check()
   For x = 0 To 6
      For y = 0 To 5
         Color 0,0,255
         If checkline(x,y,0,1) Return feld(x,y)
         If checkline(x,y,1,1) Return feld(x,y)
         If checkline(x,y,-1,1) Return feld(x,y)
         If checkline(x,y,1,0) Return feld(x,y)
      Next
   next
End Function

Function checkline(x,y,xm,ym)
   p = feld(x,y)
   If Not p Return 0
   For d = 1 To 3
      If x+d*xm > 6 Return 0
      If y+d*ym > 5 Return 0
      If feld(x+d*xm, y+d*ym) <> p Return 0
   Next
   Return 1
End Function

;---------------------
;- Hier kommt die KI -
;---------------------

Function KI(p)
   If Not p
      Return Rand(0,6)
   Else
      FlushKeys()
      Repeat
      for k = 2 To 8
         If KeyDown(k) Return k-2
      Next
      Forever
   End if
End Function