fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
Colochessum_0.4

Uploader:	grindstone
Datum/Zeit:	29.01.2014 08:05:25
Hinweis: Dieser Quelltext ist Bestandteil des Projekts Colochessum, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
' COLOCHESSUM

'*****************************************************************************************

' This program was written on the base of "gui.exe" written by VANYA, who's graphics and

' animation routines were inherited nearly unchanged.

' The pieces were created by BasicCoder2

' Special thanks to ALWIM and Roland Chastain for their helpful hints.

'*****************************************************************************************



#Include Once "windows.bi"

#Include "fbgfx.bi"

#Include "vbcompat.bi"



Type chessMove

    x1 As Integer

    x2 As Integer

    y1 As Integer

    y2 As Integer

End Type



Type wText

    opponent As String

    move As String

    depth As String

End Type



Const As Integer castlingWhite = 1, castlingBlack = 2, cfont = RGB(0,0,0), _

                 cback = RGB(100,255,100), cbacklt = RGB(220,255,220)

Const As String w = "white", b = "black"



Dim Shared As Integer mx, my, btn, ox, oy, dx, dy, depth, moveTimePreset, currentWhite, _

                      currentBlack, errorCount, moveCount, relSpeed, _

                      animationSpeed, ExitCode, count50, pchoice, moveTimeHandicap, _

                      drawnGames, mox, moy, mob, mow, gameCount, depthPreset, depthHandicap, _

                      gameTimePreset, gameTimeHandicap, menuitemhit

Dim Shared As Integer board(12,12) 'internal representation of board

Dim Shared As Integer moveTime(2), winEngine(2), depthEngine(2), timeLeft(2), gameTime(2), _

                      timePlayed(2)

Dim Shared As Integer mateFlag, replayFlag, setEngineOptionsFlag, humanFlag 'flags

Dim Shared As Integer bx, by        'position top/left of board

Dim Shared As wText wt

Dim Shared As FB.Image Ptr sImage

Dim Shared As FB.Image Ptr iPiece(12) '12 images

Dim Shared As String engine(2), matesign(2)

ReDim Shared As String fen(1), movetable(1), engineOptions(5,1)

Dim Shared As String hod, moves, currDepth, nameWhite, castlingFlag, fenstr, menuitem, _

                     nameBlack, WindowText, move, opponent, playmode, lastmove, replayMoves, _

                     iniFile, fenBoard, fenOpponent, fenCastling, fenEnPassant, fenHalfmoves, _

                     fenMoves

Dim Shared As HANDLE hReadChildPipeWhite, hWriteChildPipeWhite, hReadChildPipeBlack, _

                     hWriteChildPipeBlack, hReadPipeWhite, hWritePipeWhite, hReadPipeBlack, _

                     hWritePipeBlack, hwndThisWindow, hProcessHandleWhite, hProcessHandleBlack

Dim Shared As Any Ptr thMouse

Dim Shared As ZString * 100 iniBuffer

Dim Shared As Double gameStamp, timeRemind





Declare Function GetEngineResponse(opponent As String) As String

Declare Function GetMove(opponent As String) As String

Declare Sub WriteEngineInfo(opponent As String, s As String)

Declare Sub update()

Declare Function strMoveToNumMove(move As String) As chessMove

Declare Sub makeMove(cMove As chessMove)

Declare Sub SetTitleBar

Declare Sub CloseEngines

Declare Sub PrintMoveTable

Declare Function makeFen() As String

Declare Sub fenToBoard(fen As String)

Declare Sub parseFen(fen As String)

Declare Function deleteFromString(text As String, character As String) As String

Declare Function checkForStale() As Integer

Declare Sub mouseMenu(text As String, separator As String, lin As Integer = 1, _

                  col As Integer = 1, foreground As UInteger, background As UInteger, _

                  mode As Integer = 0)

Declare Sub continueTurnament()

Declare Sub replayGame()

Declare Sub setup

Declare Sub setupEngine(engine As String, engNumber As Integer)

Declare Sub setEngineOptions(engine As String)



Declare Sub showInternalBoard()

Declare Sub pCon OverLoad (t As String = "",text As String)

Declare Sub pCon (text As String)

Declare Sub pCon (t As String = "",x As Integer)

Declare Sub pCon (x As Integer)

Declare Function timeFormat (seconds As Double, mode As Integer = 0) As String

Declare Sub Scan

Declare Sub GetEngineOptions(engine As String)





Dim As Integer x, y, menlin, mencol

Dim As String datum, g, g2, matecomp, movecomp, winner, keypressed

Dim As chessMove cMove

Dim As STARTUPINFO siWhite, siBlack

Dim As PROCESS_INFORMATION pi

Dim As SECURITY_ATTRIBUTES sa



Enum

    oname = 1

    otype

    odefault

    omin

    omax

    ovar = omin

End Enum



ScreenRes 640,608,32,2

ScreenSet 1,1



hwndThisWindow = GetForegroundWindow() 'get the window handle



startNew:



MkDir(ExePath + "\engines") 'create engines directory if not exists



iniFile = ExePath + "\setup.ini"

If Not FileExists(inifile) Then 'create .ini - file

    Open inifile For Output As #1

    Print #1, "[]"

    Close 1

EndIf



'get variables from the .ini-file

GetPrivateProfileString("","engine1","none",@iniBuffer,100,StrPtr(iniFile))

engine(1) = iniBuffer



GetPrivateProfileString("","engine2","none",@iniBuffer,100,StrPtr(iniFile))

engine(2) = iniBuffer



GetPrivateProfileString("","animationSpeed","15",@iniBuffer,100,StrPtr(iniFile))

animationSpeed = Val(iniBuffer)



GetPrivateProfileString("","playmode","movetime",@iniBuffer,100,StrPtr(iniFile))

playmode = iniBuffer



GetPrivateProfileString("","moveTimePreset","100",@iniBuffer,100,StrPtr(iniFile))

moveTimePreset = Val(iniBuffer)



GetPrivateProfileString("","moveTimeHandicap","100",@iniBuffer,100,StrPtr(iniFile))

moveTimeHandicap = Val(iniBuffer)



GetPrivateProfileString("","depthPreset","10",@iniBuffer,100,StrPtr(iniFile))

depthPreset = Val(iniBuffer)



GetPrivateProfileString("","depthHandicap","1",@iniBuffer,100,StrPtr(iniFile))

depthHandicap = Val(iniBuffer)



GetPrivateProfileString("","gameTimePreset","300",@iniBuffer,100,StrPtr(iniFile))

gameTimePreset = Val(iniBuffer) 'default 5 minutes



GetPrivateProfileString("","gameTimeHandicap","10",@iniBuffer,100,StrPtr(iniFile))

gameTimeHandicap = Val(iniBuffer)





Color cfont,cback

Cls



mainMenu:



Color cfont,cback

Cls



Locate 15,20

Print "**********  M A I N   M E N U  **********"



mencol = 25

menlin = 20



Do 'main menu loop

    keypressed = Inkey

    menuitem = ""



    mouseMenu(" B = Begin new turnament ","=",menlin,mencol,cfont,cback)

    mouseMenu(" C = Continue last turnament ","=",menlin + 2,mencol,cfont,cback)

    mouseMenu(" R = Replay game ","=",menlin + 4,mencol,cfont,cback)

    mouseMenu(" S = Setup ","=",menlin + 6,mencol,cfont,cback,0)

    mouseMenu(" Esc = Quit program ","=",menlin + 8,mencol,cfont,cback)



    Select Case menuitem 'convert menuitem to keystroke

        Case ""

                'do nothing

        Case "Esc"

            keypressed = Chr(27)

        Case Else

            keypressed = LCase(menuitem) 'key

    End Select



    Select Case keypressed

        Case "b" 'begin new turnament

            winEngine(1) = 0

            winEngine(2) = 0

            drawnGames = 0

            moveTime(1) = moveTimePreset

            moveTime(2) = moveTimePreset

            depthEngine(1) = depthPreset

            depthEngine(2) = depthPreset

            gameTime(1) = gameTimePreset

            gameTime(2) = gameTimePreset

            Exit Do

        Case "c" 'continue last turnament

            continueTurnament

            'sleep

            Exit Do

        Case "r" 'replay game

            replayGame

            Exit Do

        Case "s" 'setup menu

            setup

            GoTo mainMenu

        Case Chr(27), Chr(255,107) 'end program

            End

    End Select

Loop



Cls



Do 'turnament loop

    ReDim fen(1)

    ReDim movetable(0)

    If (replayFlag = 0) Or (gameStamp = 0) Then

        gameStamp = Now 'game identifier

    EndIf



    count50 = 0

    castlingFlag = "KQkq"

    humanFlag = 0



    If replayFlag <> 1 Then 'no manual replay

        gameCount += 1 'game counter

        Open ExePath + "\ucilog.txt" For Output As #3 'initiate new file

        Print #3, gamestamp

        Close 3

        Open ExePath + "\fenlog.txt" For Output As #4 'initiate new file

        Print #4, gamestamp

        Close 4

        'swap engines

        If gameCount And 1 Then 'every odd game number

            currentWhite = 1

            currentBlack = 2

        Else 'every even game number

            currentWhite = 2

            currentBlack = 1

        EndIf



        'install the pipes to the two engines

        sa.nLength = SizeOf(SECURITY_ATTRIBUTES)

        sa.lpSecurityDescriptor = NULL

        sa.bInheritHandle = TRUE



        'start and connect white engine

        CreatePipe(@hReadChildPipeWhite,@hWritePipeWhite,@sa,0)

        CreatePipe(@hReadPipeWhite,@hWriteChildPipeWhite,@sa,0)



        GetStartupInfo(@siWhite)



        siWhite.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW

        siWhite.wShowWindow = SW_HIDE

        siWhite.hStdOutput  = hWriteChildPipeWhite

        siWhite.hStdError   = hWriteChildPipeWhite

        siWhite.hStdInput   = hReadChildPipeWhite



        CreateProcess(0,ExePath + "\engines\" + engine(currentWhite),0,0,TRUE,0,0,0,@siWhite,@pi)

        If engine(currentWhite) = "human.exe" Then

            humanFlag = humanFlag Or 1

        EndIf

        hProcessHandleWhite = pi.hProcess



        CloseHandle(hWriteChildPipeWhite)

        CloseHandle(hReadChildPipeWhite)



        'start and connect black engine

        CreatePipe(@hReadChildPipeBlack,@hWritePipeBlack,@sa,0)

        CreatePipe(@hReadPipeBlack,@hWriteChildPipeBlack,@sa,0)



        GetStartupInfo(@siBlack)



        siBlack.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW

        siBlack.wShowWindow = SW_HIDE

        siBlack.hStdOutput  = hWriteChildPipeBlack

        siBlack.hStdError   = hWriteChildPipeBlack

        siBlack.hStdInput   = hReadChildPipeBlack



        CreateProcess(0,ExePath + "\engines\" + engine(currentBlack),0,0,TRUE,0,0,0,@siBlack,@pi)

        If engine(currentBlack) = "human.exe" Then

            humanFlag = humanFlag Or 2

        EndIf

        hProcessHandleBlack = pi.hProcess



        CloseHandle(hWriteChildPipeBlack)

        CloseHandle(hReadChildPipeBlack)

    EndIf



    sImage = ImageCreate( 42, 42, 0 )  'save screen data



    'THIS DETERMINES WHERE TO PLACE BOARD IN WINDOW

    bx = 150

    by = 30



    'read board

    Restore boardLayout

    For j As Integer = 0 To 11

        For i As Integer = 0 To 11

            Read board(i,j)

        Next i

    Next j



    'copy images from data statements to screen

    Restore Pieces

    For i As Integer = 0 To 5   'for each piece

        For y As Integer = 0 To 41  'for each row

            Read datum

            For x As Integer = 0 To 41  'for each column

                Select Case Mid(datum,x+1,1)

                    Case "."

                        PSet(x+i*42,y),RGB(255,0,255) 'transparent color

                        PSet(x+i*42+252,y),RGB(255,0,255)

                    Case "#"

                        PSet(x+i*42,y),RGB(0,0,0)

                        PSet(x+i*42+252,y),RGB(0,0,0)

                    Case "*"

                        PSet(x+i*42,y),RGB(120,120,180)

                        PSet(x+i*42+252,y),RGB(250,200,200)

                End Select

            Next x

        Next y

    Next i

    'sleep



    'allocate memory for 12 images

    For i As Integer = 0 To 11

        iPiece(i) = ImageCreate(42,42,0)

    Next i



    'get set of 12 images

    For i As Integer = 0 To 11

        Get (i*42,0)-(i*42+41,41), iPiece(i)

    Next i



    update()



    'reset variables

    move = ""

    wt.move = "xx xx"

    opponent = b '(!)

    hod = "position startpos moves"

    moves = ""

    mateFlag = 0

    moveCount = 0

    If replayFlag = 0 Then 'no replay

        timeLeft(1) = gameTime(1) * 1000

        timeLeft(2) = gameTime(2) * 1000

        timePlayed(1) = 0

        timePlayed(2) = 0

    EndIf



    If replayFlag <> 1 Then

        Open ExePath + "\gamelog.txt" For Output As #1 'open the protocol file

        Print #1, "game";gameCount

        Print #1, "stamp";gamestamp

        Locate 52,30

        Print "LOADING ENGINES"



        If humanFlag Or 1 Then

            WriteEngineInfo(w,Str(hReadChildPipeBlack))

            WriteEngineInfo(w,Str(hWriteChildPipeBlack))

            WriteEngineInfo(w,Str(hReadPipeBlack))

            WriteEngineInfo(w,Str(hWritePipeBlack))

        EndIf



        If humanflag Or 2 Then

            WriteEngineInfo(b,Str(hReadChildPipeBlack))

            WriteEngineInfo(b,Str(hWriteChildPipeBlack))

            WriteEngineInfo(b,Str(hReadPipeBlack))

            WriteEngineInfo(b,Str(hWritePipeBlack))

        EndIf



        WriteEngineInfo(w,"uci")

        WriteEngineInfo(b,"uci")



        Do

          g = GetEngineResponse(w)

        Loop Until InStr(g,"uciok")

        x = InStr(g,"id name ") + 8

        nameWhite = Mid(g, x, InStr(x,g,Chr(13)) - x) 'get the name of engine 1



        Do

          g = GetEngineResponse(b)

        Loop Until InStr(g,"uciok")

        x = InStr(g,"id name ") + 8

        nameBlack = Mid(g, x, InStr(x,g,Chr(13)) - x) 'get the name of engine 2



        'write to protocol file

        Print #1, "white ";nameWhite;"  (";engine(currentWhite);")"

        Print #1, "black ";nameBlack;"  (";engine(currentBlack);")"

        Print #1, "mode  ";playmode;

        Select Case playmode

            Case "depth"

                Print #1, depth

            Case "movetime"

                Print #1, moveTimePreset

            Case "gametime"

                Print #1, gameTimePreset

        End Select

        Print #1, ""

        'Close 1



        Open ExePath + "\turnamentlog.txt" For Append As #2

        Print #2, ""

        Print #2, "game";gameCount

        Print #2, "stamp";gameStamp

        Print #2, "white ";nameWhite;"   ";engine(currentWhite)

        Print #2, "black ";nameBlack;"   ";engine(currentBlack)

        Print #2, "mode  ";playmode;

        Select Case playmode

            Case "depth"

                Print #2, depth

            Case "movetime"

                Print #2, moveTimePreset;" (+";moveTimeHandicap;")"

            Case "gametime"

                Print #2, gameTimePreset;" (";gameTimeHandicap;")"

        End Select

        Close 2



        'get the "mate"-messages from engine 1

        WriteEngineInfo(w,"position fen 7K/6q1/7b/8/8/8/8/6k1 w - - 3 41 moves")

        WriteEngineInfo(w,"go movetime 10")

        matesign(1) = GetMove("fullwhite")



        'get the "mate"-messages from engine 2

        WriteEngineInfo(b,"position fen 7K/6q1/7b/8/8/8/8/6k1 w - - 3 41 moves")

        WriteEngineInfo(b,"go movetime 10")

        matesign(2) = GetMove("fullblack")



        'Open ExePath + "\gamelog.txt" For Append As #1 'open the protocol file

        Print #1, matesign(1);"*"

        Print #1, matesign(2);"*"

        Close 1



        'set engine 1 options

        setEngineOptions(w)

        setEngineOptions(b)



    EndIf



    '***************  MAIN LOOP ************************

    Do 'next halfmove

        'switch opponents

        humanFlag = 0

        If opponent = w Then

            opponent = b 'black

            If nameBlack = "Colochessum human interface" Then

                humanFlag = 1

            EndIf

        Else

            opponent = w 'white

            moveCount += 1 'move number

            If nameWhite = "Colochessum human interface" Then

                humanFlag = 1

            EndIf

        EndIf



        g = makeFen



        If replayFlag <> 1 Then

            Open ExePath + "\fenlog.txt" For Append As #4 'write fen-string to log fole

            Print #4, g

            Close #4

        EndIf

        Locate 57,1

        ReDim Preserve fen(UBound(fen) + 1)

        fen(UBound(fen)) = g 'write fen-string to table



        ScreenLock

        update

        Scan

        ScreenUnLock

        'showInternalBoard



        mateFlag = 0

        errorCount = 0 'reset the error counter



        Print #1, Time;" ";moveCount;" ";opponent;" ";hod;moves 'write to protocol file

        Print #1, ""



        If replayFlag = 0 Then 'no replay --> calculate next move

            WriteEngineInfo(opponent,hod + moves) 'send the actual board setup to the engine

            ScreenLock

            update()

            Scan

            ScreenUnLock

            Select Case playmode

                Case "depth"

                    Select Case opponent

                        Case w

                            WriteEngineInfo(opponent,"go depth " + Str(depthEngine(currentWhite))) 'depth mode

                        Case b

                            WriteEngineInfo(opponent,"go depth " + Str(depthEngine(currentBlack)))

                    End Select

                Case "movetime"

                    timeRemind = Timer

                    Select Case opponent 'call the actual opponent with its movetime

                        Case w

                            WriteEngineInfo(opponent,"go movetime " + Str(moveTime(currentWhite)))

                        Case b

                            WriteEngineInfo(opponent,"go movetime " + Str(moveTime(currentBlack)))

                    End Select

                Case "gametime"

                    timeRemind = Timer

                    Select Case opponent 'call the actual opponent with its rest time

                        Case w

                            WriteEngineInfo(opponent,"go wtime " + Str(timeLeft(currentWhite)))

                        Case b

                            WriteEngineInfo(opponent,"go btime " + Str(timeLeft(currentBlack)))

                    End Select

            End Select

        EndIf



        move = GetMove(opponent) 'read the "bestmove" from the engine



        If setEngineOptionsFlag Then

            setEngineOptions(w)

            setEngineOptions(b)

            setEngineOptionsFlag = 0

            update

        EndIf



        If move = "Esc" Then 'start a new game

            Close

            CloseEngines

            replayFlag = 0

            GoTo startNew

        EndIf



        If (playmode = "gametime") And (replayFlag = 0) Then 'subtract the calculating time

            Select Case opponent

                Case w

                    timeLeft(currentWhite) -= 1000 * (Timer - timeRemind)

                    If timeLeft(currentWhite) <= 0 Then

                        move = "timeout"

                    EndIf

                Case b

                    timeLeft(currentBlack) -= 1000 * (Timer - timeRemind)

                    If timeLeft(currentBlack) <= 0 Then

                        move = "timeout"

                    EndIf

            End Select

            Open ExePath + "\timelog.txt" For Output As #6

            Print #6, gameStamp

            Print #6, timeLeft(1)

            Print #6, timeLeft(2)

            Close 6

        ElseIf (playmode = "movetime") And (replayFlag = 0) Then 'add the calculating time

            Select Case opponent

                Case w

                    timePlayed(currentWhite) += 1000 * (Timer - timeRemind)

                Case b

                    timePlayed(currentBlack) += 1000 * (Timer - timeRemind)

            End Select

            Open ExePath + "\timelog.txt" For Output As #6

            Print #6, gameStamp

            Print #6, timePlayed(1)

            Print #6, timePlayed(2)

            Close 6

        EndIf



        lastmove = move



        'check if the response is a correct move

        If move = "mate" Then 'checkmate

            If checkForStale Then

                mateFlag = 2 'stalemate

            Else

                mateFlag = 1 'checkmate

            EndIf



        ElseIf move = "timeout" Then

            mateFlag = 6



        ElseIf InStr(Mid(move,1,1),Any "abcdefgh") + _ '1st character

               InStr(Mid(move,2,1),Any "12345678") + _ '2nd character

               InStr(Mid(move,3,1),Any "abcdefgh") + _ '3rd character

               InStr(Mid(move,4,1),Any "12345678") + _ '4th character

               InStr(Mid(move,5,1),Any "qrbn") <> Len(move) Then '5th character (if existing)

          'error

          Locate 52,30

            Print #1, move

            Print #1, "game aborted due to response error caused by  ";

            Select Case opponent

                Case w

                    Print #1, nameWhite

                Case b

                    Print #1, nameBlack

            End Select

            If replayFlag <> 1 Then

                Open ExePath + "\turnamentlog.txt" For Append As #2

                Print #2, hod;moves;"   *";move;"*"

                Print #2, "game aborted due to response error caused by  ";

                Select Case opponent

                    Case w

                        Print #2, nameWhite

                    Case b

                        Print #2, nameBlack

                End Select

            Close 2

            EndIf

            Exit Do 'terminate current game

        EndIf



        Do 'check for drawn game

            If mateFlag Then 'checkmate or stalemate

                Exit Do 'leave the loop

            EndIf



            'check for threefold repetition

            g = makeFen 'create fen-string

            parseFen(makeFen)

            g = fenBoard + fenCastling + fenEnPassant

            y = 0

            For x = UBound(fen) - 1 To 1 Step -1

                parseFen(fen(x))

                g2 = fenBoard + fenCastling + fenEnPassant

                If g2 = g Then

                    y += 1

                    pCon("",String(Len(Str(x)) + 1," ") + g)

                    pCon("",Str(x) + " " + g2)

                    pCon("","")

                EndIf

                If y > 1 Then

                    mateFlag = 3 'threefold repetition

                    Exit Do 'leave the loop

                EndIf

            Next



            'check for dead position

            g = ""

            For x = 1 To InStr(fen(UBound(fen))," ") - 1

                If InStr(Mid(fen(UBound(fen)),x,1),Any "012345678/") = 0 Then   'isolate pieces from fen-string

                    g += Mid(fen(UBound(fen)),x,1)

                EndIf

            Next

            Do 'sort pieces in alphabetical order

                y = 0

                For x = 0 To Len(g) - 2

                    If g[x] > g[x+1] Then

                        Swap g[x],g[x+1]

                        y = 1

                    EndIf

                Next

            Loop While y

            Select Case LCase(g) 'check for pieces left on the board

                Case "kk","kbk","knk","kkb","kkn"

                    mateFlag = 4

                    Exit Do 'leave the loop

            End Select



            'check for 50-moves-rule

            If count50 > 99 Then

                mateFlag = 5

                Exit Do 'leave the loop

            EndIf



        Loop Until 1 'always leave the loop



        If mateFlag Then 'end game

            'showInternalBoard

            If replayFlag <> 1 Then

                Open ExePath + "\gamelog.txt" For Append As #1

                Open ExePath + "\turnamentlog.txt" For Append As #2

            EndIf

            Select Case mateFlag

                Case 1 'checkmate

                    Locate 51,29

                    Print " << CHECK MATE >> "

                    'write to protocol file

                    Print #1, " << CHECK MATE >> "

                    Locate 69,20

                    Select Case opponent 'set the win counter and write to protocol file

                        Case w

                            Print #1, "black (";nameBlack;

                            Print "<< BLACK (";nameBlack;

                            winEngine(currentBlack) += 1 'winner

                            Select Case playmode

                                Case "movetime"

                                    moveTime(currentWhite) += moveTimeHandicap 'loser

                                    moveTime(currentBlack) -= moveTimeHandicap 'winner

                                Case "depth"

                                    depthEngine(currentWhite) += depthHandicap 'loser

                                    depthEngine(currentBlack) -= depthHandicap 'winner

                                Case "gametime"

                                    gameTime(currentWhite) += gameTimeHandicap 'loser

                                    gameTime(currentBlack) -= gameTimeHandicap 'winner

                            End Select

                        Case b

                            Print #1, "white (";nameWhite;

                            Print "<< WHITE (";nameWhite;

                            winEngine(currentWhite) += 1 'winner

                            Select Case playmode

                                Case "movetime"

                                    moveTime(currentBlack) += moveTimeHandicap 'loser

                                    moveTime(currentWhite) -= moveTimeHandicap 'winner

                                Case "depth"

                                    depthEngine(currentBlack) += depthHandicap 'loser

                                    depthEngine(currentWhite) -= depthHandicap 'winner

                                Case "gametime"

                                    gameTime(currentBlack) += gameTimeHandicap 'loser

                                    gameTime(currentWhite) -= gameTimeHandicap 'winner

                            End Select

                    End Select

                    Print #1, ") wins in"; moveCount; " moves"

                    Print ") wins in"; moveCount; " moves >>"



                    'write to turnament log

                    If replayFlag <> 1 Then

                        Open ExePath + "\turnamentlog.txt" For Append As #2

                    EndIf

                    Print #2, "check mate   ";

                    Select Case opponent

                        Case w

                            Print #2, nameBlack;" wins as black ";

                        Case b

                            Print #2, nameWhite;" wins as white ";

                    End Select

                    Print #2, "in"; moveCount; " moves"



                    'showInternalBoard



                Case 2 'stalemate

                    drawnGames += 1

                    Print #2, "drawn because of stalemate after"; moveCount; " moves"

                    Locate 51,29

                    Print " << STALE MATE >> "

                Case 3 'threefold repetition

                    drawnGames += 1

                    Print #2, "drawn because of threefold repetition after"; moveCount; " moves"

                    Locate 51,29

                    Print " << THREEFOLD REPETITION    >> "

                Case 4 'dead position

                    drawnGames += 1

                    Print #2, "drawn because of dead position after"; moveCount; " moves"

                    Locate 51,29

                        Print " << DEAD POSITION >> "

                Case 5 '50-moves-rule

                    drawnGames += 1

                    Print #2, "drawn because of breaking the 50-moves-rule after"; moveCount; " moves"

                    Locate 51,29

                    Print " << 50 MOVES >> "

                Case 6 'timeout

                    update

                    Locate 51,29

                    Print " << TIMEOUT >> "

                    'write to protocol file

                    Print #1, " << TIMEOUT >> "

                    Locate 69,20

                    Select Case opponent 'set the win counter and write to protocol file

                        Case w

                            Print #1, "black (";nameBlack;

                            Print "<< BLACK (";nameBlack;

                            winEngine(currentBlack) += 1 'winner

                            Select Case playmode

                                Case "movetime"

                                    moveTime(currentWhite) += moveTimeHandicap 'loser

                                    moveTime(currentBlack) -= moveTimeHandicap 'winner

                                Case "depth"

                                    depthEngine(currentWhite) += depthHandicap 'loser

                                    depthEngine(currentBlack) -= depthHandicap 'winner

                                Case "gametime"

                                    gameTime(currentWhite) += gameTimeHandicap 'loser

                                    gameTime(currentBlack) -= gameTimeHandicap 'winner

                            End Select

                        Case b

                            Print #1, "white (";nameWhite;

                            Print "<< WHITE (";nameWhite;

                            winEngine(currentWhite) += 1 'winner

                            Select Case playmode

                                Case "movetime"

                                    moveTime(currentBlack) += moveTimeHandicap 'loser

                                    moveTime(currentWhite) -= moveTimeHandicap 'winner

                                Case "depth"

                                    depthEngine(currentBlack) += depthHandicap 'loser

                                    depthEngine(currentWhite) -= depthHandicap 'winner

                                Case "gametime"

                                    gameTime(currentBlack) += gameTimeHandicap 'loser

                                    gameTime(currentWhite) -= gameTimeHandicap 'winner

                            End Select

                    End Select

                    Print #1, ") wins in"; moveCount; " moves"

                    Print ") wins in"; moveCount; " moves >>"



                    'write to turnament log

                    If replayFlag <> 1 Then

                        Open ExePath + "\turnamentlog.txt" For Append As #2

                    EndIf

                    Print #2, "timeout   ";

                    Select Case opponent

                        Case w

                            Print #2, nameBlack;" wins as black ";

                        Case b

                            Print #2, nameWhite;" wins as white ";

                    End Select

                    Print #2, "in"; moveCount; " moves"



            End Select

            Print #2, Mid(moves,2)

            Print #2, "*";lastmove;"*"

            Print #2, "total won ";engine(1);winEngine(1)

            Print #2, "total won ";engine(2);winEngine(2)

            Print #2, "total drawn ";drawnGames

            Close



            If replayFlag Then

                Sleep

            Else

                Sleep 10000

            EndIf



            Exit Do 'start next game

        EndIf



        moves += " " + move 'add the last move to the hod-string

        'showInternalBoard



        'save the moves string

        If replayFlag <> 1 Then

            Open ExePath + "\moveslog.txt" For Output As #5

            Print #5, gameStamp

            Print #5, Mid(moves,2)

            Close 5

        EndIf

        'add the last move to the movetable

        ReDim Preserve movetable(UBound(movetable) + 1)

        If opponent = w Then

            movetable(UBound(movetable)) = Right("  " + Str(moveCount),3)

        Else

            movetable(UBound(movetable)) = "   "

        EndIf

        movetable(UBound(movetable)) += " " + UCase(Left(move,2)) + " " + _

                                        UCase(Mid(move,3,2)) + " " + _

                                        UCase(Mid(move,5,1)) + " "



        wt.move = UCase(Left(move,2) + " " + Mid(move,3)) 'for title bar

        SetTitleBar 'set screenwindow title bar

        PrintMoveTable



        'update castlig flag

        Select Case Left(move,2)

            Case "a1" 'left white rook

                castlingFlag = deleteFromString(castlingFlag,"Q")

            Case "h1" 'right white rook

                castlingFlag = deleteFromString(castlingFlag,"K")

            Case "e1" 'white king

                castlingFlag = deleteFromString(castlingFlag,"QK")

            Case "a8" 'left black rook

                castlingFlag = deleteFromString(castlingFlag,"q")

            Case "h8" 'right black rook

                castlingFlag = deleteFromString(castlingFlag,"k")

            Case "e8" 'black king

                castlingFlag = deleteFromString(castlingFlag,"qk")

        End Select



        'show animated move

        cMove = strMoveToNumMove(move)

        makeMove(cMove)

        'show animated castling

        If (move = "e1g1") And pchoice = 6 Then

            cMove = strMoveToNumMove("h1f1")

            makeMove(cMove)

        ElseIf (move = "e1c1") And pchoice = 6 Then

            cMove = strMoveToNumMove("a1d1")

            makeMove(cMove)

        ElseIf (move = "e8g8") And pchoice = -6 Then

            cMove = strMoveToNumMove("h8f8")

            makeMove(cMove)

        ElseIf (move = "e8c8") And pchoice = -6 Then

            cMove = strMoveToNumMove("a8d8")

            makeMove(cMove)

        EndIf



        ScreenLock

        update()

        Scan

        ScreenUnLock

        'showInternalBoard



        g = Inkey 'check for keyboard input

        Do

            Select Case g

                Case Chr(27) 'terminate current game

                    drawnGames += 1

            End Select

            g = Inkey 'check for key pressed

        Loop While Len(g)



    Loop Until (g = Chr(27))



    If g = Chr(27) Then

        drawnGames += 1

    EndIf

    CloseEngines

    Close



Loop 'next game



Close

End



Sub update()

    Dim As Integer x, y

    Dim As Double t



    'draw board

    Color cfont,cback

    Cls

    Dim As Integer shade

    shade = 1

    For y As Integer = 0 To 7

        shade = -shade

        For x As Integer = 0 To 7

            If shade = -1 Then

                Line (bx+x*42,by+y*42)-(bx+x*42+41,by+y*42+41),RGB(252,206,156),bf

            Else

                Line (bx+x*42,by+y*42)-(bx+x*42+41,by+y*42+41),RGB(179,110,44),bf

            End If

            shade = -shade

        Next x

    Next y

    'border of board

    Line (bx-1,by-1)-(bx+336,by+336),cfont,b



    'now draw image on square

    For y As Integer = 0 To 7 'column

        For x As Integer = 0 To 7 'line

            'put image onto square

            If board(x+2,y+2) <> 7 And board(x+2,y+2) <> 0 Then

                If board(x+2,y+2) < 0 Then 'black

                    Put (bx+x*42,by+y*42),iPiece(Abs(board(x+2,y+2))-1),Trans

                Else 'white

                    Put (bx+x*42,by+y*42),iPiece(Abs(board(x+2,y+2))+5),Trans

                End If

            End If

        Next x

    Next y

    'print engine names and coordinates on screen

    Locate 2,22

    Print nameBlack

    Locate 49,22

    Print nameWhite

    For x = 1 To 8

        Locate 48 - 5.15 * x,17

        Print x

    Next

    Locate 47,22

    Draw String (168,371), "A    B     C    D    E    F    G     H"

    Locate 22,2

    Print "Game";gameCount

    Locate 23,2

    Print "Move";moveCount;" (";Str(count50);")"

    Locate 54,22

    Print "engine 1: ";engine(1)

    Select Case playmode

        Case "movetime"

            Print Tab(22);"movetime:";moveTime(1);" ms"

        Case "depth"

            Print Tab(25);"depth:";depthEngine(1)

        Case "gametime"

            Print Tab(22);"gametime: ";timeFormat(gameTime(1),1)

    End Select

    Print Tab(27);"won:";winEngine(1)

    Print

    Print Tab(22);"engine 2: ";engine(2)

    Select Case playmode

        Case "movetime"

            Print Tab(22);"movetime:";moveTime(2);" ms"

        Case "depth"

            Print Tab(25);"depth:";depthEngine(2)

        Case "gametime"

            Print Tab(22);"gametime: ";timeFormat(gameTime(2),1)

    End Select

    Print Tab(27);"won:";winEngine(2)

    Print

    Print Tab(19);"drawn games:";drawnGames

    Print

    Print Tab(15);"animation speed:";animationSpeed

    Print Tab(22);"playmode: ";playmode

    Print Tab(22);"handicap:";

    Select Case playmode

        Case "movetime"

            t = Abs(moveTimeHandicap * (winEngine(1) - winEngine(2)))

            Print t;" ms (";CInt(100 * t / moveTimePreset);"% )"

        Case "depth"

            Print Abs(depthHandicap * (winEngine(1) - winEngine(2)))

        Case "gametime"

            t = Abs(gameTimeHandicap * (winEngine(1) - winEngine(2)))

            Print " ";timeFormat(t,1);

            Print " (";CInt(100 * t / gameTimePreset);"% )"

    End Select



    PrintMoveTable



    If replayFlag = 1 Then

        Locate 2,30

        Print "R E P L A Y   M O D E"

        Locate 42,1

        Print " ---------------"

        Print

        Print

        Print

        Print " ---------------"

        showInternalBoard

    EndIf

    'showInternalBoard

End Sub



Sub makeMove(cMove As chessMove)

    Dim As Integer choice, i, x  'number of selected piece

    Dim As Integer px1, py1, px2, py2, dx, dy  'moving data

    Dim As Double timeRem

    Dim As String g



    cMove.y1 = 8 - cMove.y1 'set correct line of internal board

    cMove.y2 = 8 - cMove.y2



    px1 = cMove.x1*42+bx   'screen pointer to chosen image

    py1 = cMove.y1*42+by

    px2 = cMove.x2*42+bx

    py2 = cMove.y2*42+by



    ox = px1

    oy = py1



    'make move on internal board

    choice = board(cMove.x1+2,cMove.y1+2)

    pchoice = choice



    count50 += 1

    If board(cMove.x2+2,cMove.y2+2) Then 'piece is captured

        Mid(movetable(UBound(movetable)),7,1) = "x"

        Mid(wt.move,3,1) = "x"

        SetTitleBar

        PrintMoveTable

        count50 = 0

    EndIf

    If Abs(choice) = 1 Then 'pawn is moved

        count50 = 0

    EndIf



    board(cMove.x2+2,cMove.y2+2) = choice

    board(cMove.x1+2,cMove.y1+2)=0  'erase data



    'convert to image ID of that number

    If choice < 0 Then

        choice = Abs(choice) - 1

    Else

        choice = choice + 5

    End If



    Select Case replayFlag

        Case 0, 1 'no or manual replay



            Line (px1,py1)-(px1+41,py1+41),Point(px1+4,py1+4),bf 'clear

            For i = 0 To 3

                Line (px1+i,py1+i)-(px1+41-i,py1+41-i),RGB(0,0,244),b  'source

                Line (px2+i,py2+i)-(px2+41-i,py2+41-i),RGB(0,255,0),b  'destination

            Next i



            'compute direction of movement

            If px1 > px2 Then

                dx = -1

            Else

                dx = 1

            End If

            If py1 > py2 Then

                dy = -1

            Else

                dy = 1

            End If



            Get (px1,py1)-(px1+41,py1+41),sImage

            Put (px1,py1),iPiece(choice),Trans

            ox = px1

            oy = py1



            timeRem = Timer

            While px1 <> px2 Or py1 <> py2

                If Timer > timeRem + .001 * animationSpeed Then

                    timeRem += .001 * animationSpeed'Timer



                    'update coordinates

                    If px1 <> px2 Then

                        px1 = px1 + dx

                    End If

                    If py1 <> py2 Then

                        py1 = py1 + dy

                    End If



                    ScreenLock

                    Put (ox,oy),sImage,PSet        'restore old back ground

                    Get (px1,py1)-(px1+41,py1+41),sImage 'save new back ground

                    Put (px1,py1),iPiece(choice),Trans  'place on new back ground

                    ox = px1

                    oy = py1

                    ScreenUnLock

                    Scan

                EndIf

            Wend



        Case 2 'instant replay



    End Select



    If Len(move) = 5 Then 'pawn promotion

        Select Case Mid(move,5,1) 'promote pawn to...

            Case "q"

                choice = Sgn(pchoice) * 5 'queen

            Case "b"

                choice = Sgn(pchoice) * 4 'bishop

            Case "n"

                choice = Sgn(pchoice) * 3 'knight

            Case "r"

                choice = Sgn(pchoice) * 2 'rook

        End Select

        board(cMove.x2+2,cMove.y2+2) = choice

    EndIf



    parseFen(fen(UBound(fen)))



    If (Mid(move,3,2) = fenEnPassant) And (Abs(pchoice) = 1) Then 'en passant

        pCon("en passant","")

        Dim As Integer ff

        Open ExePath + "\enpassantlog.txt" For Append As ff

        Print #ff, "game ";gameCount

        Print #ff, "move ";moveCount

        Print #ff, "opponent ";opponent

        Print #ff, ""

        Close ff

        If cMove.y2 = 5 Then 'remove captured white pawn

            board(cMove.x2+2,6) = 0

        ElseIf cMove.y2 = 2 Then 'remove captured black pawn

            board(cMove.x2+2,5) = 0

        EndIf

        Mid(movetable(UBound(movetable)),7,1) = "x"

        Mid(wt.move,3,1) = "x"

        SetTitleBar

        PrintMoveTable

    EndIf

End Sub



'convert string chess moves to numbers

Function strMoveToNumMove(move As String) As chessMove

    Dim As chessMove cm

    Dim As String umove



    umove = UCase(move)



    cm.x1 = Asc(Mid(umove,1,1))-65

    cm.y1 = Val(Mid(umove,2,1))

    cm.x2 = Asc(Mid(umove,3,1))-65

    cm.y2 = Val(Mid(umove,4,1))



    Return cm

End Function



'convert chess move numbers to string format

Function numMovetoStrMove(cm As chessMove) As String

    Return Chr(cm.x1+65)+Str(cm.y1)+Chr(cm.x2+65)+Str(cm.y2)

End Function



Function GetMove(opp As String) As String

    Static As Integer begPtr, endPtr

    Static As String oldReplayMoves



    Dim As String g, sRet, key

    Dim As Integer x, full = 0, repmerk



    Scan



    If (replayMoves <> oldReplayMoves) Or (endPtr >= Len(replayMoves)) Then 'reset string pointers

        oldReplayMoves = replayMoves

        begPtr = 0

        endPtr = 0

    EndIf



    If Left(opp,4) = "full" Then 'don't edit the move message

        full = 1

        opp = Mid(opp,5)

        repmerk = replayFlag

        replayFlag = 0

    EndIf

    wt.opponent = opp 'for title bar



    Select Case replayFlag

        Case 0 'no replay

            g = ""

            Do

                key = InKey

                Select Case key

                    Case Chr(27)

                        Return "Esc" 'terminate game

                    'Case Chr(255,107) 'end program

                    '   End

                End Select



                g += GetEngineResponse(opp) 'request a message from the engine

                'print opponent and current depth to the screen

                x = InStrRev(g,"info depth ")

                currDepth = Str(Val(Mid(g,x+11,2)))

                Locate 25, 2

                Print UCase(opp)

                Locate 26, 2

                Print "   depth ";currDepth;" "

                wt.depth = currDepth 'for title bar

                SetTitleBar 'set title bar

                Locate 27,2

                Print "currmove "



                If (playmode = "gametime") And (timeRemind > 0) Then

                    Select Case opp

                        Case w

                            Locate 5,10

                            Print timeFormat(timeLeft(currentBlack)/1000,1)

                            Locate 46,9

                            Color cfont,cbacklt

                            Print " ";timeFormat(timeLeft(currentWhite)/1000 - (Timer - timeRemind),1);" "

                            Color cfont,cback

                        Case b

                            Locate 5,9

                            Color cfont,cbacklt

                            Print " ";timeFormat(timeLeft(currentBlack)/1000 - (Timer - timeRemind),1);" "

                            Color cfont,cback

                            Locate 46,10

                            Print timeFormat(timeLeft(currentWhite)/1000,1)

                    End Select

                ElseIf timeRemind > 0 Then

                    Select Case opp

                        Case w

                            Locate 5,10

                            Print timeFormat(timePlayed(currentBlack)/1000,1)

                            Locate 46,9

                            Color cfont,cbacklt

                            Print " ";timeFormat(timePlayed(currentWhite)/1000 + (Timer - timeRemind),1);" "

                            Color cfont,cback

                        Case b

                            Locate 5,9

                            Color cfont,cbacklt

                            Print " ";timeFormat(timePlayed(currentBlack)/1000 + (Timer - timeRemind),1);" "

                            Color cfont,cback

                            Locate 46,10

                            Print timeFormat(timePlayed(currentWhite)/1000,1)

                    End Select

                EndIf



                x = InStrRev(g,"bestmove")

            Loop Until x 'the engine has finished the calculating for this move



            sRet = Mid(g,x + 9,InStr(x + 9,g," ") - (x + 9)) 'isolate the data of the move



        Case 1 'manual replay

                Do 'manual replay loop

                    g = Inkey

                    menuitem = ""

                    mouseMenu(" PgDn -> move ","->",43,6,cfont,cback)

                    mouseMenu(" PgUp -> back ","->",44,6,cfont,cback)

                    mouseMenu(" Esc -> quit ","->",45,6,cfont,cback)



                    Select Case menuitem 'convert menuitem to keystroke

                        Case ""

                            'do nothing

                        Case "PgDn"

                            g = Chr(255,81) 'page down

                        Case "PgUp"

                            g = Chr(255,73) 'page up

                        Case "Esc"

                            g = Chr(27) 'esc

                        Case Else

                            'do nothing

                    End Select



                    Select Case g

                        Case Chr(255,81) 'page down --> next move

                            'parse moves list

                            begPtr = endPtr

                            endPtr = InStr(begPtr + 1,replayMoves," ")

                            If endPtr = 0 Then

                                endPtr = begPtr

                            EndIf

                            sRet = Mid(replayMoves,begPtr + 1,endPtr - begPtr - 1)

                            Exit Do



                        Case Chr(255,73) 'page up --> one move back

                            If UBound(fen) > 2 Then 'fen-strings available

                                sRet = Mid(replayMoves,begPtr + 1,endPtr - begPtr - 1)

                                ReDim Preserve movetable(UBound(movetable) - 1)

                                ReDim Preserve fen(UBound(fen) - 1)

                                fenToBoard(fen(UBound(fen)))

                                update

                                endPtr = begPtr

                                begPtr = InStrRev(replayMoves," ",endPtr - 1)

                            EndIf



                        Case Chr(27) 'Esc --> main menu

                            Return "Esc"



                        Case Chr(255,107) 'end program

                            End

                    End Select

                Loop



        Case 2 'instant replay

            g = GetEngineResponse(opp) 'request a message from the engine

            begPtr = endPtr

            endPtr = InStr(begPtr + 1,replayMoves," ")

            If endPtr = 0 Then

                endPtr = begPtr

            EndIf

            sRet = Mid(replayMoves,begPtr + 1,endPtr - begPtr - 1)

            If endPtr = Len(replayMoves) Then

                replayFlag = 0

                timeRemind = Timer

                pCon("FENs n ",UBound(fen))

            EndIf



    End Select



    If full Then ' don't edit the message

        replayFlag = repmerk

        Return sRet

    EndIf



    For x = 1 To 2

        If Left(sRet,4) = Left(matesign(x),4) Then

            Return "mate"

        EndIf

    Next



    Select Case Mid(sRet,5,1)

        Case "q","b","n","r" 'pawn promotion

            sRet = Left(sRet,5) 'clip string to 5 characters

        Case Else

            sRet = Left(sRet,4) 'clip string to 4 characters

    End Select



    Return sRet 'send the move to the gui



End Function



Function GetEngineResponse(opp As String) As String

    Dim As Integer iTotalBytesAvail, iNumberOfBytesWritten, iBytesToRead, px1, py1, px2, py2, i

    Dim As String sRet = "", sBuf

    Dim As chessMove cfield



    Const As Integer MaxBytesToRead = 4096 'maximum number of bytes to be returned at one 'ReadFile'-operation



    Do

        Scan



        sBuf = "" 'clear buffer



        'look if there's any data in the pipe

        Select Case opp 'choose engine

            Case "white"

                PeekNamedPipe(hReadPipeWhite,NULL,NULL,NULL,@iTotalBytesAvail,NULL)

            Case "black"

                PeekNamedPipe(hReadPipeBlack,NULL,NULL,NULL,@iTotalBytesAvail,NULL)

        End Select



        If iTotalBytesAvail Then 'pipe is not empty

            If iTotalBytesAvail < MaxBytesToRead Then

                iBytesToRead = iTotalBytesAvail 'set all available bytes to be read

            Else

                iBytesToRead = MaxBytesToRead 'set the first 4096 bytes to be read

            EndIf

            sBuf = String(iBytesToRead,Chr(0)) 'set the length of the buffer string to the necessary value



            'read the specified amount of bytes from the pipe

            Select Case opp 'choose engine

                Case "white"

                    ReadFile(hReadPipeWhite,StrPtr(sBuf),iBytesToRead,@iNumberOfBytesWritten,NULL)

                Case "black"

                    ReadFile(hReadPipeBlack,StrPtr(sBuf),iBytesToRead,@iNumberOfBytesWritten,NULL)

            End Select



            sRet += sBuf 'add the buffer to the return string

            Sleep 1

        Else 'pipe is empty

            Exit Do 'return

        EndIf

    Loop



    If replayFlag <> 1 Then

        Open ExePath + "\ucilog.txt" For Append As #3

        Print #3, ""

        Print #3, "RECEIVE FROM: ";opp

        Print #3, sRet;"*"

        Print #3, "----------"

        Close 3

    EndIf

    If InStr(sRet,"currmove") Then

        Locate 27,11

        Print Mid(sRet,InStr(sRet,"currmove")+9,4)

    EndIf



    If InStr(sRet,"fieldset") Then



        cfield = strMoveToNumMove(Mid(sRet,InStr(sRet,"fieldset") + 9,2)+"a1")



        cfield.y1 = 8 - cfield.y1 'set correct line of internal board

        cfield.y2 = 8 - cfield.y2



        px1 = cfield.x1*42+bx   'screen pointer to chosen image

        py1 = cfield.y1*42+by

        px2 = cfield.x2*42+bx

        py2 = cfield.y2*42+by



        For i = 0 To 3

            Line (px1+i,py1+i)-(px1+41-i,py1+41-i),RGB(0,0,244),b  'source

        Next

    EndIf



    If InStr(sRet,"fieldreset") Then

        update

    EndIf



    If Len(sRet) Then

        pCon(opp,sRet)

    EndIf

    'Sleep 500

    Return sRet

End Function



Sub WriteEngineInfo(opp As String, s As String)

    Dim As Integer iNumberOfBytesWritten

    Dim As String sBuf



    sBuf = s + Chr(10)



    If replayFlag <> 1 Then

        Open ExePath + "\ucilog.txt" For Append As #3

        Print #3,""

        Print #3, "SEND TO: ";opp

        Print #3, s

        Print #3, "----------"

        Close 3

    EndIf



    'send the command string to the engine

    Select Case opp 'choose engine

        Case "white"

            WriteFile(hWritePipeWhite,StrPtr(sBuf),Len(sBuf),@iNumberOfBytesWritten,NULL)

        Case "black"

            WriteFile(hWritePipeBlack,StrPtr(sBuf),Len(sBuf),@iNumberOfBytesWritten,NULL)

    End Select



End Sub



Sub SetTitleBar

    Dim As String text



    'set the text of the screen window

    text = Left(UCase(wt.opponent),1) + " " + wt.move + " " + wt.depth

    WindowTitle(text)



End Sub



Sub CloseEngines



    TerminateProcess(hProcessHandleWhite, @ExitCode)

    TerminateProcess(hProcessHandleBlack, @ExitCode)

    CloseHandle(hWritePipeBlack)

    CloseHandle(hReadPipeBlack)



End Sub



Function makeFen() As String

    Dim As Integer x, col, lin, countFree, first, last

    Dim As String fenPcs, g, fptest



    For col = 2 To 9 'column

        For lin = 2 To 9 'line

            fenpcs += Mid("kqbnrp0PRNBQK ",board(lin,col) + 7,1) 'convert internal board to fen-string

        Next

    Next



    'compress fen-string

    countFree = 0

    g = ""

    For x = 1 To Len(fenpcs)

        If Mid(fenpcs,x,1) = "0" Then

            countFree += 1

        Else

            If countFree Then

                g += Str(countFree)

                countFree = 0

            EndIf

            g += Mid(fenpcs,x,1)

        EndIf

    Next



    fenpcs = Left(g,Len(g) - 1) + " " + Left(opponent,1) 'add opponent



    If Len(castlingFlag) Then 'castling

        fenpcs += " " + castlingFlag

    Else

        fenpcs += " -"

    EndIf



    If Abs(pchoice) = 1 Then 'add en passant information

        Select Case move

            Case "a2a4"

                fenpcs += " a3"

            Case "b2b4"

                fenpcs += " b3"

            Case "c2c4"

                fenpcs += " c3"

            Case "d2d4"

                fenpcs += " d3"

            Case "e2e4"

                fenpcs += " e3"

            Case "f2f4"

                fenpcs += " f3"

            Case "g2g4"

                fenpcs += " g3"

            Case "h2h4"

                fenpcs += " h3"

            Case "a7a5"

                fenpcs += " a6"

            Case "b7b5"

                fenpcs += " b6"

            Case "c7c5"

                fenpcs += " c6"

            Case "d7d5"

                fenpcs += " d6"

            Case "e7e5"

                fenpcs += " e6"

            Case "f7f5"

                fenpcs += " f6"

            Case "g7g5"

                fenpcs += " g6"

            Case "h7h5"

                fenpcs += " h6"

            Case Else

                fenpcs += " -"

        End Select

    Else

        fenpcs += " -"

    EndIf



    fenpcs += " " + Str(count50) + " " + Str(moveCount) 'add counters



    Return fenpcs



End Function



Sub PrintMoveTable

    Dim As Integer x, listlen



    listlen = UBound(movetable)

    If listlen > 42 Then

        listlen = 42

    EndIf

    For x = 1 To listlen

        Locate 46 - listlen + x , 63

        Print movetable(UBound(movetable) - listlen + x)

    Next



End Sub



Function deleteFromString(text As String, del As String) As String

    Dim As String g

    Dim As Integer x, y



    For x = 1 To Len(text)

        If InStr(Mid(text,x,1), Any del) = 0 Then

            g += Mid(text,x,1)

        EndIf

    Next



    Return g



End Function



Sub fenToBoard(fen As String)

    Dim As Integer x, y, i, row, col

    Dim As String opp, g



    row = 2

    col = 1



    parseFen(fen)

    For x = 1 To InStr(fen," ") - 1

        Select Case Mid(fen,x,1)

            Case "1" To "8" 'empty field(s)

                i = Val(Mid(fen,x,1))

                For y = 1 To i

                    board(col + y, row) = 0 'empty field

                Next

                col += i

            Case "/" 'next row

                row += 1

                col = 1

            Case Else

                col += 1 'next column

                board(col,row) = InStr("PRNBQKprnbqk",Mid(fen,x,1)) 'put piece to field

                If board(col,row) > 6 Then 'black piece

                    board(col,row) = -1 * (board(col,row) - 6) 'convert sign

                EndIf

        End Select

    Next

    If fenOpponent = "w" Then

        opponent = w

    Else

        opponent = b

    EndIf

    castlingFlag = fenCastling

    count50 = Val(fenHalfmoves)

    moveCount = Val(fenMoves)



End Sub



Sub showInternalBoard()

    Dim As Integer col, row



    Locate 50,1

    Print "    2 3 4 5 6 7 8 9 "

    For row = 2 To 9 'row

        Print 10-row;"|";

        For col = 2 To 9 'column

            Print board(col,row);

        Next

        Print "|";row;" "

    Next

    Print "    A B C D E F G H "



End Sub



Sub pCon(t As String = "",text As String)

    'print to console window

    Dim kf As Integer = FreeFile

    Open Cons For Output As #kf

    Print #kf, t;

    Print #kf, text

    Close kf

End Sub

Sub pCon(text As String)

    pCon("",text)

End Sub

Sub pCon(x As Integer)

    pCon("",Str(x))

End Sub

Sub pCon(t As String = "",x As Integer)

    pCon(t,Str(x))

End Sub



Function checkForStale() As Integer



Dim As Integer x, col, row, drow, dcol, kingrow, kingcol, kingsig



    ScreenLock

    update

    Scan

    ScreenUnLock



    'set Sgn of the mated king

    If opponent = w Then

        kingsig = 1

    Else

        kingsig = -1

    EndIf



    'get the internal coordinates of the mated king

    For row = 2 To 9

        For col = 2 To 9

            If board(col,row) = kingsig * 6 Then 'mated king found

                kingrow = row

                kingcol = col

                Exit For,For 'terminate searching

            EndIf

        Next

    Next



    'let the mated king look around

    For dcol = -1 To 1 'left -> rest -> right

        For drow = -1 To 1 'up -> rest -> down

            col = kingcol 'start at king coordinates

            row = kingrow

            Do 'look along the desired direction

                col += dcol 'next field

                row += drow

                If board(col,row) Then 'field not empty

                    If (board(col,row) = 7) Or (Sgn(board(col,row)) = kingsig) Then 'border or piece of own colour

                        Exit Do 'next direction

                    EndIf

                    Select Case Abs(board(col,row)) 'kind of piece

                        Case 1 'pawn

                            If (Abs(kingcol - col) = 1) And ((kingrow - row) = kingsig) Then 'check by pawn

                                Return 0

                            Else

                                Exit Do 'next direction

                            EndIf

                        Case 2 'rook

                            If (dcol = 0) Or (drow = 0) Then    'mated king is looking straight

                                Return 0

                            EndIf

                        Case 4 'bishop

                            If (dcol <> 0) And (drow <> 0) Then 'mated king is looking diagonal

                                Return 0

                            EndIf

                        Case 5 'queen

                            Return 0

                    End Select

                EndIf

            Loop

        Next

    Next



    Restore knightCheck

    For x = 1 To 8

        Read dcol, drow

        If Abs(board(kingcol + dcol, kingrow + drow)) = kingsig * -3 Then 'knight

            Return 0

        EndIf

    Next



    Return 1 'stalemate



End Function



#Macro PrintMenuItem()



    Color foreground, background 'normal colours

    compareColor = foreground + 16 * background

    PrintMenuItemMain()



#EndMacro



#Macro PrintMenuItemInv()



    Color background, foreground 'inverse colours

    compareColor = background + 16 * foreground

    PrintMenuItemMain()



#EndMacro



#Macro PrintMenuItemMain()



    For x = 1 To Len(text)

    If (Screen(lin,col - 1 + x,0) <> Asc(Mid(text,x,1))) Or _

         (Screen(lin,col - 1 + x,1) <> compareColor) Then 'only print if necessary

        Locate lin, col, 0 'adjust menu item to separator

        Print text

        Exit For

    EndIf

    Next



#EndMacro



Sub mouseMenu(text As String, separator As String, lin As Integer = 0, col As Integer = 0, _

                  foreground As UInteger, background As UInteger, mode As Integer = 0)

  'mode 0 -> highlight at touch with cursor

  'mode 1 -> highlight at click



  Dim As Integer mc, ml, wheel, buttons, textmin, textmax, x, compareColor, separatorpos



  If lin = 0 Then

    lin = CsrLin

  EndIf

  If col = 0 Then

    col = Pos

  EndIf



  If separator = "" Then

    separatorpos = Len(text) 'whole text as return value

  Else

    separatorpos = InStr(text,separator) - 1 'text left from separator as return value

    col = col - separatorpos + 1 'position text at separator

  EndIf



  If col < 1 Then

    col = 1

  EndIf



  textmin = col - 2

    textmax = textmin + Len(text) + 1



    GetMouse (mc,ml,wheel,buttons)

  mc = mc / 8 'text column

  ml = ml / 8 'text line



  menuitemhit = 0

  Select Case mode

    Case 0 'highlight when touching

        If ml + 1 = lin Then 'mouse line = text line

            Select Case mc

                Case textmin To textmax 'cursor touches the text

                    menuitemhit = 1

                    PrintMenuItemInv() 'highlight menu item

                    If (buttons And 1) Then 'left mouse button pressed

                        Do 'wait for release of the mouse button

                            GetMouse (mc,ml,wheel,buttons)

                        Loop While buttons

                        menuitem = Trim(Left(text,separatorpos)) 'isolate menu item and write to global variable

                    EndIf

                    Return

            End Select

        EndIf

    Case 1 'highlight at click

        If (buttons And 1) Then 'linke mouse button pressed

            If ml + 1 = lin Then 'mouse line = text line

                Select Case mc

                    Case textmin To textmax 'cursor touches the text

                        PrintMenuItemInv() 'highlight menu item

                        Do 'wait for release of the mouse button

                            GetMouse (mc,ml,wheel,buttons)

                        Loop While buttons

                        menuitem = Trim(Left(text,separatorpos)) 'isolate menu item and write to global variable

                        Return

                End Select

            EndIf

        EndIf

  End Select



  PrintMenuItem()



End Sub



Sub continueTurnament()

    Dim As String tl(2,20)

    Dim As Integer filepointer(2)

    Dim As String g

    Dim As Integer ff, x

    Dim As Double stampCompare



    ff = FreeFile

    Open ExePath + "\turnamentlog.txt" For Input As ff



    Do 'find and read the entries of the last 2 games

        Line Input #ff, g

        For x = 1 To UBound(tl,2) 'carry over the last game entry

            tl(1,x) = tl(2,x)

            tl(2,x) = ""

        Next

        filepointer(1) = filepointer(2)

        tl(2,1) = g

        x = 1

        Do 'get new game entry

            x += 1

            Line Input #ff, tl(2,x)

        Loop Until tl(2,x) = "" 'game entry complete

        filepointer(2) = Seek(ff)

    Loop Until EOF(ff)



    Close ff



    'game number

    gameCount = Val(Mid(tl(1,1),InStrRev(tl(1,1)," ") + 1)) 'last finished game



    'check if the last game was uncompleted

    If tl(2,6) = "" Then 'uncompleted

        'cleanup turnamentlog

        Open ExePath + "\turnamentlog.txt" For Binary As ff

        g = Input(filepointer(1)-3, ff)

        Close ff

        Open ExePath + "\turnamentlog.txt" For Output As ff

        Print #ff, g;

        Close ff

        replayFlag = 2



        'check for game stamp

        replayMoves = ""

        Open ExePath + "\moveslog.txt" For Binary As ff

        Input #ff, g

        gameStamp = Val(Mid(tl(2,2),7))

        pCon("gameStamp ",gameStamp)

        If Val(g) = gameStamp Then

            Input #ff, replayMoves

        EndIf

        replayMoves += " "

        Close ff

        If Len(replayMoves) = 1 Then 'no moves done yet in the last game

            replayFlag = 0

        EndIf

    Else 'start the next (new) game

        For x = 1 To UBound(tl,2) 'carry over the last game entry

            tl(1,x) = tl(2,x)

        Next

    EndIf

    Close ff



    'extract informations from logfile and set variables

    'game counter

    x = 0

    Do

        x += 1

    Loop Until Left(tl(1,x),5) = "game "

    gameCount = Val(Mid(tl(1,x),6))



    'engine files

    x = 0

    Do

        x += 1

    Loop Until Left(tl(1,x),6) = "white "

    g = tl(1,x)

    engine(1) = Mid(g,InStrRev(g," ") + 1)

    g = tl(1,x + 1)

    engine(2) = Mid(g,InStrRev(g," ") + 1)

    If Frac(gameCount/2) = 0 Then 'odd game number --> white = engine 1

        Swap engine(1),engine(2)

    EndIf



    'result counters

    x = 0

    Do

        x += 1

    Loop Until Left(tl(1,x),10) = "total won "

    winEngine(1) = Val(Mid(tl(1,x),InStrRev(tl(1,x)," ") + 1))

    winEngine(2) = Val(Mid(tl(1,x + 1),InStrRev(tl(1,x + 1)," ") + 1))

    drawnGames = Val(Mid(tl(1,x + 2),InStrRev(tl(1,x + 2)," ") + 1))



    'playmode

    x = 0

    Do

        x += 1

    Loop Until Left(tl(1,x),5) = "mode "

    'g = tl(2,x)

    g = tl(1,x)

    g = LTrim(Mid(g,InStr(g," "))) 'delete 1st item ("mode")

    playmode = Left(g,InStr(g," ") - 1) 'get playmode keyword (2nd item)

    g = LTrim(Mid(g,InStr(g," "))) 'delete 1st item (playmode keyword)

    pCon("playmode ",playmode)

    Select Case playmode

        Case "movetime"

            moveTimePreset = Val(Left(g,InStr(g," ") - 1))

            g = LTrim(Mid(g,InStr(g," "))) '1st space

            g = LTrim(Mid(g,InStr(g," "))) '2nd space

            g = Trim(g, Any " )")

            moveTimeHandicap = Val(Trim(g, Any " )"))

            moveTime(1) = moveTimePreset + moveTimeHandicap * (winEngine(2) - winEngine(1))

            moveTime(2) = moveTimePreset + moveTimeHandicap * (winEngine(1) - winEngine(2))

            Open ExePath + "\timelog.txt" For Input As #6

            Input #6, stampCompare

            If stampCompare = gameStamp Then 'logged times belong to the actual game --> restore times

                Input #6, timePlayed(1)

                Input #6, timePlayed(2)

                pCon ("timePlayed 1 ",timePlayed(1))

                pCon ("timePlayed 2 ",timePlayed(2))

            Else 'new game --> reset clock

                timePlayed(1) = 0

                timePlayed(2) = 0

            EndIf

            Close 6

        Case "depth"



        Case "gametime"

            gameTimePreset = Val(Left(g,InStr(g," ") - 1))

            g = LTrim(Mid(g,InStr(g," "))) 'delete 1st item (<gametime>)

            g = Trim(g, Any "( )") 'delete brackets

            gameTimeHandicap = Val(g)

            'set the game times with the actual handicap

            gameTime(1) = gameTimePreset + gameTimeHandicap * (winEngine(2) - winEngine(1))

            gameTime(2) = gameTimePreset + gameTimeHandicap * (winEngine(1) - winEngine(2))

            Open ExePath + "\timelog.txt" For Input As #6

            Input #6, stampCompare

            If stampCompare = gameStamp Then 'logged times belong to the actual game --> restore times

                Input #6, timeLeft(1)

                Input #6, timeLeft(2)

            Else 'new game with full time amount

                timeLeft(1) = gameTime(1) * 1000

                timeLeft(2) = gameTime(2) * 1000

            EndIf

            Close 6

            timeRemind = Timer



    End Select



End Sub



Sub replayGame()

    ReDim As Integer filepointer(1)

    Dim As Integer ff, gamemax, x, gameNumber

    Dim As String g



    Cls

    Locate 15,20

    Print "**********  R E P L A Y  **********"



    ff = FreeFile

    Open ExePath + "\turnamentlog.txt" For Input As ff

    Do

        Line Input #ff, g

        If Left(g,5) = "game " Then

            x = Val(Mid(g,6))

            If x > gamemax Then

                gamemax = x

                ReDim Preserve filepointer(x)

                filepointer(x) = Seek(ff)

            Else

                gamemax = x

                ReDim filepointer(x)

                filepointer(x) = Seek(ff)

            EndIf

        EndIf

    Loop Until EOF(ff)



    Locate 20,20,1

    Print x

    Input "Game number ",gameNumber

    Seek ff,filepointer(gameNumber)

    For x = 1 To 6

        Line Input #ff, replayMoves

    Next

    Line Input #ff, g

    g = Trim(g,"*")

    replayMoves += " " + g + " "

    replayFlag = 1

    gameCount = gameNumber



End Sub



Sub setup

    Dim As Integer mencol, menlin, x, jump

    Dim As String keypressed, filename

    ReDim As String enginelist(1)



    'write available engines to array

    x = 0

    ReDim enginelist(x)

    filename = Dir(ExePath + "\engines\*.*", -1)

    Do

        pCon(filename,"")

        If Right(filename,4) = ".exe" then

            x += 1

            ReDim Preserve enginelist(x)

            enginelist(x) = filename

        EndIf

        filename = DIR("", -1)

    Loop While Len(filename)



    For x = LBound(enginelist) To UBound(enginelist)

        pCon(Str(x),enginelist(x))

    Next

    Do 'setup menu loop

        If jump = 0 Then

            Cls

            Locate 15,20

            Print "**********  S E T U P  **********"

            mencol = 25

            menlin = 20

            jump = 1

        EndIf



        keypressed = Inkey

        menuitem = ""



        mouseMenu(" 1 = Engine 1 (" + engine(1) + ")","=",menlin,mencol,cfont,cback)

        mouseMenu(" 2 = Engine 2 (" + engine(2) + ")","=",menlin + 2,mencol,cfont,cback)

        mouseMenu(" P = Playmode (" + playmode + ")","=",menlin + 4 ,mencol,cfont,cback)



        mouseMenu(" Esc = Return to main menu ","=",menlin + 10,mencol,cfont,cback)



        Select Case menuitem 'convert menuitem to keystroke

            Case ""

                    'do nothing

            Case "Esc"

                keypressed = Chr(27)

            Case Else

                keypressed = LCase(menuitem) 'key

        End Select



        Select Case keypressed

            Case "1" 'engine 1

                Cls

                Locate 15,20

                Print         "**********  S E T U P  **********"

                Print

                Print Tab(29);"CHOOSE ENGINE 1"

                Do

                    keypressed = InKey

                    menuitem = ""

                    For x = 1 To UBound(enginelist)

                        mouseMenu(Str(x) + " - " + enginelist(x),"-",19 + 2*x,25,cfont,cback)

                    Next

                    mouseMenu("Esc = Return to setup menu","=",19 + 2*(x),25,cfont,cback)

                    Color cfont,cback



                    Select Case menuitem 'convert menuitem to keystroke

                        Case ""

                                'do nothing

                        Case "Esc"

                            keypressed = Chr(27)

                        Case Else

                            keypressed = menuitem 'key

                    End Select



                    Select Case keypressed

                        Case "1" To Str(UBound(enginelist))

                            engine(1) = enginelist(Val(keypressed))

                            WritePrivateProfileString("","engine1",StrPtr(engine(1)),StrPtr(iniFile))

                            jump = 0

                            Exit Do

                        Case Chr(27)

                            jump = 0

                            Exit Do

                        Case Chr(255,107) 'end program

                            End

                    End Select

                Loop



            Case "2" 'engine 2

                Cls

                Locate 15,20

                Print         "**********  S E T U P  **********"

                Print

                Print Tab(29);"CHOOSE ENGINE 2"

                Do

                    keypressed = InKey

                    menuitem = ""

                    For x = 1 To UBound(enginelist)

                        mouseMenu(Str(x) + " - " + enginelist(x),"-",19 + 2*x,25,cfont,cback)

                    Next

                    mouseMenu("Esc = Return to setup menu","=",19 + 2*(x),25,cfont,cback)

                    Color cfont,cback



                    Select Case menuitem 'convert menuitem to keystroke

                        Case ""

                                'do nothing

                        Case "Esc"

                            keypressed = Chr(27)

                        Case Else

                            keypressed = menuitem 'key

                    End Select



                    Select Case keypressed

                        Case "1" To Str(UBound(enginelist))

                            engine(2) = enginelist(Val(keypressed))

                            WritePrivateProfileString("","engine2",StrPtr(engine(2)),StrPtr(iniFile))

                            jump = 0

                            Exit Do

                        Case Chr(27)

                            jump = 0

                            Exit Do

                        Case Chr(255,107) 'end program

                            End

                    End Select

                Loop



            Case "p" 'playmode

                Cls

                Locate 15,20

                Print         "**********  S E T U P  **********"

                Print

                Print Tab(29);"PLAYMODE"

                Do

                    keypressed = InKey

                    menuitem = ""



                    If playmode = "movetime" Then

                        mouseMenu(">>> M = Movetime <<<","=",20,25,cfont,cback)

                    Else

                        mouseMenu("    M = Movetime    ","=",20,25,cfont,cback)

                    EndIf

                    mouseMenu(" 1 = Movetime (" + Str(moveTimePreset) + " ms) ","=",22,27,cfont,cback)

                    mouseMenu(" 2 = Movetime Handicap (" + Str(moveTimeHandicap) + " ms) ","=",24,27,cfont,cback)



                    If playmode = "depth" Then

                        mouseMenu(">>> D = Depth <<<","=",26,25,cfont,cback)

                    Else

                        mouseMenu("    D = Depth    ","=",26,25,cfont,cback)

                    EndIf

                    mouseMenu(" 3 = Depth (" + Str(depthPreset) + ") ","=",28,27,cfont,cback)

                    mouseMenu(" 4 = Depth Handicap (" + Str(depthHandicap) + ") ","=",30,27,cfont,cback)



                    If playmode = "gametime" Then

                        mouseMenu(">>> T = Gametime <<<","=",32,25,cfont,cback)

                    Else

                        mouseMenu("    T = Gametime    ","=",32,25,cfont,cback)

                    EndIf

                    mouseMenu(" 5 = Gametime (" + Str(gameTimePreset) + " s) ","=",34,27,cfont,cback)

                    mouseMenu(" 6 = Gametime Handicap (" + Str(gameTimeHandicap) + " s) ","=",36,27,cfont,cback)



                    mouseMenu(" Esc = Return to setup menu ","=",38,25,cfont,cback)

                    Color cfont,cback



                    Select Case menuitem 'convert menuitem to keystroke

                        Case ""

                                'do nothing

                        Case "Esc"

                            keypressed = Chr(27)

                        Case Else

                            keypressed = LCase(Trim(menuitem,Any "> ")) 'key

                    End Select



                    Select Case keypressed

                        Case "m" 'playmode

                            playmode = "movetime"

                            WritePrivateProfileString("","playmode","movetime",StrPtr(iniFile))

                        Case "1" 'moveTimePreset

                            View Print 40 To 40

                            Locate 40,20

                            Input "Movetime (ms): ",moveTimePreset

                            WritePrivateProfileString("","moveTimePreset",Str(moveTimePreset),StrPtr(iniFile))

                            Cls

                            View Print

                        Case "2" 'moveTimeHandicap

                            View Print 40 To 40

                            Locate 40,20

                            Input "movetime handicap(ms): ",moveTimeHandicap

                            WritePrivateProfileString("","moveTimeHandicap",Str(moveTimeHandicap),StrPtr(iniFile))

                            Cls

                            View Print

                        Case "d" 'depth

                            playmode = "depth"

                            WritePrivateProfileString("","playmode","depth",StrPtr(iniFile))

                        Case "3" 'depthpreset

                            View Print 40 To 40

                            Locate 40,20

                            Input "depth: ",depthPreset

                            WritePrivateProfileString("","depthPreset",Str(depthPreset),StrPtr(iniFile))

                            Cls

                            View Print

                        Case "4" 'increase depth

                            View Print 40 To 40

                            Locate 40,20

                            Input "depth handicap: ",depthHandicap

                            WritePrivateProfileString("","depthHandicap",Str(depthHandicap),StrPtr(iniFile))

                            Cls

                            View Print

                        Case "t" 'time amount

                            playmode = "gametime"

                            WritePrivateProfileString("","playmode","gametime",StrPtr(iniFile))

                        Case "5"

                            View Print 40 To 40

                            Locate 40,20

                            Input "gametime (seconds): ",gameTimePreset

                            WritePrivateProfileString("","gameTimePreset",Str(gameTimePreset),StrPtr(iniFile))

                            Cls

                            View Print

                        Case "6"

                            View Print 40 To 40

                            Locate 40,20

                            Input "gametime handicap(seconds): ",gameTimeHandicap

                            WritePrivateProfileString("","gameTimeHandicap",Str(gameTimeHandicap),StrPtr(iniFile))

                            Cls

                            View Print

                        Case Chr(27)

                            jump = 0

                            Exit Do

                        Case Chr(255,107) 'end program

                            End

                    End Select

                Loop

            Case Chr(27)

                Exit Do

            Case Chr(255,107) 'end program

                End

        End Select

    Loop



End Sub



Function timeFormat (seconds As Double, mode As Integer = 0) As String



  Dim As Integer milliseconds, hours, minutes, secs

  Dim As String tRet = ""



  milliseconds = CInt(seconds * 1000)



  hours = Int(milliseconds / 3600000)

  milliseconds = milliseconds Mod 3600000

  minutes = Int(milliseconds / 60000)

  milliseconds = milliseconds Mod 60000

  secs = Int(milliseconds / 1000)

  milliseconds = milliseconds Mod 1000



  If hours Then

    tRet = Str(hours) + ":"

  EndIf

  If minutes < 10 Then

    If Len(tRet) Then

        tRet += "0"

    EndIf

  EndIf

  tRet += Str(minutes) + ":"

  If secs < 10 Then

    tRet += "0"

  EndIf

  tRet += Str(secs)

  Select Case mode

    Case 0

        tRet += "." + Str(milliseconds)

    Case 1

        'do nothing

    Case 2 '1 digit

        tRet += "." + Left(Str(milliseconds),1)

    Case 3 '2 digits

        tRet += "." + Left(Str(milliseconds),2)

  End Select



  Return tRet



End Function





Sub Scan

    Dim As FB.EVENT se

    Dim As String g, keySubst, mousecol, mouserow

    Dim As Integer x, mx, my, mw, mb

    Static As Double repeatLock

    Static As Integer mouselock



    menuitem = ""

    Line (271,503)-(296,512),cfont,b

    mouseMenu(" - ","",64,35,cfont,cback) 'decrease animation speed

    Line (79,503)-(104,512),cfont,b

    mouseMenu(" + ","",64,11,cfont,cback) 'increase animation speed

    Line (351,439)-(544,448),cfont,b

    mouseMenu(" setup engine 1 options ","",56,45,cfont,cback)

    Line (351,471)-(544,480),cfont,b

    mouseMenu(" setup engine 2 options ","",60,45,cfont,cback)

    Color cfont,cback

    Select Case menuitem

        Case ""

                'do nothing

        Case "-" 'decrease animation speed

            If animationSpeed > 0 Then

                animationSpeed -= 1

                WritePrivateProfileString("","animationSpeed",Str(animationSpeed),StrPtr(iniFile))

            EndIf

            update

        Case "+" 'increase animation speed

            animationSpeed += 1

            WritePrivateProfileString("","animationSpeed",Str(animationSpeed),StrPtr(iniFile))

            update

        Case "setup engine 1 options"

            ScreenSet 2,2

            setupEngine(engine(1),1)

            setEngineOptionsFlag = 1

            ScreenSet 1,1

            update

        Case "setup engine 2 options"

            ScreenSet 2,2

            setupEngine(engine(2),2)

            setEngineOptionsFlag = 1

            ScreenSet 1,1

            update

    End Select



    If Timer > repeatLock Then

        If GetKeyState(109) < 0 Then 'minus-key --> decrease animation speed

            If animationSpeed > 0 Then 'don't let animation speed get negative

                animationSpeed -= 1

                WritePrivateProfileString("","animationSpeed",Str(animationSpeed),StrPtr(iniFile))

            EndIf

            update

            repeatLock = Timer + .2 'repetition delay

        ElseIf GetKeyState(107) < 0 Then 'plus-key --> increase animation speed

            animationSpeed += 1

            WritePrivateProfileString("","animationSpeed",Str(animationSpeed),StrPtr(iniFile))

            update

            repeatLock = Timer + .2 'repetition delay

        EndIf

    EndIf



    If ScreenEvent(@se) Then

    If se.type = FB.EVENT_WINDOW_CLOSE Then 'end program

        Close

        CloseEngines

        'Screen 0

        ScreenSet

        'Sleep 500

        Print "ende"

        'Sleep 500

        End

    EndIf

    EndIf



    If humanflag Then

        If GetMouse(mx,my,mw,mb) = 0 Then

            mousecol = Mid("abcdefgh",Fix((mx - bx)/42)+1,1)

            mouserow = Mid("87654321",Fix((my - by)/42)+1,1)

            If (mb And 1) And (mouselock = 0) Then

                WriteEngineInfo(opponent,"field " + mousecol + mouserow)

                Locate 50,10

                mouselock = 1

            EndIf

            If mb = 0 Then

                mouselock = 0

            EndIf

        EndIf

    EndIf



End Sub



Sub GetEngineOptions(engine As String)

    Dim As SECURITY_ATTRIBUTES sa

    Dim As STARTUPINFO si

    Dim As PROCESS_INFORMATION pi

    Dim As HANDLE hReadChildPipe, hWritePipe, hReadPipe, hWriteChildPipe, hProcessHandle

    Dim As Integer iNumberOfBytesWritten, iTotalBytesAvail, iBytesToRead, x, y, begPtr, endPtr

    Dim As String order, g, sBuf



    ReDim As String responseString(1)



    Const As Integer MaxBytesToRead = 4096



    ReDim engineOptions(5,1)



    'install the pipes to the engine

    sa.nLength = SizeOf(SECURITY_ATTRIBUTES)

    sa.lpSecurityDescriptor = NULL

    sa.bInheritHandle = TRUE



    'start and connect engine

    CreatePipe(@hReadChildPipe,@hWritePipe,@sa,0)

    CreatePipe(@hReadPipe,@hWriteChildPipe,@sa,0)



    GetStartupInfo(@si)



    si.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW

    si.wShowWindow = SW_HIDE

    si.hStdOutput  = hWriteChildPipe

    si.hStdError   = hWriteChildPipe

    si.hStdInput   = hReadChildPipe



    CreateProcess(0,ExePath + "\engines\" + engine,0,0,TRUE,0,0,0,@si,@pi)



    hProcessHandle = pi.hProcess



    CloseHandle(hWriteChildPipe)

    CloseHandle(hReadChildPipe)



    order = "uci" + Chr(10)

    WriteFile(hWritePipe,StrPtr(order),Len(order),@iNumberOfBytesWritten,NULL)



    g = ""

    Do

      Do

            sBuf = "" 'clear buffer

            PeekNamedPipe(hReadPipe,NULL,NULL,NULL,@iTotalBytesAvail,NULL)

            If iTotalBytesAvail Then 'pipe is not empty

                If iTotalBytesAvail < MaxBytesToRead Then

                    iBytesToRead = iTotalBytesAvail 'set all available bytes to be read

                Else

                    iBytesToRead = MaxBytesToRead 'set the first 4096 bytes to be read

                EndIf

                sBuf = String(iBytesToRead,Chr(0)) 'set the length of the buffer string to the necessary value

                'read the specified amount of bytes from the pipe

                ReadFile(hReadPipe,StrPtr(sBuf),iBytesToRead,@iNumberOfBytesWritten,NULL)

                g += sBuf 'add the buffer to the return string

                Sleep 1

            Else 'pipe is empty

                Exit Do

            EndIf

        Loop

    Loop Until InStr(g,"uciok")



    x = 0

    y = 0

    begptr = 1

    Do 'parse the engine response to separate strings

        x += 1

        ReDim Preserve responseString(x) 'enlarge array

        endptr = InStr(begptr,g,Chr(13,10)) 'find next line feed

        responseString(x) = Mid(g,begptr,endptr - begptr) 'write separate string to array

        If InStr(responseString(x),"option name ")Then

            y += 1 'count option strings

        EndIf

        begptr = endptr + 2 'set pointer to the beginnig of the next string

    Loop While begptr <= Len(g)



    ReDim engineOptions(5,y) 'dim options array

    x = 0

    For y = 1 To UBound(responseString) 'parse option strings

        g = responseString(y)

        If InStr(g,"option name ") Then 'option string

            x += 1

            begptr = InStr(g,"option name ") + 13

            endptr = InStr(begptr,g,"type ")

            engineOptions(oname,x) = Mid(g,begptr - 1,endptr - begptr)



            If InStr(g,"type ") Then

                begptr = InStr(g,"type ") + 5

                endptr = InStr(begptr,g," ")

                engineOptions(otype,x) = Mid(g,begptr,endptr - begptr)

            EndIf



            If InStr(g,"default ") Then

                begptr = InStr(g,"default ") + 8

                endptr = InStr(begptr,g," ")

                engineOptions(odefault,x) = Mid(g,begptr,endptr - begptr)

            EndIf



            If InStr(g,"min ") Then

                begptr = InStr(g,"min ") + 4

                endptr = InStr(begptr,g," ")

                engineOptions(omin,x) = Mid(g,begptr,endptr - begptr)

            EndIf



            If InStr(g,"max ") Then

                begptr = InStr(g,"max ") + 4

                endptr = InStr(begptr,g," ")

                engineOptions(omax,x) = Mid(g,begptr,endptr - begptr)

            EndIf



            If InStr(g,"var ") Then

                begptr = 1

                Do

                    begptr = InStr(begptr,g,"var ") + 4

                    endptr = InStr(begptr,g," ")

                    engineOptions(ovar,x) += Mid(g,begptr,endptr - begptr) + Chr(10)'" "

                    begptr = endptr

                Loop While InStr(begptr,g,"var ")

            EndIf

        EndIf



    Next



    TerminateProcess(hProcessHandle, @ExitCode)

    CloseHandle(hWritePipe)

    CloseHandle(hReadPipe)



End Sub



Sub setupEngine(engine As String, engNumber As Integer)

    Dim As Integer menlin, mencol, x, y, xmax, setDefaultFlag, page, pages, pagelen, o, _

                   mx, my, mw, mb, sliderTop, sliderBot, scrollLock, begptr, endptr, wheel, _

                   wdiff

    Dim As String menutext, g, engName, opp



    engName = engine + " as " + Str(engNumber)



    GetEngineOptions(engine)



    pagelen = 20

    pages = Int(UBound(engineOptions,2)/pagelen) + 1

    page = 1



    Do

        Do 'setup loop

            menlin = 6

            mencol = 35

            menuitem = ""

            Cls

            Locate 3,10

            Print ">>> SETUP ENGINE ";

            Color cfont,cbacklt

            Print " ";engine;" ";

            Color cfont,cback

            Print " OPTIONS <<<

            If page * pagelen < UBound(engineOptions,2) Then

                xmax = pagelen

            Else

                xmax = UBound(engineOptions,2) - ((page - 1) * pagelen)

            EndIf



            Do 'menu loop

                menuitem = ""

                If pages > 1 Then 'more than 1 page --> create scrollbar

                    Line (520,57)-(530,370),cfont,b 'scrollbar

                    slidertop = 57 + 313/pages*(page-1)

                    sliderbot = 57 + 313/pages*page

                    Line (520,slidertop)-(530,sliderbot),cfont,bf 'slider

                    Locate menlin + 2, 69

                    Print "page";page;"/";Str(pages)

                    GetMouse(mx,my,mw,mb)

                    If mb = 0 Then 'no button pressed --> reset scrollLock

                        scrollLock = 0

                    EndIf



                    'scroll pages

                    If (mx > 520) And (mx < 530) And (scrollLock = 0) Then

                        If (my < slidertop) And (my > 57) And (mb And 1) Then 'scroll to previous page

                            page -= 1

                            scrollLock = 1

                            Exit Do,Do

                        ElseIf (my > sliderbot) And (my < 374) And (mb And 1) Then 'scroll to next page

                            page += 1

                            scrollLock = 1

                            Exit Do,Do

                        EndIf

                    EndIf

                EndIf



                For x = 1 To xmax 'selected page

                    o = (page - 1) * pagelen + x

                    GetPrivateProfileString(engName,engineOptions(oname,o),engineOptions(odefault,o),@iniBuffer,100,StrPtr(iniFile))

                    menutext = engineOptions(oname,o) + " = " + iniBuffer

                    

                    Select Case engineOptions(otype,o) 'extend menu text

                        Case "check"

                            

                        Case "spin"

                                    menutext += "  (" + engineOptions(omin,o) + ".." + engineOptions(omax,o) + ") [" + engineOptions(odefault,o) + "]"

                        Case "combo"

                            If iniBuffer = engineOptions(odefault,o) Then

                                menutext += "  (=default)"

                            ElseIf inibuffer = Left(engineOptions(ovar,o),InStr(engineOptions(ovar,o),Chr(10)) - 1) Then

                                menutext += "  (=1st)"

                            EndIf

                        Case "button"

                            menutext += "BUTTON"

                        Case "string"



                    End Select

                    mouseMenu(menutext,"=",menlin + 2 * x ,mencol,cfont,cback) 'put menu item on screen

                    If menuitemhit Then

                        Select Case engineOptions(otype,o)

                            Case "spin" 'change value with mouse wheel

                                If mw <> wheel Then

                                    Exit Do 

                                EndIf

                        End Select

                    EndIf

                    If menuitem = engineOptions(oname,o)Then 'item was clicked

                        Exit Do

                    EndIf

                Next

                If setDefaultFlag = 1 Then

                    If Frac(Timer) > .5 Then 'flash item text

                        mouseMenu(" CHOOSE VALUE  to default","",menlin + 44,mencol - 15,cfont,cback)

                    Else

                        mouseMenu(" CHOOSE VALUE  to default","",menlin + 44,mencol - 15,cfont,cbacklt)

                    EndIf

                Else

                    mouseMenu("Set ONE value to default ","",menlin + 44,mencol - 15,cfont,cback)

                EndIf

                If setDefaultFlag = 2 Then

                    Locate menlin + 46,mencol - 15

                    If Frac(Timer) > .5 Then 'flash text

                        Color cfont,cback

                    Else

                        Color cfont,cbacklt

                    EndIf

                    Print " ARE YOU SURE ? "

                    mouseMenu(" NO ","",menlin + 46,mencol + 5,cfont,cback)

                    mouseMenu(" YES ","",menlin + 46,mencol + 10,cfont,cback)

                Else

                    mouseMenu("Set ALL values to default","",menlin + 46,mencol - 15,cfont,cback)

                EndIf

                mouseMenu("Exit","",menlin + 48,mencol - 15,cfont,cback)

                Color cfont,cback



                Select Case menuitem 'clicked menu item

                    Case "Set ONE value to default"

                        setDefaultFlag = 1

                    Case "CHOOSE VALUE  to default"

                        setDefaultFlag = 0

                    Case "Set ALL values to default" 'delete engine section from .ini file

                        setDefaultFlag = 2

                        Locate menlin + 46,mencol - 15

                        Print "                         "

                    Case "NO" 'cancel --> don't reset values

                        setDefaultFlag = 0

                        Locate menlin + 46,mencol - 15

                        Print "                              "

                    Case "YES" 'delete engine section from .ini file --> set all values to default

                        WritePrivateProfileString(engName,0,0,StrPtr(iniFile))

                        Locate menlin + 46,mencol - 15

                        Print "                              "

                        SetDefaultFlag = 0

                    Case "Exit" 'exit engine options setup

                        Return

                End Select

                

                wheel = mw

            Loop

            Color cfont,cback

            

            'edit option

            If setDefaultFlag Then 'set chosen value to default 

                iniBuffer = engineOptions(odefault,o)

                setDefaultFlag = 0

            Else 'set option to new value 

                Select Case engineOptions(otype,o) 'option type

                    Case "check" 'toggle value

                        Select Case iniBuffer

                            Case "true"

                                iniBuffer = "false"

                            Case "false"

                                iniBuffer = "true"

                        End Select

                        

                    Case "spin"

                        If wheel = mw Then 'no mouse wheel action --> keyboard input

                            Locate menlin + 2 * x ,mencol + 2

                            Print String(Len(iniBuffer) + 3," ")

                            Locate menlin + 2 * x ,mencol + 3

                            Input "",g

                        Else 'mouse wheel

                            y = Val(iniBuffer)

                            y += wheel - mw

                            g = Str(y)

                            wheel = mw

                        EndIf

                        If g <> "" Then

                            If (Val(g) >= Val(engineOptions(omin,o))) And (Val(g) <= Val(engineOptions(omax,o))) Then

                                iniBuffer = g

                            EndIf

                        EndIf



                    Case "combo" 'flip through "var" items

                        begptr = 1 'set pointer to 1st var item

                        endptr = InStr(engineOptions(ovar,o),Chr(10)) 'set pointer to separator

                        Do Until Mid(engineOptions(ovar,o),begptr,endptr - begptr) = iniBuffer 'search current var item

                            begptr = endptr + 1

                            endptr = InStr(begptr,engineOptions(ovar,o),Chr(10))

                            If endptr >= Len(engineOptions(ovar,o)) Then 'set pointer to 1st var item

                                endptr = 0

                                Exit Do

                            EndIf

                        Loop

                        begptr = endptr + 1 'set pointer to next var item

                        endptr = InStr(begptr,engineOptions(ovar,o),Chr(10)) 'set pointer to next separator

                        iniBuffer = Mid(engineOptions(ovar,o),begptr,endptr - begptr) 'get next var item

                        

                    Case "button"

                        'choose correct engine

                        If engNumber = currentWhite Then

                            opp = w

                        ElseIf engNumber = currentBlack Then

                            opp = b

                        EndIf

                        pCon("opp ",opp)

                        WriteEngineInfo(opp,"setoption name " + engineOptions(oname,o)) 'send BUTTON option to engine

                    Case "string"

                        Locate menlin + 2 * x ,mencol + 5 + Len(inibuffer)

                        Input "",g

                        If g <> "" Then

                            iniBuffer = g

                        EndIf

                End Select

            EndIf



            If iniBuffer = engineOptions(odefault,o) Then 'remove .ini file entry --> set option to default

                WritePrivateProfileString(engName,engineOptions(oname,o),0,StrPtr(iniFile))

            Else 'write value to .ini file

                WritePrivateProfileString(engName,engineOptions(oname,o),StrPtr(iniBuffer),StrPtr(iniFile))

            EndIf



        Loop

    Loop

End Sub



Sub setEngineOptions(opp As String)

    Dim As Integer x, ff

    Dim As String engName, g, optName, optVal



    Select Case opp

        Case w

            engName = engine(currentWhite) + " as " + Str(currentWhite)

        Case b

            engName = engine(currentBlack) + " as " + Str(currentBlack)

    End Select

    ff = FreeFile

    Open ExePath + "\setup.ini" For Input As ff

    Do 'search section in .ini - file

        Line Input #ff,g

    Loop Until (g = "[" + engName + "]") Or (Eof(ff))

    If Eof(ff) Then 'section not found

        Close ff

        Return

    EndIf

    Do 'set all mentioned options

        Line Input #ff,g

        If Left(g,1) = "[" Then 'next section --> end option setting

            Close ff

            Return

        ElseIf g = "" Then 'blank line

            'next line

        Else

            x = InStr(g,"=")

            If x <> 0 Then 'parse option entry

                optname = Left(g,x - 1) 'option name

                optVal = Mid(g,x + 1) 'option value

                WriteEngineInfo(opp,"isready") 

                Do 'wait until engine is listening

                Loop Until InStr(GetEngineResponse(opp),"readyok")

                WriteEngineInfo(opp,"setoption name " + optName + " value " + optVal) 'send option to engine

            EndIf

        EndIf

    Loop Until Eof(ff)

    Close ff



End Sub



Sub parseFen(fen As String)

    Dim As Integer ptr1, ptr2



    ptr1 = InStr(fen," ")

    fenBoard = Left(fen,ptr1 - 1)

    ptr2 = InStr(ptr1 + 1,fen," ")

    fenOpponent = Mid(fen,ptr1 + 1,ptr2 - ptr1 - 1)

    ptr1 = InStr(ptr2 + 1,fen," ")

    fenCastling = Mid(fen,ptr2 + 1,ptr1 - ptr2 - 1)

    ptr2 = InStr(ptr1 + 1,fen," ")

    fenEnPassant = Mid(fen,ptr1 + 1,ptr2 - ptr1 - 1)

    ptr1 = InStr(ptr2 + 1,fen," ")

    fenHalfmoves = Mid(fen,ptr2 + 1,ptr1 - ptr2 - 1)

    fenMoves = Mid(fen,ptr1 + 1)



End Sub





'***************************************************

knightCheck:

    Data -1,-2, 1,-2, 2,-1, 2,1, 1,2, -1,2, -2,1, -2,-1



' 1 = pawn, 2 = rook, 3 = knight, 4 = bishop, 5 = queen, 6 = king, 7 = border

' black pieces given negative value, sgn() returns -1 for black and +1 for white



'    0  1  2  3  4  5  6  7  8  9  10 11  <--- internal coordinates

'          A  B  C  D  E  F  G  H         <--- display coordinates

boardLayout:

Data 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7 '0

Data 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7 '1

Data 7, 7,-2,-3,-4,-5,-6,-4,-3,-2, 7, 7 '2     8

Data 7, 7,-1,-1,-1,-1,-1,-1,-1,-1, 7, 7 '3     7

Data 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7 '4     6

Data 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7 '5     5

Data 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7 '6     4

Data 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7 '7     3

Data 7, 7, 1, 1, 1, 1, 1, 1, 1, 1, 7, 7 '8     2

Data 7, 7, 2, 3, 4, 5, 6, 4, 3, 2, 7, 7 '9     1

Data 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7 '10

Data 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7 '11





Pieces:

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data "....................####.................."

Data "...................#****#................."

Data "..................#******#................"

Data ".................#********#..............."

Data ".................#********#..............."

Data ".................#********#..............."

Data ".................#********#..............."

Data "..................#******#................"

Data "...................#****#................."

Data "...................######................."

Data "..................#******#................"

Data "................##********##.............."

Data "...............#************#............."

Data "..............#**************#............"

Data "..............################............"

Data ".................#********#..............."

Data ".................#********#..............."

Data ".................#********#..............."

Data "................#**********#.............."

Data "................#**********#.............."

Data "...............#************#............."

Data "..............#**************#............"

Data ".............#****************#..........."

Data "............#******************#.........."

Data "............#******************#.........."

Data "............####################.........."

Data "...........#********************#........."

Data "...........#********************#........."

Data "...........######################........."

Data ".........................................."

Data ".........................................."

Data ".........................................."



Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data "...........#####..######..#####..........."

Data "...........#***#..#****#..#***#..........."

Data "...........#***#..#****#..#***#..........."

Data "...........#***#..#****#..#***#..........."

Data "...........#***####****####***#..........."

Data "...........#******************#..........."

Data "...........#******************#..........."

Data "...........#******************#..........."

Data "...........#******************#..........."

Data "...........####################..........."

Data "............#****************#............"

Data ".............################............."

Data ".............#****#****#****#............."

Data ".............#****#****#****#............."

Data ".............################............."

Data ".............#**#****#****#*#............."

Data ".............#**#****#****#*#............."

Data ".............################............."

Data ".............#****#****#****#............."

Data ".............#****#****#****#............."

Data ".............################............."

Data ".............#**#****#****#*#............."

Data ".............#**#****#****#*#............."

Data "............##################............"

Data "...........#******************#..........."

Data "..........#********************#.........."

Data "..........#********************#.........."

Data ".........#**********************#........."

Data ".........########################........."

Data ".........................................."

Data ".........................................."

Data ".........................................."



Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data "....................#....................."

Data "...................##....................."

Data "..................#**#...................."

Data "..................#**###.................."

Data ".................#******###..............."

Data "................#**********#.............."

Data "................#***********#............."

Data "...............#**#*********#............."

Data "..............#**##**********#............"

Data ".............#**##.#*********#............"

Data ".............#**###***********#..........."

Data "............#*****************#..........."

Data "............#*****************#..........."

Data "...........#******************#..........."

Data "...........#*******************#.........."

Data "..........#******#####*********#.........."

Data "..........#******#..#**********#.........."

Data ".........#*******#..#**********#.........."

Data ".........#******#..#***********#.........."

Data "..........#****#..#***********#..........."

Data "..........#####..#************#..........."

Data "................#*************#..........."

Data "...............#*************#............"

Data "...............#*************#............"

Data "..............#***************#..........."

Data "..............#***************#..........."

Data ".............#*****************#.........."

Data ".............#******************#........."

Data "............#*******************#........."

Data "............######################........"

Data ".........................................."

Data ".........................................."

Data ".........................................."



Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".....................##..................."

Data "....................#**#.................."

Data "...................#****#................."

Data "..................#******#................"

Data ".................#********#..............."

Data "................#**********#.............."

Data "...............#************#............."

Data "...............#************#............."

Data "..............##************##............"

Data "..............#**************#............"

Data "..............#**************#............"

Data "..............#******##******#............"

Data ".............#*******##*******#..........."

Data ".............#*******##*******#..........."

Data ".............#*******##*******#..........."

Data ".............#****########****#..........."

Data ".............#****########****#..........."

Data ".............#*******##*******#..........."

Data ".............#*******##*******#..........."

Data ".............#*******##*******#..........."

Data ".............#*******##*******#..........."

Data ".............#*******##*******#..........."

Data "..............#******##******#............"

Data "..............#******##******#............"

Data "...............#************#............."

Data "...............#************#............."

Data "...............##############............."

Data "...............##**********##............."

Data "................############.............."

Data "..............##************##............"

Data "............##*****######*****##.........."

Data "...........#*****##......##*****#........."

Data "...........######..........######........."

Data ".........................................."

Data ".........................................."

Data ".........................................."



Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".........................................."

Data ".....................#...................."

Data "....................#*#..................."

Data "...................#***#.................."

Data "..................#*****#................."

Data "..................#*****#................."

Data "..................#*****#................."

Data "............#.....#*****#.....#..........."

Data "...........#*#.....#***#.....#*#.........."

Data "..........#***#....#***#....#***#........."

Data "..........#***#....#***#....#***#........."

Data "...........#*#.....#***#.....#*#.........."

Data "...........#*#.....#***#.....#*#.........."

Data "..........#***#...#*****#...#***#........."

Data "..........#***#..#*******#..#***#........."

Data "..........#***#..#*******#..#***#........."

Data ".....##...#***#...#*****#...#***#...##...."

Data ".....#*#..#***#...#*****#...#***#..#*#...."

Data ".....#**#.#***#...#*****#...#***#.#**#...."

Data ".....#**#.#***#...#*****#...#***#.#**#...."

Data "......#*#.#***#...#*****#...#***#.#*#....."

Data "......#**##***#...#*****#...#***##**#....."

Data "......#**#*****#.#*******#.#*****#**#....."

Data ".......#*******##*********##*******#......"

Data ".......#***************************#......"

Data "........#*************************#......."

Data "........###########################......."

Data "........#*************************#......."

Data "........#*************************#......."

Data "........#*************************#......."

Data "........#*************************#......."

Data "........#*************************#......."

Data "........###########################......."

Data ".......#***************************#......"

Data ".......#***************************#......"

Data ".......#############################......"

Data ".........................................."

Data ".........................................."

Data ".........................................."



Data ".........................................."

Data ".........................................."

Data ".........................................."

Data "....................###..................."

Data "....................#*#..................."

Data "..................###*###................."

Data "..................#*****#................."

Data "..................###*###................."

Data "....................#*#..................."

Data "....................#*#..................."

Data "...................#####.................."

Data "..................#*****#................."

Data "..................#*****#................."

Data "..................#*****#................."

Data "...................#***#.................."

Data "......#########.....#*#.....#########....."

Data ".....#.........######*######.........#...."

Data ".....#..............#*#..............#...."

Data ".....#....####......#*#......####....#...."

Data ".....#...#****###...#*#...###****#...#...."

Data ".....#.##********##.#*#.##********##.#...."

Data ".....#.#***********##*##***********#.#...."

Data ".....#.#************#*#************#.#...."

Data ".....#.#*****####***#*#***####*****#.#...."

Data ".....#.#****#****##*#*#*##****#****#.#...."

Data "......#*****#******##*##******#*****#....."

Data ".......#****#*******#*#*******#****#......"

Data ".......#****#*******#*#*******#****#......"

Data "........#****#******#*#******#****#......."

Data "........#****#******#*#******#****#......."

Data ".........#****#*****#*#*****#****#........"

Data ".........#*****#****#*#****#*****#........"

Data "..........#*****#***#*#***#*****#........."

Data "..........#######################........."

Data "..........#*********************#........."

Data "..........#######################........."

Data ".........##*********************##........"

Data "........##***********************##......."

Data "........###########################......."

Data ".........................................."

Data ".........................................."

Data ".........................................."