Global Game_Max% = 10 ;Wie viele Spiele Maximal gespielt werden sollen



;Net Stuff
Global iPort% = 4000
Global oPort% = 4001
Global iAltPort% = 5000
Global oAltPort% = 5001

Global rPort% = 0;remote input port
Global rIp% = 0;remote ip, if nothing -> localhost

Global iStream%
Global oStream%

Global MessageIp% ;last Message IP

Global Timeout% = 15000
Global LastIncome%

Global SEARCH_pollIntervall% = 10000 ;ms until next poll
Global SEARCH_nextPoll%

;Program Stuff
Global progEnd = False
;Global progLog = WriteFile("log.txt")

;Game Stuff
Const FeldW% = 6
Const FeldH% = 5
Dim Feld(FeldW,FeldH)

Global Farbe% ;1 oder 2 'Farbe die gerade dran ist

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

Include "BesteSpalte().bb"


;############## PROGRAMM #########

;Init
NET_GetHostIp()
NET_CreateStreams()
PROCESS_SetState(STATE_SEARCH)
SetBuffer BackBuffer()

;Runtime
While Not progEnd
   PROCESS_MAIN()
Wend


;Final
STAT_Save()
NET_CloseStreams()
End

;############ PROGRAMM ENDE ###########




Function MSG_Process()
   MessageIp = RecvUDPMsg(iStream)
   If MessageIp<>0 And ReadAvail(iStream)<>0
      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


;########### FUNKTIONEN #################

;States

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
      Text 10,10, "Searching..."
   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 = GetKey()
   If key<>0 progEnd = True
End Function


;NETCODE
Function NET_GetHostIp()
   ;Get localhost ip
   Local hostcount% = CountHostIPs("")
   
   If rIp = 0 rIp = HostIP(1)
   
   ;debuglog hosts
   Local i%
   For i=1 To hostcount
      DebugLog "Host Ip: "+DottedIP(HostIP(i))
   Next
End Function

Function NET_CreateStreams()
   iStream = CreateUDPStream(iPort)
   oStream = CreateUDPStream(oPort)
   If rPort = 0 rPort = iAltPort
   
   If iStream = 0 And oStream = 0
      rPort = iPort
      iPort = iAltPort
      oPort = oAltPort
      iStream = CreateUDPStream(iPort)
      oStream = CreateUDPStream(oPort)
   EndIf
   
   If iStream = 0 Or oStream = 0
      RuntimeError("Cannot create streams")
   Else
      DebugLog "created ports"
      DebugLog "remote port: "+rPort
      DebugLog "remote ip: "+DottedIP(rIp)
   EndIf
End Function

Function NET_CloseStreams()
   CloseUDPStream(iStream)
   CloseUDPStream(oStream)
End Function

Function NET_Send()
   SendUDPMsg(oStream,rIp,rPort)
   LastIncome = MilliSecs()
End Function

;GAMECODE
Function Game_Init()
   Local x%, y%

   Game_Round = 0
   Farbe = 1
   
   ;Spielfeld säubern
   For x = 0 To FeldW
   For y = 0 To FeldH
      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 To FeldH
      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%()
   ;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%, Spalte%, ObereSumme%
   ;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 To FeldW
   For y = 0 To FeldH
      Local px = x * fw + ox
      Local py = (FeldH-y) * fh + oy
      
      Select Feld(x,y)
         Case 0
            Text px,py,Feld(x,y)
         Case 1
            Text px,py,Feld(x,y)
         Case 2
            Text px,py,Feld(x,y)
      End Select
   
   Next
   Next
   Text ox,oy + (FeldH+1) * fh, "Runde: "+Game_Round
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()
   file = 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)
   Text x,y, "Gespielt: "+STAT_Gespielt +"/"+Game_Max+ " Host: "+GAME_Host:y=y+20
   Text x,y, "Davon Gewonnen: "+STAT_Gewonnen:y=y+20
   Text x,y, "Davon Verloren: "+STAT_Verloren:y=y+20
   Text x,y, "Davon Remis   : "+STAT_Remis:y=y+20
   Text x,y, "BesteSpalte() Zeit: "+(Float(STAT_FunctionTime*2)  / Game_TotalRound):y=y+20
End Function

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


;Prog Stuff
;Function DebugLog(t$)
;   WriteLine progLog,t
;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:Firstdeathmaker?")

Const wx% = 6
Const wy% = 5
Const DIFFICULTY = 4 ;iterationstiefe
Dim Array(wx,wy)

Global WinColumn
Global WinBest

Global LooseColumn
Global LooseBest

Global WinPossibilities
Global LoosePossibilities

Dim Columns(wx)
Dim Possibilities(wx)


;--------------------------------------
Function BesteSpalte%()
;--------------------------------------
   ;Zur Erinnerung:    0 = leer, 1 = rot, 2 = gelb
   ;Mit diesen Werten wird das Spielbrett in dem globalen Array "Feld%(6,5)" gespeichert.
   ;Die unterste Reihe ist die Reihe 0, die oberste Reihe ist die Reihe 5.
   ;Ebenso laufen die Spalten von 0 bis 6 von Links nach Rechts.

   ;RuntimeError("Tja, die Function müsstest DU ermitteln! Darin besteht der Wettbewerb. Das Programm wird beendet.")

   getArray()
   WinBest = -1
   LooseBest = -1
   Local r = isBest()
   Local column
   
      For x=0 To wx
         DebugLog columns(x)
      Next

   If winBest>=0 And LooseBest>=winBest
      DebugLog "Take Winning one"
      column = winColumn
   ElseIf LooseBest>=0
      DebugLog "Take not Loosing one"
      Local tookOne = False
      For x=0 To wx
         If InsertCoin(x,Farbe)
            If Columns(x)>=0
               column = x
               tookOne = True
            EndIf
            RemoveCoin(x,Farbe)
         EndIf
      Next
      
      ;If cannot avoid other win, take that one with the most far end
      If tookOne = False
         Local farest
         For x=0 To wx
            If InsertCoin(x,Farbe)
               If Columns(x)<farest Or (Columns(x)=farest And farest<>0 And Possibilities(x)>Possibilities(column))
                  column = x
                  tookOne = True
                  farest = Columns(x)
               EndIf
               RemoveCoin(x,Farbe)
            EndIf
         Next
      EndIf
      
   Else
   
      ;Take other strategy best one
      For x=0 To wx
         If InsertCoin(x,Farbe)
            If Abs(x - wx/2)<Abs(column - wx/2) ;Bevorzuge Mitte
               column = x
               tookOne = True
            EndIf
            RemoveCoin(x,Farbe)
         EndIf
      Next
      
      DebugLog "take a random one"
   EndIf

   ;Reiner Zufall wäre:
   Return column
;--------------------------------------
End Function
;--------------------------------------



;Returns -1 if this is a bad one
;returns -2 if this is a neutral one
Function isBest(depth% = 0, maxDepth%=DIFFICULTY)
   ;printArray()
   Local ccolor = (Farbe + depth + 1) Mod 2 + 1
   Local r = CheckArray()
   Local w
   Local n
   
   Local tmpWinColumn = 0
   Local tmpWinBest = -1
   
   Local tmpLooseColumn = 0
   Local tmpLooseBest = -1
   
   Local tmpWinPossibilities = 0
   Local tmpLoosePossibilities = 0
   Local tmpPossibilities[wx]
   
   Local tmpColumns%[wx]
   
   If r = Farbe
      ;printArray()
      ;DebugLog "Win possible"
      WinColumn = 0
      WinPossibilities = 1
      WinBest = depth
      Return depth
   ElseIf r <> Farbe And r<>0 And r<>3
      ;DebugLog "Loose possible"
      LooseColumn = 0
      LoosePossibilities = 1
      LooseBest = depth
      Return -depth
   EndIf
   
   If depth >= maxDepth Return 0
   
   For x = 0 To wx
      If InsertCoin(x,ccolor)
         r = isBest(depth + 1, maxDepth)
         tmpColumns[x] = r
         tmpPossibilities[x] = WinPossibilities - LoosePossibilities
         If r>0
            tmpWinPossibilities = tmpWinPossibilities + 1
            If WinBest < tmpWinBest Or tmpWinBest<0
               tmpWinBest = WinBest
               tmpWinColumn = x
               If (depth Mod 2)=1 tmpWinColumn = WinColumn
            EndIf
         ElseIf r<0
            tmpLoosePossibilities = tmpLoosePossibilities + 1
            If LooseBest < tmpLooseBest Or tmpLooseBest<0
               tmpLooseBest = LooseBest
               tmpLooseColumn = x
               If (depth Mod 2)=1 tmpLooseColumn = LooseColumn
            EndIf
         EndIf
         RemoveCoin(x,ccolor)
      EndIf
   Next
   
   WinPossibilities = tmpWinPossibilities
   LoosePossibilities = tmpLoosePossibilities
   
   
   Local lowest%
   For x = 0 To wx
      Columns(x) = tmpColumns[x]
      Possibilities(x) = tmpPossibilities[x]
      If (Abs(lowest) > Abs(tmpColumns[x]) Or lowest = 0) And tmpColumns[x]<>0
         lowest = tmpColumns[x]
      EndIf
   Next
   
   If tmpWinBest>=0
      WinBest = tmpWinBest
      WinColumn = tmpWinColumn
   EndIf

   If tmpLooseBest>=0
      LooseBest = tmpLooseBest
      LooseColumn = tmpLooseColumn
   EndIf

   Return lowest
End Function






Function printArray()
   DebugLog "----"
   Local l$ = ""
   
   For y = wy To 0 Step -1
      l = ""
   For x = 0 To wx
      l = l + Array(x,y)
   Next
   DebugLog l
   Next
End Function

Function getArray()
   For x = 0 To wx
   For y = 0 To wy
      Array(x,y) = Feld(x,y)
   Next
   Next
End Function

Function InsertCoin(column%,player%)
   Local y%
   For y = 0 To wy
      If Array(column,y) = 0
         Array(column,y) = player
         Return 1
      EndIf
   Next
   Return 0
End Function

Function RemoveCoin(column%,player%)
   Local y%
   For y = wy To 0 Step -1
      If Array(column,y) <> 0
         If Array(column,y) = player
            Array(column,y) = 0
            Return 1
         Else
            Return 0
         EndIf
      EndIf
   Next
   Return 0
End Function


Function CheckArray%()
   ;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%, Spalte%, ObereSumme%
   ;Waagerechte Viererreihen:
   For Spalte = 0 To 3
      For Reihe = 0 To 5
            If Array(Spalte, Reihe) > 0 And Array(Spalte+1, Reihe) = Array(Spalte, Reihe) And Array(Spalte+2, Reihe) = Array(Spalte, Reihe) And Array(Spalte+3, Reihe) = Array(Spalte, Reihe) Then Return Array(Spalte, Reihe)
      Next
   Next
   ;Senkrechte Viererreihen:
   For Spalte = 0 To 6
      For Reihe = 0 To 2
         If Array(Spalte, Reihe) > 0 And Array(Spalte, Reihe+1) = Array(Spalte, Reihe) And Array(Spalte, Reihe+2) = Array(Spalte, Reihe) And Array(Spalte, Reihe+3) = Array(Spalte, Reihe) Then Return Array(Spalte, Reihe)
      Next
      ObereSumme = ObereSumme + (Array(Spalte, 5)+1)/2
   Next
   ;Diagonale Viererreihen (zwei Möglichkeiten):
   For Spalte = 0 To 3
      For Reihe = 0 To 2
         If Array(Spalte, Reihe) > 0 And Array(Spalte, Reihe) = Array(Spalte+1, Reihe+1) And Array(Spalte, Reihe) = Array(Spalte+2, Reihe+2) And Array(Spalte, Reihe) = Array(Spalte+3, Reihe+3) Then Return Array(Spalte, Reihe)
         If Array(Spalte, Reihe+3) > 0 And Array(Spalte, Reihe+3) = Array(Spalte+1, Reihe+2) And Array(Spalte, Reihe+3) = Array(Spalte+2, Reihe+1) And Array(Spalte, Reihe+3) = Array(Spalte+3, Reihe) Then Return Array(Spalte, Reihe+3)
      Next
   Next
   ;Remis?
   If ObereSumme = 7 Then Return 3
   ;Ansonsten gar nichts:
   Return 0
End Function