SuperStrict


Import vertex.bnetex
Include "BesteSpalte().bmx"
Graphics 400, 300

Const wx:Int = 7
Const wy:Int = 6
Global Feld:Byte[wx,wy]
Global Farbe:Byte
Global progEnd:Byte = False

Global Game_Max:Int = 10 'Wie viele Spiele Maximal gespielt werden sollen

Global NET_portC:Byte = 2
Global NET_ports:Int[NET_portC , 2]
Global NET_otherIp:Int
Global NET_otherPort:Int

Global MessageIp:Int 'last Message IP

Global Timeout% = 15000
Global LastIncome:Int
Global SEARCH_pollIntervall:Int = 10000 'ms Until Next poll
Global SEARCH_nextPoll:Int


'Init
Net_ports[0 , 0] = 4000
Net_ports[0 , 1] = 4001
Net_ports[1 , 0] = 5000
NET_ports[1, 1] = 5001

Global rIp:Int 'remote Ip

Global iStream:TUDPStream
Global oStream:TUDPStream

Global NET_adapter:TAdapterInfo


Global Game_State% '0 = search, 1 = init game,  2=ich Bin dran, 3=anderer ist dran
Const STATE_SEARCH% = 1
Const STATE_INIT% = 2
Const STATE_MYTURN% = 3
Const STATE_OTHERTURN% = 4
Const STATE_END% = 5


Global Game_MyColor% 'Meine Farbe
Global Game_Host% 'host hat immer recht
Global Game_Round% 'Spielrunde (1 Spiel geht über mehrere Runden)
Global Game_TotalRound%
Global Game_Count% 'Spielzähler, wie viele Spiele insgesamt gespielt wurden

'Statistik
Const STAT_Savefile$ = "statistik.txt"
Global STAT_Gewonnen%
Global STAT_Verloren%
Global STAT_Remis%
Global STAT_Gespielt%
Global STAT_FunctionTime%


'Message Bytes
Const MSG_GameOpen% = 1
Const MSG_JoinGame% = 2
Const MSG_SetColor% = 3
Const MSG_StartGame% = 4
Const MSG_InsertCoin% = 5


InitNetwork()
PROCESS_SetState(STATE_SEARCH)
'Runtime
While Not progEnd
   Delay 10
   PROCESS_MAIN()
Wend

'Final
STAT_Save()
CloseNetwork()
End


Function InitNetwork()
   TNetwork.GetAdapterInfo(NET_adapter)
   iStream:TUDPStream = New TUDPStream
   oStream:TUDPStream = New TUDPStream
   
   iStream.Init()
   oStream.Init()
   
   If NET_otherIp = 0 NET_otherIp = NET_adapter.Address
   
   Local OK:Byte
   Local c:Byte = 0
   Repeat
      OK = iStream.SetLocalPort(NET_ports[c, 0])
      oStream.SetLocalPort(Net_ports[c , 1])
      If ok = False
         Net_otherPort = Net_ports[c , 0]
      Else
         NET_otherPort = NET_ports[c + 1, 0]
      EndIf
      c:+ 1
   Until c = NET_portC Or OK
   
   Print TNetwork.StringIP(NET_otherIp)
   
   rIp = NET_otherIp
   oStream.SetRemoteIp(NET_otherIp)
   oStream.SetRemotePort(NET_otherPort)
   
   Print "Status:"
   Print "ownIp: " + DottedIP(iStream.GetLocalIP())
   Print "ownPort: " + iStream.GetLocalPort()
   Print "remote Ip: " + DottedIP(rIp)
   Print "remote Ip2: " + DottedIP(oStream.GetRemoteIP())
   Print "remotePort: " + oStream.GetRemotePort()
End Function

Function CloseNetwork()
   If iStream CloseStream iStream
   If oStream CloseStream oStream
End Function

Function NET_Send()
   oStream.SendMsg()
   LastIncome = MilliSecs()
End Function

Function MSG_Process()
   If iStream.RecvAvail()
      iStream.RecvMsg()
      MessageIp = iStream.GetMsgIP()
      Select ReadByte(iStream)
         Case MSG_GameOpen Recv_GameOpen()
         Case MSG_JoinGame Recv_JoinGame()
         Case MSG_SetColor Recv_SetColor()
         Case MSG_StartGame Recv_StartGame()
         Case MSG_InsertCoin Recv_InsertCoin()
      End Select      
   EndIf
End Function


'Game Open
Function Send_GameOpen()
   WriteByte oStream,MSG_GameOpen
   NET_Send()
End Function

Function Recv_GameOpen()
   If Game_State <> STATE_SEARCH Return
   If MessageIP <> rIp Return
   Game_Host = 0
   PROCESS_SetState(STATE_INIT)
   Send_JoinGame()
End Function

'Join Game
Function Send_JoinGame()
   DebugLog "SendJoinGame"
   WriteByte oStream,MSG_JoinGame
   NET_Send()
End Function

Function Recv_JoinGame()
   DebugLog "RecvJoinGame"
   If Game_State <> STATE_SEARCH Return
   If MessageIP <> rIp Return
   Game_Host = 1
   PROCESS_SetState(STATE_INIT)
End Function

'Set Color
Function Send_SetColor(player%)
   DebugLog "SendSetColor"
   WriteByte oStream,MSG_SetColor
   WriteByte oStream,player
   NET_Send()
End Function

Function Recv_SetColor()
   DebugLog "RecvSetColor"
   If Game_State <> STATE_INIT Return
   If MessageIP <> rIp Return
   If Game_Host Return
   Game_MyColor = ReadByte(iStream)
   DebugLog "MyColor: "+GAME_MyColor
End Function

'Start Game
Function Send_StartGame()
   DebugLog "SendStartGame"
   WriteByte oStream,MSG_StartGame
   NET_Send()
   If Farbe = GAME_MyColor
      PROCESS_SetState(STATE_MYTURN)
   Else
      PROCESS_SetState(STATE_OTHERTURN)
   EndIf
End Function

Function Recv_StartGame()
   DebugLog "RecvStartGame"
   If Game_State <> STATE_INIT Return
   If MessageIP <> rIp Return
   If Farbe = GAME_MyColor
      PROCESS_SetState(STATE_MYTURN)
   Else
      PROCESS_SetState(STATE_OTHERTURN)
   EndIf
End Function

'Insert Coin
Function Send_InsertCoin(column%)
   DebugLog "SendInsertCoin: "+column
   WriteByte oStream,MSG_InsertCoin
   WriteByte oStream,column
   NET_SEND
End Function

Function Recv_InsertCoin()
   DebugLog "RecvInsertCoin"
   If Game_State <> STATE_OTHERTURN Return
   If MessageIP <> rIp Return
   Local column% = ReadByte(iStream)
   Game_InsertCoin(column,FARBE)
   Game_Step()
End Function


Function PROCESS_SetState(state%)
   If Game_State = STATE_END Return
   Game_State = state
   Select Game_State
      Case STATE_SEARCH PROCESS_SEARCH_INIT()
      Case STATE_INIT PROCESS_INIT_INIT()
      Case STATE_MYTURN PROCESS_MYTURN_INIT()
      Case STATE_OTHERTURN PROCESS_OTHERTURN_INIT()
      Case STATE_END PROCESS_END_INIT()
   End Select
End Function

Function PROCESS_MAIN()
   MSG_PROCESS()
   
   If MilliSecs() - LastIncome > Timeout And LastIncome<>0
      DebugLog "Timeout, reset to Searchstate"
      PROCESS_SetState(STATE_SEARCH)
      LastIncome = MilliSecs()
   EndIf
   
   Select Game_State
      Case STATE_SEARCH PROCESS_SEARCH()
      Case STATE_INIT PROCESS_INIT()
      Case STATE_MYTURN PROCESS_MYTURN()
      Case STATE_OTHERTURN PROCESS_OTHERTURN()
      Case STATE_END PROCESS_END()
   End Select
End Function

Function PROCESS_SEARCH_INIT()
   DebugLog "init search"
End Function

Function PROCESS_SEARCH()
   If SEARCH_nextPoll < MilliSecs()
      DebugLog "poll"
      SEARCH_nextPoll = MilliSecs() + SEARCH_pollIntervall
      Send_GameOpen()
   EndIf
   
   Cls
      DrawText "Searching...", 10, 10
   Flip
End Function

Function PROCESS_INIT_INIT()
   DebugLog "init init"
   Game_Init()
   
   If Game_Max <= Game_Count
      PROCESS_SetState(STATE_END)
   ElseIf Game_Host
      GAME_MyColor = Rand(1,2)
      DebugLog "MyColor: "+GAME_MyColor
      Send_SetColor((GAME_MyColor Mod 2) + 1)
      Send_StartGame()
   EndIf
End Function

Function PROCESS_INIT()
End Function

Function PROCESS_MYTURN_INIT()
   DebugLog "init myturn"
   
   Local time% = MilliSecs()
   Local spalte% = BesteSpalte()
   STAT_FunctionTime = STAT_FunctionTime + (MilliSecs()-time)
   Game_InsertCoin(spalte,GAME_MyColor)
   Send_InsertCoin(spalte)
   Game_Step()
End Function

Function PROCESS_MYTURN()
   BASIC_SHOW()
End Function

Function PROCESS_OTHERTURN_INIT()
   DebugLog "init otherturn"
End Function

Function PROCESS_OTHERTURN()
   BASIC_SHOW()
End Function

Function PROCESS_END_INIT()
End Function

Function PROCESS_END()
   BASIC_SHOW()
   Local key:Int = GetChar()
   If key<>0 progEnd = True
End Function


'Game Stuff
'GAMECODE
Function Game_Init()
   Local x%, y%

   Game_Round = 0
   Farbe = 1
   
   'Spielfeld säubern
   For x = 0 Until wx
   For y = 0 Until wy
      Feld[x,y] = 0
   Next
   Next
End Function

'Inserts a coin, returns False If column is full, otherwise True
Function Game_InsertCoin%(column%,player%)
   Local y%
   
   For y = 0 Until wy
      If Feld[column,y] = 0
         Feld[column,y] = player
         Return 1
      EndIf
   Next
   Return 0
End Function

Function Game_Step()
   Local win% = GAME_CheckWin()
   If win
      If win=GAME_MyColor
         STAT_Update(1)
      ElseIf win=3
         STAT_Update(3)
      Else
         STAT_Update(2)
      EndIf
      Game_Count = Game_Count + 1
      PROCESS_SetState(STATE_INIT)
      Return
   EndIf
   Game_ToggleTurn()
End Function

Function Game_ToggleTurn()
   Game_Round = Game_Round + 1
   Game_TotalRound = Game_TotalRound + 1
   FARBE = (FARBE Mod 2) + 1
   
   
   If FARBE = GAME_MyColor
      PROCESS_SetState(STATE_MYTURN)
   Else
      PROCESS_SetState(STATE_OTHERTURN)
   EndIf
End Function

'Importierte Funktion aus dem Hauptprogramm
Function GAME_CheckWin:Byte()
   'gibt 0 zur�ck, falls das Spiel noch nicht zu Ende ist.
   'gibt 1 zur�ck, wenn Rot gewonnen hat, und 2 zur�ck, wenn Gelb gewonnen hat
   'gibt 3 zur�ck, wenn keiner gewonnen hat, das Spielbrett aber voll ist: Remis!
   Local Reihe:Int, Spalte:Int, ObereSumme:Int
   'Waagerechte Viererreihen:
   For Spalte = 0 To 3
      For Reihe = 0 To 5
            If Feld[Spalte, Reihe] > 0 And Feld[Spalte+1, Reihe] = Feld[Spalte, Reihe] And Feld[Spalte+2, Reihe] = Feld[Spalte, Reihe] And Feld[Spalte+3, Reihe] = Feld[Spalte, Reihe] Then Return Feld[Spalte, Reihe]
      Next
   Next
   'Senkrechte Viererreihen:
   For Spalte = 0 To 6
      For Reihe = 0 To 2
         If Feld[Spalte, Reihe] > 0 And Feld[Spalte, Reihe+1] = Feld[Spalte, Reihe] And Feld[Spalte, Reihe+2] = Feld[Spalte, Reihe] And Feld[Spalte, Reihe+3] = Feld[Spalte, Reihe] Then Return Feld[Spalte, Reihe]
      Next
      ObereSumme = ObereSumme + (Feld[Spalte, 5]+1)/2
   Next
   'Diagonale Viererreihen (zwei M�glichkeiten):
   For Spalte = 0 To 3
      For Reihe = 0 To 2
         If Feld[Spalte, Reihe] > 0 And Feld[Spalte, Reihe] = Feld[Spalte+1, Reihe+1] And Feld[Spalte, Reihe] = Feld[Spalte+2, Reihe+2] And Feld[Spalte, Reihe] = Feld[Spalte+3, Reihe+3] Then Return Feld[Spalte, Reihe]
         If Feld[Spalte, Reihe+3] > 0 And Feld[Spalte, Reihe+3] = Feld[Spalte+1, Reihe+2] And Feld[Spalte, Reihe+3] = Feld[Spalte+2, Reihe+1] And Feld[Spalte, Reihe+3] = Feld[Spalte+3, Reihe] Then Return Feld[Spalte, Reihe+3]
      Next
   Next
   'Remis?
   If ObereSumme = 7 Then Return 3
   'Ansonsten gar nichts:
   Return 0
End Function

Function GAME_Show(ox%=0,oy%=0)
   Local x%,y%
   Local fw% = 10, fh% = 12
   
   For x = 0 Until wx
   For y = 0 Until wy
      Local px:Int = x * fw + ox
      Local py:Int = (wy - y) * fh + oy
      
      Select Feld[x, y]
         Case 0
            DrawText Feld[x, y], px, py
         Case 1
            DrawText Feld[x, y], px, py
         Case 2
            DrawText Feld[x, y], px, py
      End Select
   
   Next
   Next
   DrawText "Runde: " + Game_Round, ox, oy + (wy + 1) * fh
End Function

'STATISTIK

'Update die Statistik
'sieg: 0 = remis, 1=gewonnen, 2=verloren
Function STAT_Update(sieg%)
   If sieg = 0
      STAT_Remis = STAT_Remis+1
   ElseIf sieg = 1
      STAT_Gewonnen = STAT_Gewonnen + 1
   ElseIf sieg = 2
      STAT_Verloren = STAT_Verloren + 1
   EndIf
   STAT_Gespielt = STAT_Gespielt + 1
End Function

Function STAT_Save()
   Local file:TStream = WriteFile(Game_Host + STAT_Savefile)
   WriteLine file,"Gespielt: "+STAT_Gespielt+"/"+Game_Max
   WriteLine file,"Davon Gewonnen: "+STAT_Gewonnen
   WriteLine file,"Davon Verloren: "+STAT_Verloren
   WriteLine file,"Davon Remis   : "+STAT_Remis
   WriteLine file,"BesteSpalte() Zeit: "+(Float(STAT_FunctionTime*2)  / Game_TotalRound)
   CloseFile(file)
End Function

Function STAT_Show(x% = 10,y% = 10)
   DrawText "Gespielt: " + STAT_Gespielt + "/" + Game_Max + " Host: " + Game_Host, x, y;y = y + 20
   DrawText "Davon Gewonnen: " + STAT_Gewonnen, x, y;y = y + 20
   DrawText "Davon Verloren: " + STAT_Verloren, x, y;y = y + 20
   DrawText "Davon Remis   : " + STAT_Remis, x, y;y = y + 20
   DrawText "BesteSpalte() Zeit: " + (Float(STAT_FunctionTime * 2) / Game_TotalRound), x, y;y = y + 20
End Function

Function BASIC_SHOW()
   Cls
   STAT_SHow(10,10)
   GAME_Show(10,110)
   Flip
End Function

AppTitle("Vier-gewinnt-Gegner: ComNik")

Global gegner% ; DER GEGNER... ...wer hätte das gedacht...

Dim gefahr%(6) ; LISTE DER SPALTEN IN DIE !KEIN! STEIN GEWORFEN WERDEN DARF!!! ...unter keinen umständen...
Dim vFeld%(6,5) ; "Virtuelles" Feld, zum vorberechnen von Zügen
;--------------------------------------
Function BesteSpalte%()
;--------------------------------------
 
 For versuch = 0 To 5000               ;Sieht unnötig aus! Ist aber ziemlich nützlich. 5000 mal ist immer besser als 1 mal ;-)

   SeedRnd MilliSecs()                 ;Schöne Zufallszahlen... Sollten welche gebraucht werden.

   If farbe% = 1 Then gegner% = 2       ;gegner und farbe bestimmen...
   If farbe% = 2 Then gegner% = 1       ;  "     "    "    "       """
 
   For nogo = 0 To 6                   ;ZIEMLICH WICHTIG!!! HAB ICH AUCH ERST SPÄT GEMERKT!!!
     gefahr%(nogo) = 0                 ;NOGOS IMMER AUF NULL SETZEN!!!
   Next                                ;puhh... (wusste wahrscheinlich sowieso schon jeder außer mir -.-)
 
   ziel = ki_sieg()                    ;ziel wird am ende zurückgegeben! ki_sieg() ist die erste Funktion, mit blödem Namen

   If ziel <= 6 And ziel >= 0 Then     ; wenn ziel innerhalb vom feld -.-
    If Feld%(ziel,5) = 0 Then          ; wenn ziel spalte noch nicht voll ist dann...

   For XX = 0 To 6                     ;Einmal durchs "Virtuelle" Feld
    For YY = 0 To 5                    ; "        "       "        "
     vFeld%(XX,YY) = Feld%(XX,YY)      ; Daten übertragen von Feld%() auf vFeld%()
    Next
   Next

 For tiefe = 0 To 10

     For yy = 0 To 5                   
       If vFeld%(ziel,yy) = 0 Then vFeld%(ziel,yy) = farbe%  ;Ziel im vFeld% einsetzen
     Next

     mSieg = TesteMeinSieg()                ; gucken ob ich gewinnen würde
    If mSieg = 1 Then Goto ende     ; wenn ja, dann goto(omg! GOTO benutzt) .end

     gSieg = TesteGegnerSieg()       ; Testen ob der Gegner gewinnen würde
    If gSieg = 0 Then Goto ende      ; wenn NEIN, dann zum Ende
   
    eintragen()                  ;Sollte der Gegner nun doch gewinnen oder ich doch verlieren.

 Next

    End If
   End If       

  .ende
  If ziel <= 6 And Feld%(ziel,5) = 0 Then
   Return ziel     
  End If

  Next
;--------------------------------------
End Function
;--------------------------------------

Function eintragen()                  ; Ziel wird ins "virtuelle" Feld eingetragen. Und das prozedere beginnt von vorn.
   For y = 0 To 5
    If vFeld%(ziel,y) = 0 Then
     vFeld%(ziel,y) = farbe%
    Return
    End If
   Next
End Function   

;//PRÜFEN OB ICH/KI IN DIESEM ZUG GEWINNEN KANN\\
Function ki_sieg() ;prüfen ob drei in |, /, \, -> oder <- liegen...
     For x = 0 To 6  ;spalten
       For y = 0 To 5       ;reihen

         If Feld%(x,y) = farbe% Then ;wenn auf dem Feld mein stein liegt...

           ;//HOCH\\
           If y + 3 <= 5 Then          ;wenn 3 in einer reihe liegen können^^
           If Feld%(x,y+1) = farbe% And Feld%(x,y+2) = farbe% And Feld%(x,y+3) = 0 Then
              If gefahr%(x) = 0 Then Return x
             End If
           End If
           
           ;//RECHTS\\ und //LINKS\\
           If x + 3 <= 6 Then          ; 3 können in einer Reihe liegen...
             If Feld%(x+1,y) = farbe% And Feld%(x+2,y) = farbe% And Feld%(x+3,y) = 0 Then
               If y = 0 Then
                 Return x + 3

                 ElseIf Feld%(x+3,y-1) <> 0 Then
                      Return x + 3
                 Else
                      gefahr%(x+3) = 1               
               End If
             End If
            End If   

           If x - 1 >= 0 Then
           If x - 1 + 3 <= 6 Then
            If Feld%(x-1,y) = 0 And Feld%(x+1,y) = farbe% And Feld%(x+2,y) = farbe% Then
                 If y = 0 Then
                   Return x - 1

                  ElseIf y > 0 Then
                   If Feld%(x-1,y-1) <> 0 Then
                     Return x - 1
                   End If
                  Else
                    gefahr%(x-1) = 1
                 End If
             End If
            End If     
            End If


           ;//RECHTS und LINKS mit LÜCKEN\\
           ;1011
           If x + 3 <= 6 Then
           If Feld%(x+1,y) = 0 And Feld%(x+2,y) = farbe% And Feld%(x+3,y) = farbe% Then
             If y = 0 Then
               Return x + 1
             
             ElseIf Feld%(x+1,y-1) <> 0 Then
                Return x + 1
             Else
                gefahr%(x+1) = 1
             End If
           End If

           ;1101
           If Feld%(x+1,y) = farbe% And Feld%(x+2,y) = 0 And Feld%(x+3,y) = farbe% Then
             If y = 0 Then
              Return x + 2
 
             ElseIf Feld%(x+2,y-1) <> 0 Then
              Return x + 2
             Else
              gefahr%(x+2) = 1
             End If
           End If
           End If

          ;//SCHRÄG: OBEN RECHTS\\
          If x + 3 <= 6 And y + 3 <= 5 Then
            If Feld%(x+1,y+1) = farbe% And Feld%(x+2,y+2) = farbe% And Feld%(x+3,y+3) = 0 Then
              If Feld%(x+3,y+2) <> 0 Then
                Return x + 3
               
              Else
               gefahr%(x+3) = 1
              End If
            End If
          End If

         ;//SCHRÄG: OBEN LINKS\\
          If y < 3 And x > 2 Then
            If Feld%(x-1,y+1) = farbe% And Feld%(x-2,y+2) = farbe% And Feld%(x-3,y+3) = 0 Then
              If Feld%(x-3,y+2) <> 0 Then
                Return x - 3

               Else
                gefahr%(x-3) = 1
              End If
            End If
          End If

          ;//SCHRÄG: UNTEN RECHTS\\
         If x + 3 <= 6 And y - 3 >= 0 Then
           If Feld%(x+1,y-1) = farbe% And Feld%(x+2,y-2) = farbe% And Feld%(x+3,y-3) = 0 Then
             If y - 3 = 0 Then
               Return x + 3
           
             ElseIf y - 4 >= 0 Then
              If Feld%(x+3,y-4) <> 0 Then
               Return x + 3
              End If
             Else
               gefahr%(x+3) = 1
             End If
           End If
          End If         

         ;//SCHRÄG: UNTEN LINKS\\
         If x - 3 >= 0 And y - 3 >= 0 Then
           If Feld%(x-1,y-1) = farbe% And Feld%(x-2,y-2) = fareb% And Feld%(x-3,y-3) = 0 Then
             If y - 3 = 0 Then
               Return x - 3
           
             ElseIf y - 4 >= 0 Then
              If Feld%(x-3,y-4) <> 0 Then
               Return x - 3
              End If
             Else
               gefahr%(x-3) = 1
             End If
           End If
          End If         

         ;//SCHRÄG: OBEN LINKS(mit LÜCKEN)\\
         ;1011
          If y < 3 And x > 2 Then
           If Feld%(x-1,y+1) = 0 And Feld%(x-2,y+2) = farbe% And Feld%(x-3,y+3) = farbe% Then
            If Feld%(x-1,y) <> 0 Then
             Return x-1
           
            Else
             gefahr%(x-1) = 1
            End If
           End If
          End If

         ;1101
         If y < 3 And x > 2 Then
          If Feld%(x-1,y+1) = farbe% And Feld%(x-2,y+2) = 0 And Feld%(x-3,y+3) = farbe% Then
           If Feld%(x-2,y+1) <> 0 Then
            Return x-2
           
           Else
            gefahr%(x-2) = 1
           End If
          End If
         End If

         ;//SCHRÄG: OBEN RECHTS(mit LÜCKEN)\\
         ;1101
         If x + 3 <= 6 And y + 3 <= 5 Then
          If Feld%(x+1,y+1) = farbe% And Feld%(x+2,y+2) = 0 And Feld%(x+3,y+3) = farbe% Then
           If Feld%(x+2,y+1) <> 0 Then
             Return x + 2
           
           Else
             gefahr%(x+2) = 1
           End If
          End If
         End If   
     
        ;1011
        If x + 3 <= 6 And y + 3 <= 5 Then
         If Feld%(x+1,y+1) = 0 And Feld%(x+2,y+2) = farbe% And Feld%(x+3,y+3) = farbe% Then
          If Feld%(x+1,y) <> 0 Then
             Return x + 1
           
          Else
             gefahr%(x+1) = 1
          End If
         End If
        End If

        End If
       Next
      Next
    spalte = gegner_sieg()
    Return spalte
End Function   

;----------------------------------------------------------------------------

;//SCHADE, MAL SEHEN OB DER GEGNER IN DIESEM ZUG GEWINNEN KANN\\
Function gegner_sieg() ;prüfen ob 3 in |, /, \, -> oder <- liegen...
     For x = 0 To 6  ;spalten
       For y = 0 To 5       ;reihen

         If Feld%(x,y) = gegner% Then ;wenn auf dem Feld mein stein liegt...

           ;//HOCH\\
           If y + 3 <= 5 Then          ;wenn 4 in einer reihe liegen können^^
            If Feld%(x,y+1) = gegner% And Feld%(x,y+2) = gegner% And Feld%(x,y+3) = 0 Then Return x
           End If
           
           ;//RECHTS\\ und //LINKS\\
           If x + 3 <= 6 Then          ; 4 können in einer Reihe liegen...
             If Feld%(x+1,y) = gegner% And Feld%(x+2,y) = gegner% And Feld%(x+3,y) = 0 Then
               If y = 0 Then
                 Return x + 3

                ElseIf Feld%(x+3,y-1) <> 0 Then
                      Return x + 3
                Else
                 gefahr%(x+3) = 1
               End If
             End If
            End If                 
           
           If x - 1 >= 0 Then
           If x - 1 + 3 <= 6 Then
            If Feld%(x-1,y) = 0 And Feld%(x+1,y) = gegner% And Feld%(x+2,y) = gegner% Then
                 If y = 0 Then
                   Return x - 1

                  ElseIf y > 0 Then
                   If Feld%(x-1,y-1) <> 0 Then
                     Return x - 1
                  Else
                    gefahr%(x-1) = 1
                   End If
                 End If
              End If
            End If     
            End If
                             
          ;//SCHRÄG: OBEN RECHTS\\
          If x + 3 <= 6 And y + 3 <= 5 Then
            If Feld%(x+1,y+1) = gegner% And Feld%(x+2,y+2) = gegner% And Feld%(x+3,y+3) = 0 Then
              If Feld%(x+3,y+2) <> 0 Then
                Return x + 3

               Else
                gefahr%(x+3) = 1
               End If
            End If
          End If

          ;//SCHRÄG: OBEN LINKS\\
          If y < 3 And x > 2 Then
            If Feld%(x-1,y+1) = gegner% And Feld%(x-2,y+2) = gegner% And Feld%(x-3,y+3) = 0 Then
              If Feld%(x-3,y+2) <> 0 Then
                Return x - 3

               Else
                gefahr%(x-3) = 1
               End If
            End If
          End If     
     
         ;//SCHRÄG: UNTEN RECHTS\\
         If x + 3 <= 6 And y - 3 >= 0 Then
           If Feld%(x+1,y-1) = gegner% And Feld%(x+2,y-2) = gegner% And Feld%(x+3,y-3) = 0 Then
             If y - 3 = 0 Then
               Return x + 3
           
             ElseIf y - 4 >= 0 Then
              If Feld%(x+3,y-4) <> 0 Then
               Return x + 3
              End If
             Else
               gefahr%(x+3) = 1
             End If
           End If
          End If         

         ;//SCHRÄG: UNTEN LINKS\\
         If x - 3 >= 0 And y - 3 >= 0 Then
           If Feld%(x-1,y-1) = gegner% And Feld%(x-2,y-2) = gegner% And Feld%(x-3,y-3) = 0 Then
             If y - 3 = 0 Then
               Return x - 3
           
             ElseIf y - 4 >= 0 Then
              If Feld%(x-3,y-4) <> 0 Then
               Return x - 3
              End If
             Else
               gefahr%(x-3) = 1
             End If
           End If
          End If         

         ;//RECHTS und LINKS mit LÜCKEN\\
         ;1011
         If x + 3 <= 6 Then
         If Feld%(x+1,y) = 0 And Feld%(x+2,y) = gegner% And Feld%(x+3,y) = gegner% Then
           If y = 0 Then
            Return x + 1

           ElseIf Feld%(x+1,y-1) <> 0 Then
            Return x + 1
           Else
            gefahr%(x+1) = 1
           End If
         End If

         ;1101
         If Feld%(x+1,y) = gegner% And Feld%(x+2,y) = 0 And Feld%(x+3,y) = gegner% Then
           If y = 0 Then
            Return x + 2
 
           ElseIf Feld%(x+2,y-1) <> 0 Then
            Return x + 2
           Else
            gefahr%(x + 2) = 1
           End If
         End If
         End If

         ;//SCHRÄG: OBEN LINKS(mit LÜCKEN)\\
         ;1011
          If y < 3 And x > 2 Then
           If Feld%(x-1,y+1) = 0 And Feld%(x-2,y+2) = gegner% And Feld%(x-3,y+3) = gegner% Then
            If Feld%(x-1,y) <> 0 Then
             Return x-1
           
            Else
             gefahr%(x-1) = 1
            End If
           End If
          End If

         ;1101
         If y < 3 And x > 2 Then
          If Feld%(x-1,y+1) = gegner% And Feld%(x-2,y+2) = 0 And Feld%(x-3,y+3) = gegner% Then
           If Feld%(x-2,y+1) <> 0 Then
            Return x-2
           
           Else
            gefahr%(x-2) = 1
           End If
          End If
         End If

         ;//SCHRÄG: OBEN RECHTS(mit LÜCKEN)\\
         ;1101
         If x + 4 <= 6 And y + 3 <= 5 Then
          If Feld%(x+1,y+1) = gegner% And Feld%(x+2,y+2) = 0 And Feld%(x+3,y+3) = gegner% Then
           If Feld%(x+2,y+1) <> 0 Then
             Return x + 2
           
           Else
             gefahr%(x+2) = 1
           End If
          End If
         End If   
       
         ;1011
        If x + 3 <= 6 And y + 3 <= 5 Then
         If Feld%(x+1,y+1) = 0 And Feld%(x+2,y+2) = gegner% And Feld%(x+3,y+3) = gegner% Then
          If Feld%(x+1,y) <> 0 Then
             Return x + 1
           
          Else
             gefahr%(x+1) = 1
          End If
         End If
        End If

        End If
       Next
      Next
  spalte = zwei_bedrohung()
   Return spalte
End Function   

;------------------------------------------------------------------------

;//UND WIE SIEHTS MIT DEM STÖREN DES AUFBAUS DES GEGNERS AUS(satzbau??!!)??\\
Function zwei_bedrohung()
  For x = 0 To 6  ;spalten
    For y = 0 To 5       ;reihen

      If Feld%(x,y) = gegner% Then ;wenn auf dem Feld mein stein liegt...
           
           ;//RECHTS\\ und //LINKS\\
           If x + 2 <= 6 Then          ; 3 können in einer Reihe liegen...
            If x - 1 >= 0 Then
             If Feld%(x-1,y) = 0 Then
             If Feld%(x+1,y) = gegner% And Feld%(x+2,y) = 0 Then
               If y = 0 Then
                 If gefahr%(x+2) = 0 Then Return x + 2
                ElseIf Feld%(x+2,y-1) <> 0 Then
                      Return x + 2               
               
                ElseIf Feld%(x-1,y) = 0 Then
                   If y > 0 Then
                   If Feld%(x-1,y-1) <> 0 Then
                    If gefahr%(x-1) = 0 Then Return x - 1
                   End If
                   End If
                 End If       
                End If
               End If
             End If
            End If
             
          ;//SCHRÄG: OBEN RECHTS\\
          If x + 3 <= 6 And y + 2 <= 5 Then
            If Feld%(x+1,y+1) = gegner% And Feld%(x+2,y+2) = 0 Then
              If Feld%(x+2,y+1) <> 0 Then
               If gefahr%(x+2) = 0 Then Return x + 2
              End If
            End If
          End If
         
         ;//SCHRÄG: OBEN LINKS\\
          If y < 2 And x > 1 Then
            If Feld%(x-1,y+1) = gegner% And Feld%(x-2,y+2) = 0 Then
              If Feld%(x-2,y+1) <> 0 Then
               If gefahr%(x-2) = 0 Then Return x - 2
              End If
            End If
          End If     
       
        End If
       Next
      Next
    spalte = bauen()
    Return spalte
End Function

;--------------------------------------------------------------------------

;//DANN KANN ICH/KI JA AUFBAUEN\\
Function bauen()
   For x = 0 To 6  ;spalten
       For y = 0 To 5       ;reihen

         If Feld%(x,y) = farbe% Then ;wenn auf dem Feld mein stein liegt...

           ;//HOCH\\
           If y + 3 <= 5 Then          ;wenn 3 in einer reihe liegen können^^
           If Feld%(x,y+1) = farbe% And Feld%(x,y+2) = 0 Then
              If gefahr%(x) = 0 Then Return x
             End If
           End If
           
           ;//RECHTS\\ und //LINKS\\
           If x + 3 <= 6 Then          ; 3 können in einer Reihe liegen...
             If Feld%(x+1,y) = farbe% And Feld%(x+2,y) = 0 Then
               If y = 0 Then
                  If gefahr%(x+2) = 0 Then Return x + 2
                 ElseIf Feld%(x+2,y-1) <> 0 Then
                    If gefahr%(x+2) = 0 Then Return x + 2
                 Else
                      gefahr%(x+2) = 1               
                End If
              End If
            End If

           
           If x - 1 >= 0 Then
           If x - 1 + 3 <= 6 Then
            If Feld%(x-1,y) = 0 And Feld%(x+1,y) = farbe% Then
                 If y = 0 Then
                   If gefahr%(x-1) = 0 Then Return x - 1
                  ElseIf y > 0 Then
                   If Feld%(x-1,y-1) <> 0 Then
                     If gefahr%(x-1) = 0 Then Return x - 1
                   End If
                 End If
             End If
            End If     
            End If

          ;//SCHRÄG: OBEN RECHTS\\
          If x + 4 <= 6 And y + 3 <= 5 Then
            If Feld%(x+1,y+1) = farbe% And Feld%(x+2,y+2) = 0 Then
              If Feld%(x+2,y+1) <> 0 Then
                If gefahr%(x+2) = 0 Then Return x + 2
              Else
                gefahr%(x+2) = 1
              End If
            End If
          End If

         ;//SCHRÄG: OBEN LINKS\\
          If y < 3 And x > 2 Then
            If Feld%(x-1,y+1) = farbe% And Feld%(x-2,y+2) = 0 Then
              If Feld%(x-2,y+1) <> 0 Then
                If gefahr%(x-2) = 0 Then Return x - 2

              Else
               gefahr%(x-2) = 1
              End If
            End If
          End If
     
        End If
       Next
      Next
    spalte = no_plan_von_ki()
    Return spalte
End Function

;---------------------------------------------------------------------

Function no_plan_von_ki() ;yeah und so! Check the Flow und so... (-.-)
 If Feld%(3,0) = 0 Then
  If gefahr%(3) = 0 Then Return 3
 End If
   For g = 0 To 255  ; Was für ein zufälliger Variablenname...
     spalte = Rnd(0,6)
    If Feld%(spalte,5) = 0 Then
     If gefahr%(spalte) = 0 Then
      Return spalte
     End If
    End If
   Next

;SCH**** Nichts gefunden...
 spalte = Rnd(0,6)
 Return spalte
End Function

;----------------------------------------------------------------------

Function TesteGegnerSieg()

  Local Reihe%, Spalte%

  For Spalte = 0 To 6
   For Reihe = 0 To 5

   ;Waagerechte Viererreihen:
     If Spalte + 3 <= 6 Then
      If vFeld%(Spalte, Reihe) = gegner% And vFeld%(Spalte+1, Reihe) = gegner% And vFeld%(Spalte+2, Reihe) = gegner% And vFeld%(Spalte+3, Reihe) = gegner% Then Return 1
     End If
       
   ;Senkrechte Viererreihen:
     If Reihe + 3 <= 5 Then
      If vFeld%(Spalte, Reihe) = gegner% And vFeld%(Spalte, Reihe+1) = gegner% And vFeld(Spalte, Reihe+2) = gegner% And vFeld%(Spalte, Reihe+3) = gegner% Then Return 1
     End If
   
   ;Diagonale Viererreihen (zwei Möglichkeiten):
        If Spalte - 3 >= 0 And Reihe + 3 <= 5 Then   
         If vFeld%(Spalte, Reihe) = gegner% And vFeld%(Spalte-1, Reihe+1) = gegner% And vFeld%(Spalte-2, Reihe+2) = gegner% And vFeld%(Spalte-3, Reihe+3) = gegner%  Then Return 1
      End If
      If Spalte + 3 <= 6 And Reihe + 3 <= 5 Then     
          If vFeld%(Spalte, Reihe) = gegner% And vFeld%(Spalte+1, Reihe+1) = gegner% And vFeld%(Spalte+2, Reihe+2) = gegner% And vFeld%(Spalte+3, Reihe+3) = gegner% Then Return 1
      End If
   
   Next
   Next

   ;Ansonsten gar nichts:
   Return 0

End Function

;-------------------------------------------------------------------------

Function TesteMeinSieg()

 Local Reihe%, Spalte%
 
   For Spalte = 0 To 6
    For Reihe = 0 To 5

   ;Waagerechte Viererreihen
    If Spalte + 3 <= 6 Then
      If vFeld%(Spalte, Reihe) = farbe% And vFeld%(Spalte+1, Reihe) = farbe% And vFeld%(Spalte+2, Reihe) = farbe% And vFeld%(Spalte+3, Reihe) = farbe% Then Return 1
     End If

     ;Senkrechte Viererreihen:
     If Reihe + 3 <= 5 Then    
       If vFeld%(Spalte, Reihe) = farbe% And vFeld%(Spalte, Reihe+1) = farbe% And vFeld%(Spalte, Reihe+2) = farbe% And vFeld%(Spalte, Reihe+3) = farbe% Then Return 1
     End If     

    ;Diagonale Viererreihen (zwei Möglichkeiten):
   If Spalte + 3 <= 6 And Reihe + 3 <= 5 Then
         If vFeld%(Spalte, Reihe) = farbe% And vFeld%(Spalte+1, Reihe+1) = farbe% And vFeld%(Spalte+2, Reihe+2) = farbe% And vFeld%(Spalte+3, Reihe+3) = farbe% Then Return 1
   End If
   
   If Spalte - 3 >= 0 And Reihe + 3 <= 5 Then       
           If vFeld%(Spalte, Reihe) = farbe% And vFeld%(Spalte-1, Reihe+1) = farbe% And vFeld%(Spalte-2, Reihe+2) = farbe% And vFeld%(Spalte-3, Reihe+3) = farbe% Then Return 1
   End If 
            
   Next
   Next

   ;Ansonsten gar nichts:
   Return 0

End Function
     

;-Bitte ergänze im Folgenden "Nickname?" durch deinen eigenen, damit man später beim
;Gegeneinanderspielen mehrerer Gegner die Fenster anhand der Titelleisten unterscheiden kann:
AppTitle("Vier-gewinnt-Gegner: Rallimen")
;--------------------------------------
Dim SpFe%(6,5)
Dim Schacht% (6)
Global Maxtiefe% = 5
Global AnzRekursiv%
Function BesteSpalte%()
Time =MilliSecs ()
SeedRnd (MilliSecs())
   ;Array kopieren
   AnzRekursiv%=0
   time = MilliSecs ()
   Local x%,y%,Tiefe%,Spalte%
   For x% = 0 To 6
      For y% = 0 To 5
         SpFe (x%,y%) = Feld (x%,y%)
      Next
   Next
   ;--------------------------------------
   For Spalte%= 0 To 6
      Schacht% (Spalte%) = Rekursiv(Spalte%,Tiefe%,Farbe,1)
   Next
   time = MilliSecs () -time
   ;Print  time
   Return Schachtauswaehlen()
End Function

Function Schachtauswaehlen%()
   ;Print AnzRekursiv%
    ;Mitte bevorzugen
   Schacht(1)=Schacht(1)+Rand (1)
   Schacht(2)=Schacht(2)+Rand (2)
   Schacht(3)=Schacht(3)+Rand (3)
   Schacht(4)=Schacht(4)+Rand (2)
   Schacht(5)=Schacht(5)+Rand (1)

   ;:::For t%= 0 To 6 Print Schacht(t%) Next ;
   ;höchsten Wert emitteln
   For x% = 0 To 6 ;Schacht ermitteln
      If Feld (x%,5) = 0 Then ; der Schacht ist oben frei
         maxwert% = Schacht(x%)
         maxindex% = x%
         For x1% = x%+1 To 6
            If Feld (x1%,5) = 0 Then ; der Schacht ist oben frei
               If maxwert% < Schacht(x1%) Then
                  maxindex% = x1%
                  maxwert% = Schacht(x1%)
               End If
            End If
         Next
         Exit
      End If
   Next
   Return maxindex%
End Function


Function Rekursiv%(Spalte%,Tiefe%,Player,PosNeg)
   ;
   AnzRekursiv%=AnzRekursiv%+1
   For Reihe% = 0 To 5
      If SpFe (Spalte%,Reihe%) = 0 Then
         SpFe (Spalte%,Reihe%) = Player
         SteinSpalte% = Spalte%
         SteinReihe% = Reihe%
         Steingesetzt = True
         If CheckGewinn(SteinSpalte%,SteinReihe%,Player%) = True Then
         ;::::ShowField()
         ::::If Steingesetzt = False Then Stop
            SpFe (SteinSpalte%,SteinReihe%) = 0 ;Stein rausnehmen
            Punkte =  10^(MaxTiefe - Tiefe) ; gewinn/VerlustPunkte zurück schicken#
            ;Punkte =  100 - Tiefe
            If PosNeg  = 1 Then Return  Punkte Else Return -Punkte
         ::Else
            Exit
         End If
      End If
   Next
   If Steingesetzt = False Then Return
   ;
   If Tiefe% => Maxtiefe% Then
      SpFe (SteinSpalte%,SteinReihe%) = 0
      Return
   End If
   ;
   Tiefe% = Tiefe% +1
   Player% = Player% Xor 3; Wechsel 1 zu 2 und umgekehrt
   PosNeg% = PosNeg% Xor 1; Wechsel 0 zu 1 und umgekehrt
   ;
   For Spalte%= 0 To 6
      Punkte% = Punkte% +  Rekursiv(Spalte%,Tiefe%,Player%,PosNeg%)
   Next
   ;
   SpFe (SteinSpalte%,SteinReihe%) = 0
   ;
   Return Punkte
End Function


Function CheckGewinn%(SteinSpalte%,SteinReihe%,Player%)

   ;Waagerecht
   For Spalte% = 0 To 3
      If SpFe (Spalte%,SteinReihe%) = Player% Then
         If SpFe (Spalte%+1,SteinReihe%) = Player% Then
            If SpFe (Spalte%+2,SteinReihe%) = Player% Then
               If SpFe (Spalte%+3,SteinReihe%) = Player% Then Return True
            End If
         End If
      End If
   Next
   ;senkrecht
   For Reihe% = 0 To 2
      If SpFe (SteinSpalte%,Reihe%) = Player% Then
         If SpFe (SteinSpalte%,Reihe%+1) = Player% Then
            If SpFe (SteinSpalte%,Reihe%+2) = Player% Then
               If SpFe (SteinSpalte%,Reihe%+3) = Player% Then
                  Return True
               End If
            End If
         End If
      End If
   Next
   For Spalte = 0 To 3
      For Reihe = 0 To 2
         If SpFe(Spalte, Reihe) = Player%
            If SpFe(Spalte+1, Reihe+1) = Player%
               If SpFe(Spalte+2, Reihe+2) = Player%
                      If SpFe(Spalte+3, Reihe+3) = Player% Then Return True
                End If
            End If
         End If
         If SpFe(Spalte, Reihe+3) = Player%
            If SpFe(Spalte+1, Reihe+2) = Player%
               If SpFe(Spalte+2, Reihe+1) = Player%
                  If SpFe(Spalte+3, Reihe) = Player% Then Return True
               End If
            End If
         End If
      Next
   Next
End Function

Function ShowField()

   Print"ShowField"
   For y = 5 To 0 Step -1
      For x = 0 To 6
         Write  SpFe (x%,y%)
      Next
      Print ""
   Next

   For t= 0 To 6 Print Schacht(t) Next
End Function