Global PCStrength=5000                          ;Anzahl der Testspiele für PC
Global WinCount=4                               ;Länge der Gewinnreihe
Global BoardWidth=7                             ;Felder Horizontal         
Global BoardHeight=6                            ;Felder Vertikal   
Global Size=50                                  ;Größe der Felder
Global CurrentPlayer
Global TEST=False
Global LastX,LastY                              ;zuletzt gespieltes Feld
Dim Board(BoardWidth,BoardHeight, 2)            ;das Spielfeld

Graphics BoardWidth*Size,(BoardHeight+1)*Size,16,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()

Type Line                                       ;zum Speichern der letzten Gewinnreihe
   Field x,y
End Type

Function newGame()
   CurrentPlayer=Rand(1,2)                     ;Spieler "auswürfeln"
   LastX=-1 : LastY=-1
   For yy=0 To BoardHeight-1
   For xx=0 To BoardWidth-1
      Board(xx,yy,0)=0                        ;Steine vom Spielfeld löschen         
   Next
   Next

   For l.Line=Each Line : Delete l : Next

   FlushKeys()
   Cls : Draw() : Flip
End Function

Function GameOver(Message$)
   Color 255,255,255
   Text GraphicsWidth()*0.5,10,Message, 1

   Draw()
   Color 0,0,0                                 ;Gewinnreihe anzeigen
   For l.Line=Each Line
      Oval l\x*Size+15,l\y*Size+Size+15,Size-30,Size-30
      Board(l\x,l\y, 0)=0
   Next
   Color 0,0,255 : Oval LastX*Size+15,LastY*Size+Size+15,Size-30,Size-30   
   Flip
   Repeat
      If MouseHit(1) Exit Else If KeyHit(1) End      
   Forever
   FlushKeys() : FlushMouse()
   newGame()
End Function


Function SetStone(x)
   full=True                                   ;Spielfeld voll?
   For xx=0 To BoardWidth-1
      If Board(xx,0,TEST)=0 full=False : Exit
   Next
   If full=True
      If TEST=0 GameOver("UNENTSCHIEDEN")   Else Return -2
   EndIf   

   For y=0 To BoardHeight-1                    ;Reihe voll?
      If Board(x,y,TEST)<>0 Exit
   Next
   If y=0 Return -1

   Board(x,y-1,TEST)=CurrentPlayer             ;Stein setzen
   Result=checkwin(x,y-1)                      ;Steine zählen
   LastX=x : LastY=y-1
   
   If TEST=False
      If Result>=WinCount                     ;Gewonnen?
         If CurrentPlayer=1 GameOver("ROT gewinnt") Else GameOver("GELB gewinnt")
      EndIf
   EndIf

   ;Spieler tauschen
   If CurrentPlayer=1 CurrentPlayer=2 Else CurrentPlayer=1

   Return Result
End Function

Function checkWin(x,y)                          ;Funktion zum zählen der zusammenhängenden Steine
   ;suche links-rechts:
   For l.Line=Each Line : Delete l : Next
   c=CountStones(x,y, -1, 0)+CountStones(x,y, 1, 0)-1 : If c>=WinCount Return c
   ;suche oben-unten:
   For l.Line=Each Line : Delete l : Next
   c=CountStones(x,y,  0,-1)+CountStones(x,y, 0, 1)-1 : If c>=WinCount Return c
   ;suche diagonal:
   For l.Line=Each Line : Delete l : Next
   c=CountStones(x,y, -1,-1)+CountStones(x,y, 1, 1)-1 : If c>=WinCount Return c
   For l.Line=Each Line : Delete l : Next
   c=CountStones(x,y, -1, 1)+CountStones(x,y, 1,-1)-1 : If c>=WinCount Return c
End Function
Function CountStones(x,y, dirX,dirY)
   Repeat
      Count=Count+1
      If TEST=0 l.Line=New Line : l\x=x : l\y=y
      x=x+dirX : y=y+dirY
      If x<0 Or x>BoardWidth-1 Or y<0 Or y>BoardHeight-1 Exit
      If Board(x,y, TEST)<>CurrentPlayer Exit
   Forever
   Return Count
End Function

Function CalculateMove(Computer)
   TEST=True                                   ;Testmodus anschalten

   For x=0 To BoardWidth-1                     ;der PC testet nacheinander alle Reihen durch
      wMax=0
      For t=1 To PCstrength                   ;Testspiele starten
         For yy=0 To BoardHeight-1           ;Spielfeld in Ausgangslage bringen
         For xx=0 To BoardWidth-1
            Board(xx,yy, TEST)=Board(xx,yy,0)   
         Next
         Next

         CurrentPlayer=Computer
         xx=x
         Repeat                              ;Zufällig Steine setzen bis Spiel
            Result=SetStone(xx)             ;gewonnen oder Spielfeld voll ist   
            xx=Rand(0,BoardWidth-1)
         Until (Result>=WinCount) Or (Result=-2)   

         If (CurrentPlayer<>Computer) And (Result>=WinCount) wMax=wMax+1 ;PC gewinnt - wMax um 1 erhoehen
      Next
      If wMax>WinMax WinMax=wMax : MaxX=x     ;hoechste Anzahl gewonnener Spiele (WinMax) + dazugehoerige Reihe (MaxX) merken
   Next

   TEST=False                                  ;Testmodus ausschalten

   CurrentPlayer=Computer                      ;Stein an Position mit
   Result=setStone(MaxX)                       ;maximaler Gewinnchance setzen
   
   If Result=-1                                ;Die gewählte Reihe ist voll
      For x=0 To BoardWidth-1                 ;suche nach freiem Feld               
         If Board(x,0, TEST)=0 SetStone(x) : Exit
      Next
   EndIf   
End Function

Function draw()
   Color 0,0,255                               ;Spielfeld zeichnen   
   Rect 0,size,BoardWidth*Size,BoardHeight*Size

   For y=0 To BoardHeight-1
   For x=0 To BoardWidth-1
      If Board(x,y, 0)=1 Color 255,0,0 Else If Board(x,y, 0)=2 Color 255,255,0 Else Color 0,0,0
      xx=x*Size : yy=y*Size
      Oval xx+4,yy+4+Size,Size-8,Size-8       ;Steine zeichen
   Next
   Next
   Color 0,0,255                               ;zuletzt gespielten Stein markieren
   Oval LastX*Size+15,LastY*Size+Size+15,Size-30,Size-30
End Function

newGame()

While Not KeyHit(1)
   If CurrentPlayer=1
      If MouseHit(1) Or KeyHit(57) SetStone(Int(MouseX()/size))
   Else
      CalculateMove(2)
      FlushKeys()
   EndIf   

   draw : Flip
Wend