' COLOCHESSUM '***************************************************************************************** ' This program was written on the base of "gui.exe" coded by VANYA. ' The pieces were designed by BasicCoder2. ' Special thanks to ALWIM and Roland Chastain for their helpful hints. '***************************************************************************************** #Include Once "windows.bi" #Include "fbgfx.bi" #Include "vbcompat.bi" #Include "engines\common.bi" 'contains subs/functions which are used identically in the ' colocessum main program as well as in the human interface '#Include "d:\basic\freebasic\tests\bipipe\bipipe.bi" Type chessMove x1 As Integer x2 As Integer y1 As Integer y2 As Integer End Type Dim As chessMove cMove Type scrText opponent As String move As String depth As String End Type Dim Shared As scrText screenText Type boardpos x As Integer y As Integer End Type Dim Shared As boardpos boardPosition 'position top/left of board Type engineData Name As String Pipe As bipdata Ptr End Type Dim Shared As engineData white, black Type opponentData fileName As String engineName As String depth As Integer win As Integer moveTime As Integer timeLeft As Integer gameTime As Integer timePlayed As Integer matesign As String End Type Dim Shared As opponentData engine(2) Type counter move As Integer h50 As Integer drawn As Integer game As Integer illegal As Integer legal As Integer End Type Dim Shared As counter count Type flags mate As Byte replay As Byte setEngineOptions As Byte human As Byte break As Byte replay2 As Byte internalBoard As Byte testForLegal As Byte animation As Byte flipBoard As Byte ready As Byte castling As String End Type Dim Shared As flags flag Type boardImagePointers pxs As Integer pys As Integer pxd As Integer pyd As Integer End Type Type logf uci As String = ExePath + "\ucilog.txt" fen As String = ExePath + "\fenlog.txt" game As String = ExePath + "\gamelog.txt" turnament As String = ExePath + "\turnamentlog.txt" _time As String = ExePath + "\timelog.txt" moves As String = ExePath + "\moveslog.txt" enpassant As String = ExePath + "\enpassantlog.txt" End Type Dim Shared As logf logFile Enum 'access numbers for log files lguci = 100 lgfen lggam lgtur lgtim lgmov lgenp End Enum Const As Integer castlingWhite = 1, castlingBlack = 2, cfont = RGB(0,0,0), _ cback = RGB(100,255,100), cbacklt = RGB(220,255,220), _ fieldSize = 42 Dim Shared As ZString*20 infoKeyword(1 To ...) = {"depth","seldepth","time","nodes", _ "multipv","score","currmove", _ "currmovenumber","hashfull","nps", _ "tbhits","cpuload","refutation", _ "currline","pv","string"} Dim Shared As String infoString(0 To UBound(infoKeyword)) Dim As Integer mx, my, btn, dx, dy Dim Shared As Integer depth, moveTimePreset, currentWhite, currentBlack, _ animationSpeed, pchoice, moveTimeHandicap, mox, moy, mob, mow, _ depthPreset, depthHandicap, gameTimePreset, gameTimeHandicap, isLegal, _ moveDelay, gameDelay Dim Shared As FB.Image Ptr srcFrame, dstFrame, boardTemplate, boardImage Dim Shared As FB.Image Ptr iPiece(12) '12 images ReDim Shared As String fen(1), movetable(1), engineOptions(5,1) Dim Shared As String hod, moves, currDepth, fenstr, menuitem, _ WindowText, move, opponent, playmode, lastmove, replayMoves, _ iniFile, legalHint Dim Shared As ZString * 100 iniBuffer Dim Shared As Double timeRemind Dim As Integer x, y, menlin, mencol, ff, shade Dim As String datum, g, g2, matecomp, movecomp, winner, keypressed 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 updateScreen'(img As FB.Image Ptr = 0) 'Declare Sub updateScreen(scrTop As UInteger = 0, scrLeft As UInteger = 0, scrBottom As UInteger = 0, scrRight As UInteger = 0) 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 Function 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) As Integer 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 printCon OverLoad (t As String = "",text As String) Declare Sub printCon (text As String) Declare Sub printCon (t As String = "",x As Integer) Declare Sub printCon (x As Integer) Declare Function timeFormat (seconds As Double, mode As Integer = 0) As String Declare Sub Scan Declare Sub GetEngineOptions(engine As String) Declare Function GetLegalMoves(fen As String) As String Declare Sub makeBoardImage'(bImage As FB.Image Ptr) Declare Function SetBoardImagePointers(cm As chessMove) As boardImagePointers Declare Function GetMouseField() As String Declare Sub Shutdown Declare Sub updateScreenHaze Declare Sub printInfo Enum 'engine options oname = 1 otype odefault omin omax ovar = omin End Enum 'ScreenRes 640,600,32 ScreenRes 640,720,32 'ScreenRes 640,800,32 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).fileName = iniBuffer GetPrivateProfileString("","engine2","none",@iniBuffer,100,StrPtr(iniFile)) engine(2).fileName = 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) GetPrivateProfileString("","showInternalBoard","0",@iniBuffer,100,StrPtr(iniFile)) flag.internalBoard = Val(iniBuffer) GetPrivateProfileString("","testForLegal","0",@iniBuffer,100,StrPtr(iniFile)) flag.testForLegal = Val(iniBuffer) GetPrivateProfileString("","animation","1",@iniBuffer,100,StrPtr(iniFile)) flag.animation = Val(iniBuffer) GetPrivateProfileString("","movedelay","200",@iniBuffer,100,StrPtr(iniFile)) moveDelay = Val(iniBuffer) GetPrivateProfileString("","gamedelay","5000",@iniBuffer,100,StrPtr(iniFile)) gameDelay = Val(iniBuffer) ''*************************************************************** ''for testing. in the final version these variables will be '' set up with an .ini - file ' 'engine(1) = "stockfish_4_32bit.exe" ''engine(2) = "stockfish_4_32bit.exe" ''engine(1) = "Fruit-2-3-1.exe" 'engine(2) = "Fruit-2-3-1.exe" ' 'playmode = "movetime" 'moveTimePreset = 1000 'moveTimeHandicap = 1000 ' ''playmode = "depth" 'depth = 10 ' ''animationSpeed = 15 ''GetPrivateProfileString(0,"animationSpeed","15",@iniBuffer,100 ' ''*************************************************************** boardImage = ImageCreate( fieldSize * 8, fieldSize * 8, 0 ) 'allocate memory for board image boardTemplate = ImageCreate( fieldSize * 8, fieldSize * 8, 0 ) 'allocate memory for board template shade = 1 For y As Integer = 0 To 7 'draw squares to board tamplate shade = -shade For x As Integer = 0 To 7 Line boardTemplate,(x * fieldSize, y * fieldSize) - _ ((x + 1) * fieldSize - 1, (y + 1) * fieldSize - 1), _ IIf(shade > 0,RGB(179,110,44),RGB(252,206,156)),bf shade = -shade Next x Next y 'allocate memory for source-/destination frames srcFrame = ImageCreate(fieldSize,fieldSize,RGB(255,0,255)) dstFrame = ImageCreate(fieldSize,fieldSize,RGB(255,0,255)) For i As Integer = 0 To 3 Line srcFrame,(i, i) - (fieldSize - 1 - i, fieldSize - 1 - i),RGB(0,0,244),b 'source frames Line dstFrame,(i, i) - (fieldSize - 1 - i, fieldSize - 1 - i),RGB(0,255,0),b 'destination frames Next 'allocate memory for 12 images For i As Integer = 0 To 11 iPiece(i) = ImageCreate(fieldSize,fieldSize,RGB(255,0,255)) Next i 'copy piece images from data statements to piece image array 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 datum[x] Case Asc(".") PSet iPiece(i),(x,y),RGB(255,0,255) 'transparent color PSet iPiece(i+6),(x,y),RGB(255,0,255) Case Asc("#") 'black PSet iPiece(i),(x,y),RGB(0,0,0) PSet iPiece(i+6),(x,y),RGB(0,0,0) Case Asc("*") 'pieces colour PSet iPiece(i),(x,y),RGB(120,120,180) 'black pieces PSet iPiece(i+6),(x,y),RGB(250,200,200) 'white pieces End Select Next x Next y Next i 'THIS DETERMINES WHERE TO PLACE BOARD IN WINDOW boardPosition.x = 150 boardPosition.y = 30 Color cfont,cback Cls '? getlegalmoves("r2q1b1r/pbpk1p1p/1pn1p3/6p1/3B3P/1P4P1/P1PPP3/RN1QK1NR b KQ h3 0 10" );"*" 'Sleep 'End mainMenu: Do Color cfont,cback Cls Locate 15,20 Print "********** M A I N M E N U **********" flag.break = 0 mencol = 25 menlin = 20 Do 'main menu loop keypressed = Inkey flag.ready = 0 If mouseMenu(" B - Begin new turnament ","-",menlin,mencol,cfont,cback) = 9 Or _ keypressed = "b" Then 'reset variables engine(1).win = 0 engine(2).win = 0 count.drawn = 0 engine(1).moveTime = moveTimePreset engine(2).moveTime = moveTimePreset engine(1).depth = depthPreset engine(2).depth = depthPreset engine(1).gameTime = gameTimePreset engine(2).gameTime = gameTimePreset Exit Do ElseIf mouseMenu(" C - Continue last turnament ","-",-2,mencol,cfont,cback) = 9 Or _ keypressed = "c" Then 'continue last turnament continueTurnament 'sleep Exit Do ElseIf mouseMenu(" R - Replay game ","-",-2,mencol,cfont,cback) = 9 Or _ keypressed = "r" Then 'replay game replayGame Exit Do ElseIf mouseMenu(" S - Setup ","-",-2,mencol,cfont,cback,0) = 9 Or _ keypressed = "s" Then 'setup menu setup Continue Do,Do GoTo mainMenu ElseIf mouseMenu(" Esc - Quit program ","-",-4,mencol,cfont,cback) = 9 Or _ keypressed = Chr(27) Or _ keypressed = Chr(255,107) Then 'end program Shutdown EndIf Loop Cls Do 'turnament loop '(re)set variables ReDim fen(1) ReDim movetable(0) count.h50 = 0 flag.castling = "KQkq" flag.human = 0 count.illegal = 0 If (flag.replay = 0) Or (gameStamp = 0) Then gameStamp = Now 'game identifier EndIf If flag.replay <> 1 Then 'no manual replay count.game += 1 'increase game counter Open logFile.uci For Output As #lguci 'initiate new file Print #lguci, gamestamp Close #lguci Open logFile.fen For Output As #lgfen 'initiate new file Print #lgfen, gamestamp Close #lgfen 'assign engines to colour If count.game And 1 Then 'every odd game number currentWhite = 1 currentBlack = 2 Else 'every even game number currentWhite = 2 currentBlack = 1 EndIf '-------------------------------------------------------------------- 'start and connect white engine white.pipe = bipOpen(ExePath + "\engines\" + engine(currentWhite).fileName,SW_MINIMIZE) If engine(currentWhite).fileName = "human2.exe" Then flag.human Or= 1 EndIf '- - - - - - - - - - - - - - - - - - - - - - 'start and connect black engine black.pipe = bipOpen(ExePath + "\engines\" + engine(currentBlack).fileName,SW_MINIMIZE) If engine(currentBlack).fileName = "human2.exe" Then flag.human Or= 2 EndIf '-------------------------------------------------------------------- EndIf 'set internal board default Restore boardLayout For j As Integer = 0 To 11 For i As Integer = 0 To 11 Read board(i,j) Next i Next j makeBoardImage updateScreen If flag.replay2 Then Open logFile.fen For Input As #lgfen ReDim fen(1) Line Input #lgfen, fen(1) 'overread stamp Line Input #lgfen, fen(1) '1st fen-string Do Until EOF(lgfen) ReDim Preserve fen(UBound(fen) + 1) Line Input #lgfen, fen(UBound(fen)) Loop Close #lgfen x = 1 Do g = Inkey If mouseMenu(" PgDn -> move ","->",43,6,cfont,cback) = 9 Or _ g = Chr(255,81) Then 'page down --> next move x = IIf(x < UBound(fen), x + 1,x) fenToBoard(fen(x)) updateScreen showInternalBoard Locate 70,10 Print fen(x);" " ElseIf mouseMenu(" PgUp -> back ","->",44,6,cfont,cback) = 9 Or _ g = Chr(255,73) Then 'page up --> one move back x = IIf(x > 1,x - 1,1) fenToBoard(fen(x)) updateScreen showInternalBoard Locate 70,10 Print fen(x);" " ElseIf mouseMenu(" Esc -> quit ","->",45,6,cfont,cback) = 9 Or _ g = Chr(27) Then 'Esc --> main menu flag.replay = 0 flag.replay2 = 0 Exit Do,Do EndIf Loop EndIf 'reset variables move = "" screenText.move = "xx xx" opponent = b '(!) hod = "position startpos moves" moves = "" flag.mate = 0 count.move = 0 If flag.replay = 0 Then 'no replay engine(1).timeLeft = engine(1).gameTime * 1000 engine(2).timeLeft = engine(2).gameTime * 1000 engine(1).timePlayed = 0 engine(2).timePlayed = 0 EndIf If flag.replay <> 1 Then Open logFile.game For Output As #lggam 'open the protocol file Print #lggam, "game";count.game Print #lggam, "stamp";gamestamp Locate 52,30 Print "LOADING ENGINES" WriteEngineInfo(w,"uci") WriteEngineInfo(b,"uci") Do g = GetEngineResponse(w) If InStr(g,"id name ") Then x = InStr(g,"id name ") + 8 white.name = Mid(g, x, InStr(x,g,Chr(13)) - x) 'get the name of engine 1 engine(currentWhite).engineName = white.name EndIf Loop Until InStr(g,"uciok") Do g = GetEngineResponse(b) If InStr(g,"id name ") Then x = InStr(g,"id name ") + 8 black.name = Mid(g, x, InStr(x,g,Chr(13)) - x) 'get the name of engine 1 engine(currentBlack).engineName = black.name EndIf Loop Until InStr(g,"uciok") 'write to protocol file Print #lggam, "white ";white.name;" (";engine(currentWhite).fileName;")" Print #lggam, "black ";black.name;" (";engine(currentBlack).fileName;")" Print #lggam, "mode ";playmode; Select Case playmode Case "depth" Print #lggam, depth Case "movetime" Print #lggam, moveTimePreset Case "gametime" Print #lggam, gameTimePreset End Select Print #lggam, "" 'Close 1 Open logFile.turnament For Append As #lgtur Print #lgtur, "" Print #lgtur, "game";count.game Print #lgtur, "stamp";gameStamp Print #lgtur, "white ";white.name;" ";engine(currentWhite).fileName Print #lgtur, "black ";black.name;" ";engine(currentBlack).fileName Print #lgtur, "mode ";playmode; Select Case playmode Case "depth" Print #lgtur, depth Case "movetime" Print #lgtur, moveTimePreset;" (+";moveTimeHandicap;")" Case "gametime" Print #lgtur, gameTimePreset;" (";gameTimeHandicap;")" End Select Close #lgtur '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") engine(1).matesign = 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") engine(2).matesign = GetMove("fullblack") 'Open ExePath + "\gamelog.txt" For Append As #1 'open the protocol file Print #lggam, engine(1).matesign;"*" Print #lggam, engine(2).matesign;"*" Close #lggam setEngineOptions(w) setEngineOptions(b) EndIf '******** for testing ***************** 'fenstr = "7K/6q1/7b/8/8/8/8/6k1 w - - 3 41" 'test mate response 'fenstr = "4k3/8/8/8/8/8/1P6/4K3 w - - 5 39" 'fenstr = "3b4/7r/K7/8/k7/8/8/8 w - - 3 26" 'test stalemate 'fenstr = "k7/P7/8/8/8/8/8/5KN1 b - - 3 26" 'test dead position 'fenstr = "k7/8/8/8/8/8/8/1B3KNN w - - 3 26" 'test check by knight 'fenToBoard(fenstr) 'hod = "position fen " + fenstr + " moves" 'fenToBoard("4N3/p7/1p6/n1p1kB1p/2P1Q3/1P6/P6P/6K1 b - - 3 56") '50 moves 'hod = "position startpos moves b1c3 d7d5 d2d4 g8f6 c1f4 e7e6 e2e3 f8e7 f1d3 e8g8 g1f3 f6h5 f4g3 b8d7 f3g5 h5g3 d3h7 g8h8 g5f7 f8f7 h2g3 d7f6 h7g6 h8g8 g3g4 e6e5 d4e5 f6g4 g6f7 g8f7 c3d5 c7c6 d5e7 d8e7 d1f3 f7g8 e1c1 c8e6 f3h3 g4h6 h3g3 h6f7 f2f4 e6f5 a2a3 e7c5 e3e4 f5e4 g3b3 e4d5 b3b7 a8f8 b7b4 c5b4 a3b4 f8b8 b4b5 b8b5 h1h2 f7h6 d1d3 g8f7 b2b3 b5b4 c2c4 d5e6 h2h5 a7a5 d3c3 a5a4 c1b2 c6c5 h5h1 a4b3 c3b3 b4c4 b3b7 f7g6 g2g3 c4b4 b7b4 c5b4 h1a1 h6g4 a1a7 b4b3 a7b7 g4f2 b7b6 g6f5 b6d6 e6c4 d6d4 f2d3 b2a1 c4b5 d4d5 b3b2 a1b1 b5c6 d5d4 c6b5 d4d6 b5c4 e5e6 f5f6 f4f5 g7g6 f5g6 f6g6 e6e7 g6f7 d6d3 c4d3 b1b2 d3b1 e7e8r f7e8 b2b1 e8d7 b1c2 d7c6 c2d3 c6d5 g3g4 d5e6 g4g5 e6d5 g5g6 d5e6 d3d4 e6f6 g6g7 f6g7" 'hod = "position startpos moves b1c3 d7d5 d2d4 g8f6 c1f4 e7e6 e2e3 f8e7 f1d3 e8g8 g1f3 f6h5 f4g3 b8d7 f3g5 h5g3 d3h7 g8h8 g5f7 f8f7 h2g3 d7f6 h7g6 h8g8 g3g4 e6e5 d4e5 f6g4 g6f7 g8f7 c3d5 c7c6 d5e7 d8e7 d1f3 f7g8 e1c1 c8e6 f3h3 g4h6 h3g3 h6f7 f2f4 e6f5 a2a3 e7c5 e3e4 f5e4 g3b3 e4d5 b3b7 a8f8 b7b4 c5b4 a3b4 f8b8 b4b5 b8b5 h1h2 f7h6 d1d3 g8f7 b2b3 b5b4 c2c4 d5e6 h2h5 a7a5 d3c3 a5a4 c1b2 c6c5 h5h1 a4b3 c3b3 b4c4 b3b7 f7g6 g2g3 c4b4 b7b4 c5b4 h1a1 h6g4 a1a7 b4b3 a7b7 g4f2 b7b6 g6f5 b6d6 e6c4 d6d4 f2d3 b2a1 c4b5 d4d5 b3b2 a1b1 b5c6 d5d4 c6b5 d4d6 b5c4 e5e6 f5f6 f4f5 g7g6 f5g6 f6g6 e6e7 g6f7 d6d3 c4d3 b1b2 d3b1 e7e8r f7e8 b2b1 e8d7 b1c2 d7c6 c2d3 c6d5 g3g4 d5e6 g4g5 e6d5 g5g6 d5e6 d3d4 e6f6 g6g7" 'hod = "position startpos moves e2e4 g8f6 e4e5 f6d5 d2d4 d7d6 g1f3 b8c6 f1b5 c8f5 e1g1 a7a6 b5c6 b7c6 b1a3 a8b8 d1e2 d8c8 a3c4 c8d7 f1e1 h7h6 c1d2 e7e6 b2b3 f5c2 c4a5 b8b6 e2c4 c2f5 a1c1 d5b4 e5d6 c7d6 d2b4 d6d5 f3e5 d5c4 e5d7 f8b4 d7b6 b4a5 b6c4 a5e1 c1e1 f7f6 f2f3 e8d7 g1f2 h8b8 e1c1 b8b5 g2g4 f5g6 c1d1 g6c2 d1d2 c2g6 h2h4 h6h5 f2e3 d7e7 d2g2 g6f7 g4h5 b5h5 g2g7 h5h4 c4a5 h4h2 a2a3 e7f8 g7g3 h2a2 a3a4 a2b2 g3g1 e6e5 d4e5 f7b3 g1g6 f6e5 a5b3 b2b3 e3e4 b3c3 e4e5 f8f7 g6h6 c3e3 e5f4 e3a3 h6c6 a3a4 f4f5 a4a5 f5g4 a5a2 g4g5 a6a5 f3f4 a5a4 c6a6 a4a3 g5f5 f7e7 a6a7 e7d6 f5e4 a2a1 e4d4 a1d1 d4c4 d1c1 c4d4 c1a1 a7a6 d6c7 a6a5 c7b6 a5a4 b6b5 a4a7 b5b4 a7b7 b4a4 b7a7 a4b3 a7b7 b3a2 f4f5 a1b1 b7g7 b1f1 d4e5 a2b3 g7b7 b3c4 b7c7 c4b4 c7a7 f1e1 e5d5 e1d1 d5e6 b4b3 f5f6 a3a2 f6f7 d1e1 e6d5 e1f1 a7b7 b3c3 b7a7 c3b2 a7b7 b2c2 b7a7 a2a1q a7a1 f1f7 a1e1 c2b2 e1g1 b2b3 g1a1 f7f3 a1b1 b3c2 b1a1 c2b2 a1d1 f3c3 d1e1 b2b3 e1a1 b3b2 a1d1 b2b3 d1a1" 'hod = " position startpos moves e2e4 g8f6 e4e5 f6d5 c2c4 d5b4 d2d4 b8c6 a2a3 b4a6 b2b4 a6b8 b1c3 d7d6 g1f3 c8g4 b4b5 g4f3 g2f3 c6a5 c1g5 h7h6 g5e3 a7a6 f1e2 a6b5 c3b5 b8d7 f3f4 c7c6 b5c3 d7b6 c4c5 d6c5 d4c5 b6d5 d1c2 d5e3 f2e3 e7e6 c3e4 d8h4 e1d1 g7g5 e4f6 e8e7 f4g5 f8g7 h1f1 h6g5 f6g4 h8d8 d1c1 h4h8 c2c3 d8d5 g4f6 g7f6 e5f6 e7e8 c1b1 h8h2 a1a2 h2h7 a2c2 e8f8 e3e4 h7e4 e2f3 e4f5 f1h1 f8g8 f3d5 c6d5 c3h3 f5f6 h3h7 g8f8 h7h8 f8e7 h8a8 f6f3 h1h8 f3b3 b1c1 b3e3 c1d1 e3g1 d1e2 g1g2 e2e1 g2g1 e1d2 g1f2 d2c3 f2e3 c3b2 e3b3 b2a1 b3a3 a1b1 a3b4 b1c1 b4e1 c1b2 e1b4 b2a1 *b4a3 '*" '*************** MAIN LOOP ************************ flag.ready = 1 Do 'next halfmove 'switch opponents flag.human = 0 If opponent = w Then opponent = b 'black If black.name = "Colochessum human interface" Then flag.human = 1 EndIf Else opponent = w 'white count.move += 1 'move number If white.name = "Colochessum human interface" Then flag.human = 1 EndIf EndIf g = makeFen 'printCon("",g) If flag.replay <> 1 Then Open logFile.fen For Append As #lgfen 'write fen-string to log file Print #lgfen, g Close #lgfen EndIf Locate 57,1 ReDim Preserve fen(UBound(fen) + 1) fen(UBound(fen)) = g 'write fen-string to table 'ScreenLock updateScreen Scan() 'ScreenUnLock showInternalBoard flag.mate = 0 If flag.replay = 0 Then 'no replay --> calculate next move WriteEngineInfo(opponent,hod + moves) 'send the actual board setup to the engine 'ScreenLock updateScreen'() Scan 'ScreenUnLock Select Case playmode Case "depth" WriteEngineInfo(opponent,"go depth " + Str(engine(IIf(opponent = w,currentWhite,currentBlack)).depth)) 'Select Case opponent ' Case w ' WriteEngineInfo(opponent,"go depth " + Str(engine(currentWhite).depth)) 'depth mode ' Case b ' WriteEngineInfo(opponent,"go depth " + Str(engine(currentBlack).depth)) 'End Select Case "movetime" timeRemind = Timer WriteEngineInfo(opponent,"go movetime " + Str(engine(IIf(opponent = w,currentWhite,currentBlack)).moveTime)) 'Select Case opponent 'call the actual opponent with its movetime ' Case w ' WriteEngineInfo(opponent,"go movetime " + Str(engine(currentWhite).moveTime)) ' Case b ' WriteEngineInfo(opponent,"go movetime " + Str(engine(currentBlack).moveTime)) 'End Select Case "gametime" timeRemind = Timer WriteEngineInfo(opponent,"go wtime " + Str(engine(IIf(opponent = w,currentWhite,currentBlack)).timeLeft)) 'Select Case opponent 'call the actual opponent with its rest time ' Case w ' WriteEngineInfo(opponent,"go wtime " + Str(engine(currentWhite).timeLeft)) ' Case b ' WriteEngineInfo(opponent,"go btime " + Str(engine(currentBlack).timeLeft)) 'End Select End Select EndIf move = GetMove(opponent) 'read the "bestmove" from the engine 'sleep If flag.testForLegal Then g = GetLegalMoves(fen(UBound(fen))) If InStr(g,Left(move,4)) Then count.legal = -2 For x As Integer = 0 To Len(g) - 1 If g[x] = Asc(" ") Then count.legal += 1 Next legalHint = " " + opponent + " " + move + " LEGAL" ' (" + Str(count.legal) + ")" islegal = 1 ElseIf move = "mate" Then legalHint = " mate " islegal = 1 Else legalHint = " " + opponent + " " + move + " ILLLEGAL" count.illegal += 1 islegal = 0 EndIf EndIf updateScreen'(0,0,640,530) 'Sleep 1000 If flag.setEngineOptions Then printCon("optionflag") setEngineOptions(w) setEngineOptions(b) flag.setEngineOptions = 0 updateScreen EndIf If move = "Esc" Then 'start a new game Close CloseEngines flag.replay = 0 GoTo startNew EndIf If (playmode = "gametime") And (flag.replay = 0) Then 'subtract the calculating time Select Case opponent Case w engine(currentWhite).timeLeft -= 1000 * (Timer - timeRemind) If engine(currentWhite).timeLeft <= 0 Then move = "timeout" EndIf Case b engine(currentBlack).timeLeft -= 1000 * (Timer - timeRemind) If engine(currentBlack).timeLeft <= 0 Then move = "timeout" EndIf End Select Open logFile._time For Output As #lgtim Print #lgtim, gameStamp Print #lgtim, engine(1).timeLeft Print #lgtim, engine(2).timeLeft Close #lgtim ElseIf (playmode = "movetime") And (flag.replay = 0) Then 'add the calculating time Select Case opponent Case w engine(currentWhite).timePlayed += 1000 * (Timer - timeRemind) Case b engine(currentBlack).timePlayed += 1000 * (Timer - timeRemind) End Select Open logFile._time For Output As #lgtim Print #lgtim, gameStamp Print #lgtim, engine(1).timePlayed Print #lgtim, engine(2).timePlayed Close #lgtim EndIf lastmove = move 'check if the response is a correct move If move = "mate" Then 'checkmate If flag.replay Then Locate 70,20 Print "MATT" Sleep EndIf If testForCheck(opponent) Then flag.mate = 1 'checkmate Else flag.mate = 2 'stalemate EndIf ElseIf move = "timeout" Then flag.mate = 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, white.name Case b Print #1, black.name End Select If flag.replay <> 1 Then Open logFile.turnament For Append As #lgtur Print #lgtur, hod;moves;" *";move;"*" Print #lgtur, "game aborted due to response error caused by "; Select Case opponent Case w Print #lgtur, white.name Case b Print #lgtur, black.name End Select Close #lgtur EndIf Exit Do 'terminate current game EndIf Do 'check for drawn game If flag.mate Then 'checkmate or stalemate Exit Do 'leave the loop EndIf 'check for threefold repetition g = makeFen 'create fen-string parseFen(makeFen) g = fenP.Board + fenP.Castling + fenP.EnPassant y = 0 For x = UBound(fen) - 1 To 1 Step -1 parseFen(fen(x)) g2 = fenP.Board + fenP.Castling + fenP.EnPassant If g2 = g Then y += 1 printCon("",String(Len(Str(x)) + 1," ") + g) printCon("",Str(x) + " " + g2) printCon("","") EndIf If y > 1 Then flag.mate = 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" flag.mate = 4 Exit Do 'leave the loop End Select 'check for 50-moves-rule If count.h50 > 99 Then flag.mate = 5 Exit Do 'leave the loop EndIf Loop Until 1 'always leave the loop If flag.mate Then 'end game showInternalBoard If flag.replay <> 1 Then Open logFile.game For Append As #lggam Open logFile.turnament For Append As #lgtur EndIf Select Case flag.mate Case 1 'checkmate Locate 51,29 Print " << CHECK MATE >> " 'write to protocol file Print #lggam, " << CHECK MATE >> " Locate 69,20 Select Case opponent 'set the win counter and write to protocol file Case w Print #lggam, "black (";black.name; Print "<< BLACK (";black.name; engine(currentBlack).win += 1 'winner Select Case playmode Case "movetime" engine(currentWhite).moveTime += moveTimeHandicap 'loser engine(currentBlack).moveTime -= moveTimeHandicap 'winner Case "depth" engine(currentWhite).depth += depthHandicap 'loser engine(currentBlack).depth -= depthHandicap 'winner Case "gametime" engine(currentWhite).gameTime += gameTimeHandicap 'loser engine(currentBlack).gameTime -= gameTimeHandicap 'winner End Select Case b Print #lggam, "white (";white.name; Print "<< WHITE (";white.name; engine(currentWhite).win += 1 'winner Select Case playmode Case "movetime" engine(currentBlack).moveTime += moveTimeHandicap 'loser engine(currentWhite).moveTime -= moveTimeHandicap 'winner Case "depth" engine(currentBlack).depth += depthHandicap 'loser engine(currentWhite).depth -= depthHandicap 'winner Case "gametime" engine(currentBlack).gameTime += gameTimeHandicap 'loser engine(currentWhite).gameTime -= gameTimeHandicap 'winner End Select End Select Print #lggam, ") wins in"; count.move; " moves" Print ") wins in"; count.move; " moves >>" For x = 1 To 2 'don't let the values become negative If engine(x).moveTime < 1 Then engine(x).moveTime = 1 If engine(x).depth < 1 Then engine(x).depth = 1 If engine(x).gameTime < 1 Then engine(x).gameTime = 1 Next 'write to turnament log 'If flag.replay <> 1 Then ' Open ExePath + "\turnamentlog.txt" For Append As #2 'EndIf Print #lgtur, "check mate ";'#2 Select Case opponent Case w Print #lgtur, black.name;" wins as black "; Case b Print #lgtur, white.name;" wins as white "; End Select Print #lgtur, "in"; count.move; " moves" showInternalBoard Case 2 'stalemate count.drawn += 1 Print #lgtur, "drawn because of stalemate after"; count.move; " moves" Locate 51,29 Print " << STALE MATE >> " Case 3 'threefold repetition count.drawn += 1 Print #lgtur, "drawn because of threefold repetition after"; count.move; " moves" Locate 51,29 Print " << THREEFOLD REPETITION >> " Case 4 'dead position count.drawn += 1 Print #lgtur, "drawn because of dead position after"; count.move; " moves" Locate 51,29 Print " << DEAD POSITION >> " Case 5 '50-moves-rule count.drawn += 1 Print #lgtur, "drawn because of breaking the 50-moves-rule after"; count.move; " moves" Locate 51,29 Print " << 50 MOVES >> " Case 6 'timeout updateScreen Locate 51,29 Print " << TIMEOUT >> " 'write to protocol file Print #lggam, " << TIMEOUT >> " Locate 69,20 Select Case opponent 'set the win counter and write to protocol file Case w Print #lggam, "black (";black.name; Print "<< BLACK (";black.name; engine(currentBlack).win += 1 'winner Select Case playmode Case "movetime" engine(currentWhite).moveTime += moveTimeHandicap 'loser engine(currentBlack).moveTime -= moveTimeHandicap 'winner Case "depth" engine(currentWhite).depth += depthHandicap 'loser engine(currentBlack).depth -= depthHandicap 'winner Case "gametime" engine(currentWhite).gameTime += gameTimeHandicap 'loser engine(currentBlack).gameTime -= gameTimeHandicap 'winner End Select Case b Print #lggam, "white (";white.name; Print "<< WHITE (";white.name; engine(currentWhite).win += 1 'winner Select Case playmode Case "movetime" engine(currentBlack).moveTime += moveTimeHandicap 'loser engine(currentWhite).moveTime -= moveTimeHandicap 'winner Case "depth" engine(currentBlack).depth += depthHandicap 'loser engine(currentWhite).depth -= depthHandicap 'winner Case "gametime" engine(currentBlack).gameTime += gameTimeHandicap 'loser engine(currentWhite).gameTime -= gameTimeHandicap 'winner End Select End Select Print #lggam, ") wins in"; count.move; " moves" Print ") wins in"; count.move; " moves >>" 'write to turnament log If flag.replay <> 1 Then Open ExePath + "\turnamentlog.txt" For Append As #2 EndIf Print #lgtur, "timeout "; Select Case opponent Case w Print #lgtur, black.name;" wins as black "; Case b Print #lgtur, white.name;" wins as white "; End Select Print #lgtur, "in"; count.move; " moves" End Select Print #lgtur, Mid(moves,2) Print #lgtur, "*";lastmove;"*" Print #lgtur, "total won ";engine(1).fileName;engine(1).win Print #lgtur, "total won ";engine(2).fileName;engine(2).win Print #lgtur, "total drawn ";count.drawn Close If flag.replay Then 'Sleep Else Sleep gameDelay EndIf Exit Do 'start next game EndIf moves += " " + move 'add the last move to the hod-string showInternalBoard 'save the moves string If flag.replay <> 1 Then Open logFile.moves For Output As #lgmov Print #lgmov, gameStamp Print #lgmov, Mid(moves,2) Close #lgmov EndIf 'add the last move to the movetable ReDim Preserve movetable(UBound(movetable) + 1) If opponent = w Then movetable(UBound(movetable)) = Right(" " + Str(count.move),3) Else movetable(UBound(movetable)) = " " EndIf movetable(UBound(movetable)) += " " + UCase(Left(move,2)) + " " + _ UCase(Mid(move,3,2)) + " " + _ UCase(Mid(move,5,1)) + " " screenText.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 flag.castling = deleteFromString(flag.castling,"Q") Case "h1" 'right white rook flag.castling = deleteFromString(flag.castling,"K") Case "e1" 'white king flag.castling = deleteFromString(flag.castling,"QK") Case "a8" 'left black rook flag.castling = deleteFromString(flag.castling,"q") Case "h8" 'right black rook flag.castling = deleteFromString(flag.castling,"k") Case "e8" 'black king flag.castling = deleteFromString(flag.castling,"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 updateScreen Scan 'ScreenUnLock showInternalBoard g = Inkey 'check for keyboard input Do Select Case g Case Chr(27) 'terminate current game count.drawn += 1 End Select g = Inkey 'check for key pressed Loop While Len(g) If (g = Chr(27)) Or flag.break Then count.drawn += 1 CloseEngines Close Exit Do,Do EndIf Loop 'Until (g = Chr(27)) 'Or g = Chr(255,107) 'Esc, X flag.ready = 0 CloseEngines Close Loop 'next game Loop Close End Sub updateScreen Dim As Integer x, y, shade Dim As Double t Dim As String legendCol, legendRow ScreenLock 'drawBoard Color cfont,cback Cls '1 'Sleep '500 'scan Put (boardPosition.x, boardPosition.y),boardImage,PSet 'border of board Line (boardPosition.x - 1,boardPosition.y - 1) - _ (boardPosition.x + 8 * fieldSize, boardPosition.y + 8 * fieldSize), _ cfont, b 'print engine names Locate 2,22 Print IIf(flag.flipBoard,white.name,black.name) Locate 49,22 Print IIf(flag.flipBoard,black.name,white.name) 'print board legend If flag.flipBoard Then legendRow = "12345678" legendCol = "HGFEDCBA" Else legendRow = "87654321" legendCol = "ABCDEFGH" EndIf For x = 1 To 8 Draw String (boardPosition.x - 15, _ boardPosition.y + fieldSize * (x - .5) - 4), _ Mid(legendRow,x,1) Draw String (boardPosition.x + fieldSize * (x - .5) - 4, _ boardPosition.y + fieldSize * 8 + 5), _ Mid(legendCol,x,1) Next Locate 22,2 Print "Game";count.game Locate 23,2 Print "Move";count.move;" (";Str(count.h50);")" Locate 54,22 Print "engine 1: ";engine(1).engineName Select Case playmode Case "movetime" Print Tab(22);"movetime:";engine(1).moveTime;" ms" Case "depth" Print Tab(25);"depth:";engine(1).depth Case "gametime" Print Tab(22);"gametime: ";timeFormat(engine(1).gameTime,1) End Select Print Tab(27);"won:";engine(1).win Print Print Tab(22);"engine 2: ";engine(2).engineName Select Case playmode Case "movetime" Print Tab(22);"movetime:";engine(2).moveTime;" ms" Case "depth" Print Tab(25);"depth:";engine(2).depth Case "gametime" Print Tab(22);"gametime: ";timeFormat(engine(2).gameTime,1) End Select Print Tab(27);"won:";engine(2).win Print Print Tab(19);"drawn games:";count.drawn Print Print Tab(22);"playmode: ";playmode Print Tab(22);"handicap:"; Select Case playmode Case "movetime" t = Abs(moveTimeHandicap * (engine(1).win - engine(2).win)) Print t;" ms (";CInt(100 * t / moveTimePreset);"% )" Case "depth" Print Abs(depthHandicap * (engine(1).win - engine(2).win)) Case "gametime" t = Abs(gameTimeHandicap * (engine(1).win - engine(2).win)) Print " ";timeFormat(t,1); Print " (";CInt(100 * t / gameTimePreset);"% )" End Select 'If flag.animation And 1 Then ' Print ' Print Tab(15);"animation speed:";animationSpeed 'EndIf printInfo 'Locate 69,2 'Print infoString(0) 'Print 'For x = 1 To UBound(infoKeyword) ' Print String(15 - Len(infoKeyword(x))," ");infoKeyword(x);" ";infoString(x) 'Next PrintMoveTable If flag.testForLegal Then Locate 51,55 Print legalHint Locate 52,56 Print count.legal; " legal move(s)" Locate 53,56 Print count.illegal; " illegal move(s)" EndIf If flag.replay = 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 'View ScreenUnLock() 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 Dim As FB.Image Ptr animBoard Dim As boardImagePointers ip ip = SetBoardImagePointers(cMove) 'make move on internal board choice = board(cMove.x1 + 2,cMove.y1 + 2) 'piece which is moved pchoice = choice count.h50 += 1 If board(cMove.x2 + 2,cMove.y2 + 2) Then 'piece to be captured on destination field Mid(movetable(UBound(movetable)),7,1) = "x" Mid(screenText.move,3,1) = "x" SetTitleBar PrintMoveTable count.h50 = 0 'reset 50-moves-counter EndIf If Abs(choice) = 1 Then 'pawn is moved count.h50 = 0 EndIf board(cMove.x1+2,cMove.y1+2) = 0 'clear source field on internal board makeBoardImage 'board without the moved piece updateScreen'(0,0,640,200) board(cMove.x2+2,cMove.y2+2) = choice 'set moved piece to destination field on internal board choice = IIf(choice < 0, Abs(choice) - 1,choice + 5) 'convert internal piece number to image ID Select Case flag.replay Case 0, 1 'no or manual replay 'compute direction of movement dx = IIf(ip.pxs > ip.pxd,-1,1) dy = IIf(ip.pys > ip.pyd,-1,1) Scan If flag.testForLegal Then If islegal = 0 Then 'illegal move Shell "start C:\WINDOWS\system32\notepad.exe " + ExePath + "\engines\boardlog.txt" Shell "C:\WINDOWS\system32\notepad.exe " + ExePath + "\engines\legalmoves2.txt" Sleep EndIf EndIf If Bit(flag.animation,0) Then 'animation is ON 'frame the source- and destination field If Bit(flag.animation,1) = 0 Then Put boardImage,(ip.pxs,ip.pys),srcFrame,Trans Put boardImage,(ip.pxd,ip.pyd),dstFrame,Trans EndIf updateScreen'(0,0,640,200) Put (ip.pxs + boardPosition.x, ip.pys + boardPosition.y),iPiece(choice),Trans 'place moved piece on screen timeRem = Timer If Bit(flag.animation,1) = 0 Then Do 'move delay Scan Sleep 1 Loop Until Timer >= timeRem + moveDelay / 1000 EndIf timeRem = Timer If Bit(flag.animation,1) Then ip.pxs = ip.pxd ip.pys = ip.pyd flag.animation = BitReset(flag.animation,1) EndIf Do While ip.pxs <> ip.pxd Or ip.pys <> ip.pyd 'animation loop Scan If Timer > timeRem + .001 * animationSpeed Then timeRem += .001 * animationSpeed'Timer 'update coordinates of moved piece ip.pxs += IIf(ip.pxs <> ip.pxd,dx,0) ip.pys += IIf(ip.pys <> ip.pyd,dy,0) ScreenLock Put (boardPosition.x, boardPosition.y),boardImage,PSet 'draw animation board on screen Put (ip.pxs + boardPosition.x,ip.pys + boardPosition.y),iPiece(choice),Trans 'place moved piece on screen ScreenUnLock Else Sleep 1 EndIf Loop EndIf 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 'write new piece to internal board EndIf parseFen(fen(UBound(fen))) If (Mid(move,3,2) = fenP.EnPassant) And (Abs(pchoice) = 1) Then 'en passant printCon("en passant","") Open logFile.enpassant For Append As #lgenp Print #lgenp, "game ";count.game Print #lgenp, "move ";count.move Print #lgenp, "opponent ";opponent Print #lgenp, "" Close #lgenp If cMove.y2 = 5 Then 'remove captured white pawn from internal board board(cMove.x2 + 2,6) = 0 ElseIf cMove.y2 = 2 Then 'remove captured black pawn from internal board board(cMove.x2 + 2,5) = 0 EndIf Mid(movetable(UBound(movetable)),7,1) = "x" Mid(screenText.move,3,1) = "x" SetTitleBar PrintMoveTable EndIf makeBoardImage 'image of board with the move done updateScreen 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 = flag.replay flag.replay = 0 EndIf screenText.opponent = opp 'for title bar Select Case flag.replay 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 Dim As Integer txBeg, txEnd, txPtr Dim As String inf If Left(g,4) = "info" Then 'parse info string and display on screen 'Locate 69,2 'Print UCase(opp);" info:" 'Print UCase(opp);" (";engine(IIf(opp = "white",currentWhite,currentBlack)).engineName;") INFO:" infoString(0) = UCase(opp) + " (" + engine(IIf(opp = "white",currentWhite,currentBlack)).engineName + ") INFO:" 'Print For x = 1 To UBound(infoKeyword) If x = UBound(infoKeyword) Then Print 'Print String(15 - Len(infoKeyword(x))," ");infoKeyword(x);" "; txBeg = InStr(g,infoKeyword(x)) If txBeg Then inf = Mid(g,txBeg + Len(infoKeyword(x)) + 1) txEnd = Len(inf) For y As Integer = 1 To UBound(infoKeyword) txPtr = InStr(inf,infoKeyword(y)) If (txPtr < txEnd) And (txPtr <> 0) Then txEnd = txPtr EndIf Next infoString(x) = Left(inf,txEnd - 1)+String(60 - txEnd," ")';"*" 'Print Left(inf,txEnd - 1);String(60 - txEnd," ")';"*" 'Else ' Print EndIf Next printInfo 'Locate 69,2 'Print infoString(0) 'Print 'For x = 1 To UBound(infoKeyword) ' Print String(15 - Len(infoKeyword(x))," ");infoKeyword(x);" ";infoString(x) 'Next 'Locate 70,2 'Print g 'Sleep 200 EndIf '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;" " screenText.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(engine(currentBlack).timeLeft/1000,1) Locate 46,9 Color cfont,cbacklt Print " ";timeFormat(engine(currentWhite).timeLeft/1000 - (Timer - timeRemind),1);" " Color cfont,cback Case b Locate 5,9 Color cfont,cbacklt Print " ";timeFormat(engine(currentBlack).timeLeft/1000 - (Timer - timeRemind),1);" " Color cfont,cback Locate 46,10 Print timeFormat(engine(currentWhite).timeLeft/1000,1) End Select ElseIf timeRemind > 0 Then Select Case opp Case w Locate 5,10 Print timeFormat(engine(currentBlack).timePlayed/1000,1) Locate 46,9 Color cfont,cbacklt Print " ";timeFormat(engine(currentWhite).timePlayed/1000 + (Timer - timeRemind),1);" " Color cfont,cback Case b Locate 5,9 Color cfont,cbacklt Print " ";timeFormat(engine(currentBlack).timePlayed/1000 + (Timer - timeRemind),1);" " Color cfont,cback Locate 46,10 Print timeFormat(engine(currentWhite).timePlayed/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 If mouseMenu(" PgDn -> move ","->",43,6,cfont,cback) = 9 Or _ g = Chr(255,81) Then '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 ElseIf mouseMenu(" PgUp -> back ","->",44,6,cfont,cback) = 9 Or _ g = Chr(255,73) Then '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))) showInternalBoard 'Sleep updateScreen Scan 'sleep endPtr = begPtr begPtr = InStrRev(replayMoves," ",endPtr - 1) EndIf ElseIf mouseMenu(" Esc -> quit ","->",45,6,cfont,cback) = 9 Or _ g = Chr(27) Then 'Esc --> main menu Return "Esc" ElseIf g = Chr(255,107) Then 'end program Shutdown EndIf Loop Case 2 'instant replay 'replaylist = "e2e4 g8f6 e4e5 f6d5 c2c4 d5b4 d2d4 d7d6 d1a4 b8c6 a2a3 b4a6 g1f3 c8d7 a4b3 d6e5 d4e5 b7b6 b3c2 g7g6 b2b4 f8g7 c2c3 d7g4 b1d2 a6b8 b4b5 c6a5 f1d3 b8d7 d3e4 a8c8 h2h3 g4e6 e4d5 e6d5 c4d5 d7c5 d2c4 d8d5 c4a5 b6a5 e1g1 e8g8 c1e3 c5d3 a1d1 d3e5 f3e5 g7e5 c3a5 d5e4 f1e1 f8d8 d1d8 c8d8 e3c5 e4c2 c5e7 d8d1 e7b4 e5d4 e1d1 c2d1 b4e1 d1e2 a3a4 e2e4 a5b4 e4h4 g1f1 h4f4 b4d2 f4e5 f2f3 g8g7 d2d3 e5c5 e1d2 g7g8 d2h6 c5d6 d3e4 d6d8 f1e2 d4b6 g2g3 b6c5 h6e3 c5b6 e4e5 f7f6 e5e6 g8g7 h3h4 h7h6 g3g4 h6h5 g4h5 g6h5 f3f4 b6d4 f4f5 d4e3 e6e3 d8d5 e3a7 d5e4 e2d2 e4f4 a7e3 f4b4 d2e2 b4g4 e2d3 g4f5 d3c3 g7f7 e3d3 f5e5 d3d4 e5e1 c3c4 f7g7 c4d5 e1h1 d5c5 h1c1 d4c4 c1g1 c5c6 g1g4 c4b3 g4h4 c6c7 h4f4 c7b7 h5h4 b5b6 f4g5 b3e6 g5h5 b7a6 h5d1 b6b7 d1a4 a6b6 a4b4 b6c7 b4a5 e6b6 a5c3 b6c6 c3a5 c7c8 a5f5 c6d7 g7g6 b7b8q f5c5 b8c7 c5f8 d7d8 f8d8 c8d8 f6f5 c7f4 g6f6 f4h4 f6e5 d8e7 f5f4 h4h5 e5e4 h5e2 e4d5 e2f3 d5e5 f3d3 f4f3 d3f3 e5d4 e7d6 d4c4 f3f4 c4c3 d6c5 c3d3 c5b4 d3c2 b4c4 c2d1 f4f2 d1c1 c4c3 c1b1 f2b2 a1a1 " 'replaylist = "b1c3 d7d5 g1f3 d5d4 c3e4 g8f6 e4f6 e7f6 e2e4 d4e3 f2e3 b8c6 d2d4 f8e7 f1d3 c6b4 e1g1 e8g8 e3e4 b4d3 c2d3 f6f5 c1d2 b7b6 e4e5 c8b7 d1a4 a7a5 a1c1 b7d5 g1h1 c7c6 h2h3 d8d7 d2g5 e7g5 f3g5 f7f6 g5f3 f5f4 h1h2 d7e6 f1e1 f8e8 e1f1 a8c8 c1c3 e6f5 h2g1 f5g6 f1f2 g6g3 c3c2 e8e6 c2c1 f6e5 h3h4 e6g6 h4h5 g6g4 g1f1 b6b5 a4d1 e5d4 d1e1 g8f8 e1e5 c8e8 e5d6 f8g8 c1e1 e8f8 e1e7 h7h6 a2a4 d5f3 g2f3 g4g5 d6c6 g3g1 f1e2 g1b1 a4b5 g5g1 e7g7 g8g7 c6d7 f8f7 d7d4 g7g8 d4d8 g8h7 d8g8 h7g8 f2f1 g1f1 b2b3 b1d1 a1a1 " 'replaylist = "b1c3 d7d5 g1f3 d5d4 " 'replaylist = "(none) a1a1 b1c3 d7d5 d2d4 g8f6 c1f4 e7e6 e2e3 b8c6 g1f3 f8d6 f4d6 c7d6 f1b5 e8g8 e1g1 c8d7 b5c6 d7c6 b2b3 c6d7 d1d3 d8c7 f1c1 f8c8 c3e2 e6e5 d3d1 b7b5 e2g3 e5e4 f3h4 g7g6 d1d2 c7c3 d2e2 a7a5 a1b1 b5b4 h2h3 g8g7 e2d1 c3c6 a2a3 b4a3 b1a1 a5a4 a1a3 a4b3 a3b3 a8a2 d1e2 a2c2 e2c2 c6c2 c1c2 c8c2 b3b6 d7c6 b6b8 f6d7 b8c8 g7f6 f2f4 h7h6 g1h1 d7b6 c8c7 c6a4 c7c2 a4c2 h1g1 b6c4 g1f2 c2d3 f2e1 c4e3 e1d2 e3c4 d2e1 c4a3 e1d2 f6e6 d2d1 a3c2 d1d2 c2d4 d2c3 d4b5 c3d2 d5d4 d2e1 e6d5 g3h1 d3c4 h1f2 h6h5 f2d1 b5c3 d1b2 c4b5 g2g4 c3e2 g4h5 g6h5 f4f5 e2f4 b2d1 e4e3 d1b2 d5e4 b2d1 f4d3 e1f1 d3f2 f1g2 f2d1 h4f3 d4d3 f5f6 d1c3 f3g5 e4f4 g5f7 d3d2 f7h8 d2d1q h8g6 f4g5 g6e7 d1d2 g2h1 e3e2 h3h4 g5g4 h1g1 e2e1q a1a1 " 'replaylist = "a1a1 (non b1c3 d7d5 d2d4 g8f6 c1f4 e7e6 e2e3 f8b4 f1d3 e8g8 g1f3 f6h5 f4g5 h5f6 e1g1 b8c6 f3e5 h7h6 g5h4 b4e7 e5c6 b7c6 d1f3 a8b8 b2b3 c6c5 a2a3 c5d4 e3d4 c7c5 h4g3 b8a8 g3e5 c5d4 e5d4 c8d7 f3g3 a8c8 b3b4 g8h8 f1e1 d7c6 d4a7 e7d6 f2f4 f6h5 g3g4 h5f4 a7d4 f8g8 g2g3 f4d3 c2d3 c6d7 g4f3 e6e5 e1e5 d6e5 d4e5 d7e6 a1e1 g8e8 e5d4 f7f6 g1h1 d8d6 e1e2 h8h7 d4c5 d6d7 f3f4 d5d4 f4d4 d7d4 c5d4 c8c3 d4c3 e6d5 e2e4 f6f5 h1g2 f5e4 d3e4 e8e4 g2f2 e4c4 c3d2 c4c2 f2e3 d5c6 h2h4 c2b2 e3d3 b2b3 d3d4 b3g3 d4c5 c6e8 b4b5 e8b5 c5b5 g3a3 b5c5 a3h3 d2e1 h7g6 e1f2 g6f5 c5d5 g7g5 h4g5 h6g5 f2c5 h3d3 d5c4 f5e4 c5e7 g5g4 e7c5 g4g3 c4b4 g3g2 c5g1 d3d1 g1f2 g2g1q f2g1 d1g1 b4c5 g1g6 c5c4 g6g5 c4c3 g5c5 c3b4 e4d4 b4b3 c5c1 b3b2 c1c4 b2b3 d4d3 b3b2 c4b4 b2a3 d3c3 a3a2 b4b5 a2a1 c3c2 a1a2 b5a5 a1a1 " 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 flag.replay = 0 timeRemind = Timer printCon("FENs n ",UBound(fen)) EndIf End Select If full Then ' don't edit the message flag.replay = repmerk Return sRet EndIf For x = 1 To 2 If Left(sRet,4) = Left(engine(x).matesign,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 Dim As boardImagePointers ip Scan Select Case opp 'choose engine Case "white" sRet = bipReadLine(white.pipe) Case "black" sRet = bipReadLine(black.pipe) End Select If flag.replay <> 1 Then Open logFile.uci For Append As #lguci Print #lguci, "" Print #lguci, "RECEIVE FROM: ";opp Print #lguci, sRet;"*" Print #lguci, "----------" Close #lguci 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") ip = SetBoardImagePointers(cfield) If Bit(flag.animation,1) = 0 Then Put (boardPosition.x + ip.pxs,boardPosition.y + ip.pys),srcFrame,Trans EndIf 'For i = 0 To 3 ' Line (px1 + i,py1 + i) - (px1 + fieldSize - 1 - i,py1 + fieldSize - 1 - i),RGB(0,0,244),b 'source 'Next EndIf If InStr(sRet,"fieldreset") Then updateScreen EndIf If Len(sRet) Then printCon(UCase(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 flag.replay <> 1 Then Open logFile.uci For Append As #lguci Print #lguci,"" Print #lguci, "SEND TO: ";opp Print #lguci, s Print #lguci, "----------" Close #lguci EndIf 'send the command string to the engine Select Case opp 'choose engine Case "white" WriteFile(white.pipe->hWritePipe,StrPtr(sBuf),Len(sBuf),@iNumberOfBytesWritten,NULL) Case "black" WriteFile(black.pipe->hWritePipe,StrPtr(sBuf),Len(sBuf),@iNumberOfBytesWritten,NULL) End Select End Sub Sub SetTitleBar Dim As String text 'set the text of the screen window text = "COLOCHESSUM " + Left(UCase(screenText.opponent),1) + " " + screenText.move + " " + screenText.depth WindowTitle(text) End Sub Sub CloseEngines Dim As String order Dim As Integer iNumberOfBytesWritten Dim As Double timeRem order = "quit" + Chr(10) 'close white engine timeRem = Timer bipWrite(white.pipe,order,"b") bipClose(white.pipe) 'close black engine timeRem = Timer bipWrite(black.pipe,order,"b") bipClose(black.pipe) order = GetLegalMoves("close") End Sub Function makeFen() As String Dim As Integer x, col, lin, countFree, first, last Dim As String fenPcs, g For col = 2 To 9 'column For lin = 2 To 9 'line 'convert internal board to fen-string Select Case board(lin,col) Case 0 'free fenpcs += "0" Case 1 'white pawn fenpcs += "P" Case 2 'white rook fenpcs += "R" Case 3 'white knight fenpcs += "N" Case 4 'white bishop fenpcs += "B" Case 5 'white queen fenpcs += "Q" Case 6 'white king fenpcs += "K" Case -1 'black pawn fenpcs += "p" Case -2 'black rook fenpcs += "r" Case -3 'black knight fenpcs += "n" Case -4 'black bishop fenpcs += "b" Case -5 'black queen fenpcs += "q" Case -6 'black king fenpcs += "k" End Select Next fenpcs += "/" 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(flag.castling) Then 'castling fenpcs += " " + flag.castling 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(count.h50) + " " + Str(count.move) '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 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 fenP.Opponent = "w" Then opponent = w Else opponent = b EndIf flag.castling = fenP.Castling count.h50 = Val(fenP.Halfmoves) count.move = Val(fenP.Moves) End Sub Sub showInternalBoard() Dim As Integer col, row If flag.internalBoard Then 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 " EndIf End Sub Sub printCon(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 printCon(text As String) printCon("",text) End Sub Sub printCon(x As Integer) printCon("",Str(x)) End Sub Sub printCon(t As String = "",x As Integer) printCon(t,Str(x)) End Sub #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 text to separator If (mode And 2) Then 'draw frame around text Line (col * 8 - 9,lin * 8 - 9)-((col + Len(text) - 1) * 8,lin * 8),foreground,b EndIf Print text Exit For EndIf Next #EndMacro Function 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) As Integer 'mode 0 -> highlight at touch with cursor (default) 'mode 1 -> highlight at click 'mode 2 -> draw frame around text Dim As Integer mc, ml, wheel, buttons, textmin, textmax, x, compareColor, separatorpos, _ pressedButton = 0, returnValue = 0 Static As Integer oldlin, oldcol If lin = 0 Then lin = oldlin ElseIf lin < 0 Then lin = oldlin - lin EndIf If col = 0 Then col = Pos ElseIf col < 0 Then col = oldcol - col EndIf oldlin = lin oldcol = col 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 Select Case (mode And 1) Case 0 'highlight at touch If ml + 1 = lin Then 'mouse line = text line Select Case mc Case textmin To textmax 'cursor touches the text returnValue Or= 8 PrintMenuItemInv() 'highlight menu item If buttons Then 'mouse button pressed returnValue Or= buttons printCon(buttons) Do 'wait for release of the mouse button GetMouse (mc,ml,wheel,buttons) Loop While buttons EndIf Color cfont,cback Return returnValue End Select EndIf Case 1 'highlight at click If buttons Then 'mouse button pressed returnValue Or= buttons If ml + 1 = lin Then 'mouse line = text line Select Case mc Case textmin To textmax 'cursor touches the text returnValue Or= 8 PrintMenuItemInv() 'highlight menu item Do 'wait for release of the mouse button GetMouse (mc,ml,wheel,buttons) Loop While buttons Color cfont,cback Return returnValue End Select EndIf EndIf End Select PrintMenuItem() End Function 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 logFile.turnament For Input As #lgtur Do 'find and read the entries of the last 2 games Line Input #lgtur, 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 #lgtur, tl(2,x) Loop Until tl(2,x) = "" 'game entry complete filepointer(2) = Seek(lgtur) Loop Until EOF(lgtur) Close #lgtur 'game number count.game = 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 logFile.turnament For Binary As #lgtur g = Input(filepointer(1)-3, #lgtur) Close #lgtur Open logFile.turnament For Output As #lgtur Print #lgtur, g; Close #lgtur flag.replay = 2 'replayMoves = "e2e4 d7d5 e4d5 g8f6 d2d4 f6d5 c2c4 d5f6 g1f3 c8g4 f1e2 e7e6 d1b3 b7b6 b1c3 f8e7 c1e3 g4h5 b3b5 c7c6 b5a4 d8c7 e1g1 e8g8 h2h3 b8d7 f1e1 a7a6 a1c1 f8d8 a4b3 a8c8 a2a3 e7d6 b3a4 b6b5 a4b3 b5c4 b3c4 c8b8 c3a4 d7b6 a4b6 b8b6 d4d5 b6b2 d5e6 f7e6 e3d4 b2b7 f3g5 h5f7 g5e6 c7d7 e6d8 f7c4 e2c4 f6d5 d8b7 d7b7 c1b1 b7f7 g2g3 g8f8 b1b6 f7c7 b6a6 c7c8 g1g2 g7g5 a3a4 h7h5 a6a7 d5c7 d4e5 d6e5 e1e5 c8b8 a7a5 g5g4 h3g4 h5g4 e5e4 c7d5 c4d5 c6d5 a5d5 b8b7 d5f5 f8g7 f5g5 g7f6 g5g4 b7d5 g4h4 f6g7 g2g1 d5d1 g1h2 d1d8 e4e6 d8d2 " 'replayMoves = "e2e4 d7d5 e4d5 g8f6 d2d4 f6d5 c2c4 d5f6 g1f3 c8g4 f1e2 e7e6 d1b3 b7b6 b1c3 f8e7 c1e3 g4h5 b3b5 c7c6 b5a4 d8c7 e1g1 e8g8 h2h3 b8d7 f1e1 a7a6 a1c1 f8d8 a4b3 a8c8 a2a3 e7d6 b3a4 b6b5 a4b3 b5c4 b3c4 c8b8 c3a4 d7b6 a4b6 b8b6 d4d5 b6b2 d5e6 f7e6 e3d4 b2b7 f3g5 h5f7 g5e6 c7d7 e6d8 f7c4 e2c4 f6d5 d8b7 d7b7 c1b1 b7f7 g2g3 g8f8 b1b6 f7c7 b6a6 c7c8 g1g2 g7g5 a3a4 h7h5 a6a7 d5c7 d4e5 d6e5 e1e5 c8b8 a7a5 g5g4 h3g4 h5g4 e5e4 c7d5 c4d5 c6d5 a5d5 b8b7 d5f5 f8g7 f5g5 g7f6 g5g4 b7d5 g4h4 f6g7 g2g1 d5d1 g1h2 d1d8 e4e6 d8d2 h2g2 d2g5 h4e4 g5d5 e6e5 d5d3 e5e7 g7f8 a4a5 f8g8 e7e8 g8g7 e4e7 g7g6 a5a6 d3d5 e7e4 d5a2 e8e6 g6f7 e6e7 f7f6 e4e6 f6f5 a6a7 a2d5 e6e4 f5g6 e7e8 d5c6 a7a8q c6a8 e8a8 g6f5 a8a4 f5g6 a4a6 g6f7 e4b4 f7f8 b4b7 f8e8 " 'replayMoves = "e2e4 d7d5 e4d5 g8f6 d2d4 f6d5 " 'check for game stamp replayMoves = "" Open logFile.moves For Binary As #lgmov Input #lgmov, g gameStamp = Val(Mid(tl(2,2),7)) printCon("gameStamp ",gameStamp) If Val(g) = gameStamp Then Input #lgmov, replayMoves EndIf replayMoves += " " Close #lgmov If Len(replayMoves) = 1 Then 'no moves done yet in the last game flag.replay = 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 " count.game = 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).fileName = Mid(g,InStrRev(g," ") + 1) g = tl(1,x + 1) engine(2).fileName = Mid(g,InStrRev(g," ") + 1) If Frac(count.game/2) = 0 Then 'odd game number --> white = engine 1 Swap engine(1).fileName,engine(2).fileName EndIf 'result counters x = 0 Do x += 1 Loop Until Left(tl(1,x),10) = "total won " engine(1).win = Val(Mid(tl(1,x),InStrRev(tl(1,x)," ") + 1)) engine(2).win = Val(Mid(tl(1,x + 1),InStrRev(tl(1,x + 1)," ") + 1)) count.drawn = 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) printCon("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 " )")) engine(1).moveTime = moveTimePreset + moveTimeHandicap * (engine(2).win - engine(1).win) engine(2).moveTime = moveTimePreset + moveTimeHandicap * (engine(1).win - engine(2).win) Open logFile._time For Input As #lgtim Input #lgtim, stampCompare If stampCompare = gameStamp Then 'logged times belong to the actual game --> restore times Input #lgtim, engine(1).timePlayed Input #lgtim, engine(2).timePlayed printCon ("timePlayed 1 ",engine(1).timePlayed) printCon ("timePlayed 2 ",engine(2).timePlayed) Else 'new game --> reset clock engine(1).timePlayed = 0 engine(2).timePlayed = 0 EndIf Close #lgtim Case "depth" Case "gametime" gameTimePreset = Val(Left(g,InStr(g," ") - 1)) g = LTrim(Mid(g,InStr(g," "))) 'delete 1st item () g = Trim(g, Any "( )") 'delete brackets gameTimeHandicap = Val(g) 'set the game times with the actual handicap engine(1).gameTime = gameTimePreset + gameTimeHandicap * (engine(2).win - engine(1).win) engine(2).gameTime = gameTimePreset + gameTimeHandicap * (engine(1).win - engine(2).win) Open logFile._time For Input As #lgtim Input #lgtim, stampCompare If stampCompare = gameStamp Then 'logged times belong to the actual game --> restore times Input #lgtim, engine(1).timeLeft Input #lgtim, engine(2).timeLeft Else 'new game with full time amount engine(1).timeLeft = engine(1).gameTime * 1000 engine(2).timeLeft = engine(2).gameTime * 1000 EndIf Close #lgtim 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 **********" Open logFile.turnament For Input As #lgtur Do Line Input #lgtur, 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(lgtur) Else gamemax = x ReDim filepointer(x) filepointer(x) = Seek(lgtur) EndIf EndIf Loop Until EOF(lgtur) Locate 20,20,1 Print x Input "Game number ",gameNumber If gameNumber = gamemax Then flag.replay2 = 1 EndIf Seek #lgtur,filepointer(gameNumber) For x = 1 To 6 Line Input #lgtur, replayMoves Next 'printCon("*"&replayMoves) 'Sleep Line Input #lgtur, g g = Trim(g,"*") replayMoves += " " + g + " " 'printCon(replayMoves) 'Sleep flag.replay = 1 count.game = gameNumber Seek #lgtur,filepointer(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\*.exe", -1) Do printCon(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) printCon(Str(x),enginelist(x)) Next Do 'setup menu loop If jump = 0 Then Color cfont, cback Cls Locate 15,20 Print "********** S E T U P **********" mencol = 25 menlin = 20 jump = 1 EndIf keypressed = Inkey If mouseMenu(" 1 - Engine 1 (" + engine(1).fileName + ")","-",menlin,mencol,cfont,cback) = 9 Or _ keypressed = "1" Then '--- S U B M E N U --- Cls Locate 15,20 Print "********** S E T U P **********" Print Print Tab(29);"CHOOSE ENGINE 1" Do keypressed = Inkey For x = 1 To UBound(enginelist) If mouseMenu(Str(x) + " - " + enginelist(x),"-",19 + 2*x,25,cfont,cback) = 9 Or _ keypressed = Str(x) Then engine(1).fileName = enginelist(x) WritePrivateProfileString("","engine1",StrPtr(engine(1).fileName),StrPtr(iniFile)) jump = 0 Exit Do EndIf Next If mouseMenu("Esc - Return to setup menu","-",-4,25,cfont,cback) = 9 Or _ keypressed = Chr(27) Then jump = 0 Exit Do ElseIf keypressed = Chr(255,107) Then 'end program Shutdown EndIf Loop '---END SUBMENU--- ElseIf mouseMenu(" 2 - Engine 2 (" + engine(2).fileName + ")","-",menlin + 2,mencol,cfont,cback) = 9 Or _ keypressed = "2" Then '--- S U B M E N U --- Cls Locate 15,20 Print "********** S E T U P **********" Print Print Tab(29);"CHOOSE ENGINE 1" Do keypressed = Inkey For x = 1 To UBound(enginelist) If mouseMenu(Str(x) + " - " + enginelist(x),"-",19 + 2*x,25,cfont,cback) = 9 Or _ keypressed = Str(x) Then engine(2).fileName = enginelist(x) WritePrivateProfileString("","engine2",StrPtr(engine(2).fileName),StrPtr(iniFile)) jump = 0 Exit Do EndIf Next If mouseMenu("Esc - Return to setup menu","-",-4,25,cfont,cback) = 9 Or _ keypressed = Chr(27) Then jump = 0 Exit Do ElseIf keypressed = Chr(255,107) Then 'end program Shutdown EndIf Loop '---END SUBMENU--- ElseIf mouseMenu(" P - Playmode (" + playmode + ")","-",menlin + 4 ,mencol,cfont,cback) = 9 Or _ keypressed = "p" Then '--- S U B M E N U --- Cls Locate 15,20 Print "********** S E T U P **********" Print Print Tab(29);"PLAYMODE" Do keypressed = Inkey If mouseMenu(IIf(playmode = "movetime","----> M - Movetime "," M - Movetime "), _ " - ",20,25,cfont,cback) = 9 Or _ keypressed = "m" Then playmode = "movetime" WritePrivateProfileString("","playmode","movetime",StrPtr(iniFile)) ElseIf mouseMenu(" 1 - Movetime (" + Str(moveTimePreset) + " ms) ","-",-2,27,cfont,cback) = 9 Or _ keypressed = "1" Then View Print 40 To 40 Locate 40,20 Input "Movetime (ms): ",moveTimePreset WritePrivateProfileString("","moveTimePreset",Str(moveTimePreset),StrPtr(iniFile)) Cls View Print ElseIf mouseMenu(" 2 - Movetime Handicap (" + Str(moveTimeHandicap) + " ms) ","-",-2,27,cfont,cback) = 9 Or _ keypressed = "2" Then View Print 40 To 40 Locate 40,20 Input "movetime handicap(ms): ",moveTimeHandicap WritePrivateProfileString("","moveTimeHandicap",Str(moveTimeHandicap),StrPtr(iniFile)) Cls View Print ElseIf mouseMenu(IIf(playmode = "depth","----> D - Depth "," D - Depth "), _ " - ",-2,25,cfont,cback) = 9 Or _ keypressed = "d" Then playmode = "depth" WritePrivateProfileString("","playmode","depth",StrPtr(iniFile)) ElseIf mouseMenu(" 3 - Depth (" + Str(depthPreset) + ") ","-",-2,27,cfont,cback) = 9 Or _ keypressed = "3" Then View Print 40 To 40 Locate 40,20 Input "depth: ",depthPreset WritePrivateProfileString("","depthPreset",Str(depthPreset),StrPtr(iniFile)) Cls View Print ElseIf mouseMenu(" 4 - Depth Handicap (" + Str(depthHandicap) + ") ","-",-2,27,cfont,cback) = 9 Or _ keypressed = "4" Then View Print 40 To 40 Locate 40,20 Input "depth handicap: ",depthHandicap WritePrivateProfileString("","depthHandicap",Str(depthHandicap),StrPtr(iniFile)) Cls View Print ElseIf mouseMenu(IIf(playmode = "gametime","----> T - Gametime "," T - Gametime ") _ ," - ",-2,25,cfont,cback) = 9 Or _ keypressed = "t" Then playmode = "gametime" WritePrivateProfileString("","playmode","gametime",StrPtr(iniFile)) ElseIf mouseMenu(" 5 - Gametime (" + Str(gameTimePreset) + " s) ","-",-2,27,cfont,cback) = 9 Or _ keypressed = "5" Then View Print 40 To 40 Locate 40,20 Input "gametime (seconds): ",gameTimePreset WritePrivateProfileString("","gameTimePreset",Str(gameTimePreset),StrPtr(iniFile)) Cls View Print ElseIf mouseMenu(" 6 - Gametime Handicap (" + Str(gameTimeHandicap) + " s) ","-",-2,27,cfont,cback) = 9 Or _ keypressed = "6" Then View Print 40 To 40 Locate 40,20 Input "gametime handicap(seconds): ",gameTimeHandicap WritePrivateProfileString("","gameTimeHandicap",Str(gameTimeHandicap),StrPtr(iniFile)) Cls View Print ElseIf mouseMenu(" Esc - Return to setup menu ","-",-2,25,cfont,cback) = 9 Or _ keypressed = Chr(27) Then jump = 0 Exit Do ElseIf keypressed = Chr(255,107) Then 'end program Shutdown EndIf Color cfont,cback Loop '---END SUBMENU--- ElseIf mouseMenu(" Esc - Return to main menu ","-",-4,mencol,cfont,cback) = 9 Or _ keypressed = Chr(27) Then Exit Do ElseIf keypressed = Chr(255,107) Then Shutdown EndIf 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 'check for keyboard or mouse input while running Dim As FB.EVENT se Dim As String mousecol, mouserow, legalMoves, sourceField, destinationField, move Dim As String*8 colString, rowString Dim As Integer mx, my, mw, mb, pause, cf, cb, key, x, choice, piece, sourceIsLegal, _ mencol, menlin Dim As boardImagePointers ip Dim As chessmove cm Dim As Any Ptr boardHaze Static As Double repeatLock Static As Integer mouselock 'printCon(InKey,"") key = 0 If ScreenEvent(@se) Then If se.type = FB.EVENT_KEY_PRESS Or (se.type = FB.EVENT_KEY_REPEAT And Timer > repeatlock) Then key = se.scancode Select Case key Case FB.SC_MINUS, FB.SC_PLUS repeatLock = Timer + .2 Case Else repeatLock = Timer + .5 End Select EndIf EndIf If mouseMenu(" B - Back to main menu ","-",61,52,cfont,cback,2) = 9 Or _ key = FB.SC_B Then flag.break = 1 ElseIf mouseMenu(" F - Flip board ","-",-2,52,cfont,cback,2) = 9 Or _ key = FB.SC_F Then flag.flipBoard = IIf(flag.flipBoard,0,1) makeBoardImage updateScreen ElseIf mouseMenu(" P - Pause / Setup ","-",-2,52,cfont,cback,2) = 9 Or _ key = FB.SC_P Then pause = IIf(pause,0,1) 'toggle pause flag updateScreenHaze '--- P A U S E M E N U --- mencol = 25 menlin = 15 Do While pause cf = IIf(Frac(Timer) > .5,cfont,cback) 'flash item text cb = IIf(cf = cfont,cback,cfont) key = 0 If ScreenEvent(@se) Then If se.type = FB.EVENT_KEY_PRESS Then 'And se.scancode = FB.SC_P Then key = se.scancode EndIf EndIf If mouseMenu(" P - Pause / Setup ","-",65,52,cf,cb,2) = 9 Or _ key = FB.SC_P Then pause = 0 updateScreen ElseIf mouseMenu(" 1 - setup engine 1 options ","-",15,mencol,cfont,cback,2) = 9 Or _ key = FB.SC_1 Then setupEngine(engine(1).fileName,1) flag.setEngineOptions = 1 updateScreenHaze ElseIf mouseMenu(" 2 - setup engine 2 options ","-",-2,mencol,cfont,cback,2) = 9 Or _ key = FB.SC_2 Then setupEngine(engine(2).fileName,2) flag.setEngineOptions = 1 updateScreenHaze ElseIf mouseMenu(IIf(flag.internalBoard," I - Show internal board = ON ", _ " I - Show internal board = OFF "),"-",-2,mencol,cfont,cback,2) = 9 Or _ key = FB.SC_I Then flag.internalBoard = IIf(flag.internalBoard,0,1) 'toogle internal board on/off WritePrivateProfileString("","showInternalBoard",Str(flag.internalBoard),StrPtr(iniFile)) updateScreenHaze 'Put (boardPosition.x,boardPosition.y),boardHaze,Alpha,128 ElseIf mouseMenu(IIf(flag.testForLegal," L - Test move for legal = ON ", _ " L - Test move for legal = OFF "),"-",-2,mencol,cfont,cback,2) = 9 Or _ key = FB.SC_L Then If flag.testForLegal Then flag.testForLegal = 0 Dim As String order = GetLegalMoves("close") Else flag.testForLegal = 1 EndIf WritePrivateProfileString("","testForLegal",Str(flag.testForLegal),StrPtr(iniFile)) ElseIf mouseMenu(IIf(flag.animation And 1," A - Animation = ON ", _ " A - Animation = OFF "),"-",-2,mencol,cfont,cback,2) = 9 Or _ key = FB.SC_A Then flag.animation = IIf(flag.animation And 1,0,1) 'toogle animation on/off WritePrivateProfileString("","animation",Str(flag.animation),StrPtr(iniFile)) ElseIf mouseMenu(" D - Move delay (" + Str(moveDelay) + " ms) ","-",-2,mencol,cfont,cback,2) = 9 Or _ key = FB.SC_D Then 'set new delay value View Print menlin + 10 To menlin + 10 Cls Locate menlin + 10,mencol While InKey <> "" :Wend 'flush keyboard buffer Input "move delay (ms): ",moveDelay WritePrivateProfileString("","moveDelay",Str(moveDelay),StrPtr(iniFile)) Cls View Print updateScreenHaze ElseIf mouseMenu(" G - Delay between games (" + Str(gameDelay) + " ms) ","-",-2,mencol,cfont,cback,2) = 9 Or _ key = FB.SC_G Then 'set new delay value View Print menlin + 12 To menlin + 12 Cls Locate menlin + 12,mencol While InKey <> "" :Wend 'flush keyboard buffer Input "game delay (ms): ",gameDelay WritePrivateProfileString("","gamedelay",Str(gameDelay),StrPtr(iniFile)) Cls View Print updateScreenHaze EndIf Sleep 1 Loop ElseIf se.type = FB.EVENT_WINDOW_CLOSE Then Shutdown EndIf If flag.animation And 1 Then Locate 67,54 Print "animation speed" If mouseMenu(" + ",,-2,70,cfont,cback,2) = 9 Or _ key = FB.SC_PLUS Then 'minus-key --> decrease animation speed If animationSpeed > 0 Then 'don't let animation speed become negative animationSpeed -= 1 WritePrivateProfileString("","animationSpeed",Str(animationSpeed),StrPtr(iniFile)) EndIf updateScreen ElseIf mouseMenu(" - ",,0,50,cfont,cback,2) = 9 Or _ key = FB.SC_MINUS Then 'plus-key --> increase animation speed animationSpeed += 1 WritePrivateProfileString("","animationSpeed",Str(animationSpeed),StrPtr(iniFile)) updateScreen 'EndIf EndIf EndIf Color cfont,cback 'For x As Integer = 0 To 255 ' If MultiKey(x) Then ' printCon(x) ' EndIf 'Next 'printCon("opponent ",opponent) If flag.human And flag.ready Then 'human interface active --> chose field by mouseclick If se.type = FB.EVENT_MOUSE_BUTTON_PRESS And se.button = FB.BUTTON_LEFT Then 'printCon("mouse") makeBoardImage updateScreen sourceField = GetMouseField 'determine pickup field under mouse cursor legalMoves = GetLegalMoves(makeFen) 'printCon("",legalMoves) 'printCon("",Mid(legalMoves,2,1)) sourceIsLegal = 0 x = 2 'pointer to legalMoves string Do If Mid(legalMoves,x,2) = sourceField Then 'at least 1 legal source field sourceIsLegal = 1 Exit Do EndIf x += 5 Loop Until x > Len(legalMoves) 'printCon(IIf(sourceIsLegal = 1,sourceField + " drin",sourceField + " draussen")) If sourceIsLegal Then saveBoard cm = strMoveToNumMove(sourceField + "a1") cm.y1 = 10 - cm.y1 'set correct line of internal board cm.x1 += 2 'set correct column of internal board 'printCon("numCoord " + Str(cm.x1),Str(cm.y1)) choice = board(cm.x1,cm.y1) 'printCon("choice ",choice) piece = IIf(choice < 0, Abs(choice) - 1,choice + 5) 'convert internal piece number to image ID board(cm.x1,cm.y1) = 0 'clear source field makeBoardImage 'board image without the selected piece Do 'draging the selected piece with the mouse ScreenLock updateScreen GetMouse(mx,my,mw,mb) Put (mx - fieldSize/2 ,my - fieldSize/2),iPiece(piece),Trans ScreenUnLock Sleep 1 Loop Until mb = 0 'mouse button release 'printCon("release") destinationField = GetMouseField 'printCon("release ",destinationField) move = sourceField + destinationField 'printCon(move) If sourceField = destinationField Then 'mark all possible moves printCon("sourceField = destinationField ",sourceField) restoreBoard makeBoardImage ip = SetBoardImagePointers(strMoveToNumMove(move)) Put boardImage,(ip.pxs,ip.pys),srcFrame,Trans 'frame source field x = 2 'pointer to legalMoves string Do 'frame all possible destination fields If Mid(legalMoves,x,2) = sourceField Then 'legal ip = SetBoardImagePointers(strMoveToNumMove(Mid(legalMoves,x,4))) Put boardImage,(ip.pxd,ip.pyd),dstFrame,Trans EndIf x += 5 Loop Until x > Len(legalMoves) updateScreen Else 'source field and destination field are different If InStr(legalMoves,move) Then restoreBoard flag.animation = BitSet(flag.animation,1) 'no animation for this move WriteEngineInfo(opponent,"field " + sourceField) Sleep 1 WriteEngineInfo(opponent,"field " + destinationField) Else restoreBoard makeBoardImage updateScreen move = "" EndIf 'legal move EndIf 'source = destination EndIf 'source is legal EndIf 'left button pressed EndIf 'flag.human End Sub Sub GetEngineOptions(engine As String) Dim As Integer iNumberOfBytesWritten, iTotalBytesAvail, iBytesToRead, x, y, begPtr, endPtr Dim As String order, g Dim As Any Ptr pipeOptions ReDim As String responseString(1) ReDim engineOptions(5,1) 'pipeOptions = bipopen(ExePath + "\engines\" + engine,SW_HIDE) pipeOptions = bipOpen(ExePath + "\engines\" + engine,SW_MINIMIZE) order = "uci" + Chr(10) bipWrite(pipeOptions, order,"b") g = "" Do x += 1 ReDim Preserve responseString(x) 'enlarge array responseString(x) = bipReadLine(pipeOptions) If responseString(x) = "uciok" Then ReDim Preserve responseString(x - 1) Exit Do EndIf If InStr(responseString(x),"option name ")Then y += 1 'count option strings EndIf Loop bipClose(pipeOptions) 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 'sleep 'bipclose(pipeOptions) 'TerminateProcess(hProcessHandle, 0) 'CloseHandle(hWritePipe) 'CloseHandle(hReadPipe) '?"############" 'sleep 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, cf, cb, mm, mmm Dim As String menutext, g, engineName, opp, mt GetMouse(mx,my,wheel,mb) 'initialize 'wheel' engineName = 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 mt = " " 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 GetMouse(mx,my,mw,mb) For x = 1 To xmax 'scan options of the selected page o = (page - 1) * pagelen + x GetPrivateProfileString(engineName,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 menutext += " " Select Case mouseMenu(menutext,"=",menlin + 2 * x ,mencol,cfont,cback) Case 8 'cursor is touching item (without any button pressed) If wheel <> mw Then Select Case engineOptions(otype,o) 'option type Case "spin" 'change value with mouse wheel y = Val(iniBuffer) y -= wheel - mw Select Case y Case Val(engineOptions(omin,o)) To Val(engineOptions(omax,o)) iniBuffer = Str(y) End Select End Select If iniBuffer = engineOptions(odefault,o) Then 'remove .ini file entry --> set option to default WritePrivateProfileString(engineName,engineOptions(oname,o),0,StrPtr(iniFile)) Else 'write value to .ini file WritePrivateProfileString(engineName,engineOptions(oname,o),StrPtr(iniBuffer),StrPtr(iniFile)) EndIf EndIf Case 9 'left click --> normal operation Select Case engineOptions(otype,o) 'option type Case "check" 'toggle value iniBuffer = IIf(iniBuffer = "true","false","true") Case "spin" Locate menlin + 2 * x ,mencol + 2 Print String(Len(iniBuffer) + 3," ") Locate menlin + 2 * x ,mencol + 3 Input "",g If g <> "" Then Select Case Val(g) Case Val(engineOptions(omin,o)) To Val(engineOptions(omax,o)) iniBuffer = g End Select 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 printCon("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 If iniBuffer = engineOptions(odefault,o) Then 'remove .ini file entry --> set option to default WritePrivateProfileString(engineName,engineOptions(oname,o),0,StrPtr(iniFile)) Else 'write value to .ini file WritePrivateProfileString(engineName,engineOptions(oname,o),StrPtr(iniBuffer),StrPtr(iniFile)) EndIf Case 10 'right click --> set to default WritePrivateProfileString(engineName,engineOptions(oname,o),0,StrPtr(iniFile)) setDefaultFlag = 0 Color cfont,cback View Print menlin + 43 To menlin + 48 Cls 2 View Print End Select Next cf = IIf(Frac(Timer) > .5,cfont,cback) 'flash item text cb = IIf(cf = cfont,cback,cfont) Select Case setDefaultFlag Case 0 If mouseMenu("Set ALL values to default",,menlin + 44,mencol - 15,cfont,cback) = 9 Then 'delete engine section from .ini file setDefaultFlag = 1 Color cfont,cback View Print menlin + 44 To menlin + 48 Cls 2 View Print ElseIf mouseMenu("Exit",,menlin + 46,mencol - 15,cfont,cback) = 9 Then 'exit engine options setup Return EndIf Case 1 Locate menlin + 44,mencol - 15 Color cf,cb Print " are you sure? " Color cfont,cback If mouseMenu(" YES ","",menlin + 44,mencol + 3,cfont,cback,2) = 9 Then 'printCon("engine ",engineName) WritePrivateProfileString(engineName,0,0,StrPtr(iniFile)) setDefaultFlag = 0 Color cfont,cback View Print menlin + 43 To menlin + 48 Cls 2 View Print ElseIf mouseMenu(" NO - cancel ",,menlin + 44,mencol + 10,cfont,cback,2) = 9 Then 'cancel --> don't reset values setDefaultFlag = 0 Color cfont,cback View Print menlin + 43 To menlin + 48 Cls 2 View Print EndIf End Select Color cfont,cback wheel = mw Loop Color cfont,cback Loop Loop End Sub Sub setEngineOptions(opp As String) Dim As Integer x, ff Dim As String engineName, g, optionName, optionValue Select Case opp Case w engineName = engine(currentWhite).fileName + " as " + Str(currentWhite) Case b engineName = engine(currentBlack).fileName + " 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 = "[" + engineName + "]") Or (EOF(ff)) If EOF(ff) Then 'section not found --> set all options to default Close ff 'printCon("vor getoptions") GetEngineOptions(IIf(opp = w,engine(currentWhite).fileName,engine(currentBlack).fileName)) 'printCon("setoptions") For x = 1 To UBound(engineOptions,2) WriteEngineInfo(opp,"setoption name " + engineOptions(oname,x) + _ " value " + engineOptions(odefault,x)) 'send option to engine Next 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 optionName = Left(g,x - 1) optionValue = Mid(g,x + 1) WriteEngineInfo(opp,"isready") Do 'wait until engine is listening Loop Until InStr(GetEngineResponse(opp),"readyok") WriteEngineInfo(opp,"setoption name " + optionName + " value " + optionValue) 'send option to engine EndIf EndIf Loop Until EOF(ff) Close ff End Sub Function GetLegalMoves(fen As String) As String 'use the pseudo - engine 'human.exe' to get a list of all legal moves Static As bipdata Ptr pipeLegal = 0 'keep pointer until engine becomes closed Dim As String order, g, sBuf If pipeLegal = 0 Then pipeLegal = bipOpen(ExePath + "\engines\human2.exe",SW_MINIMIZE) EndIf If fen = "close" Or fen = "" Then 'close engine and pipes bipWrite(pipeLegal,"quit" + Chr(10),"b") bipClose(pipeLegal) Return "" EndIf order = "position fen " + fen + " legal" + Chr(10) '? order bipWrite(pipeLegal,order,"b") printCon("LEGAL " & order) g = "" Do g += bipReadLine(pipeLegal) Loop Until InStr(g,"uciok") Return Left(g,InStr(g,"uciok") - 2) 'list of legal moves End Function Sub makeBoardImage'(bImage As FB.Image Ptr) 'If (bImage = 0) Or (bImage = boardTemplate) Then ' Return 'no valid pointer 'EndIf Put boardImage,(0,0),boardTemplate,PSet 'draw pieces 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 If flag.flipBoard Then 'board fliped Put boardImage,((7 - x) * fieldSize, (7 - y) * fieldSize), _ iPiece(Abs(board(x+2,y+2)) + IIf(board(x+2,y+2) < 0,-1,5)),Trans Else 'board normal Put boardImage,(x * fieldSize, y * fieldSize), _ iPiece(Abs(board(x+2,y+2)) + IIf(board(x+2,y+2) < 0,-1,5)),Trans 'black piece_____| | 'white piece_______| EndIf End If Next x Next y End Sub Function SetBoardImagePointers(cm As chessMove) As boardImagePointers Dim As boardImagePointers ip cm.y1 = 8 - cm.y1 'set correct line of internal board cm.y2 = 8 - cm.y2 If flag.flipBoard Then 'board image pointers to source and destination fields ip.pxs = 7 * fieldSize - cm.x1 * fieldSize ip.pys = 7 * fieldSize - cm.y1 * fieldSize ip.pxd = 7 * fieldSize - cm.x2 * fieldSize ip.pyd = 7 * fieldSize - cm.y2 * fieldSize Else 'board not flipped ip.pxs = cm.x1 * fieldSize ip.pys = cm.y1 * fieldSize ip.pxd = cm.x2 * fieldSize ip.pyd = cm.y2 * fieldSize EndIf Return ip End Function Function GetMouseField() As String Dim As String colString, rowString, mousecol, mouserow Dim As Integer mx, my, mw, mb GetMouse(mx,my,mw,mb) If flag.flipBoard Then colString = "hgfedcba" rowString = "12345678" Else colString = "abcdefgh" rowString = "87654321" EndIf mousecol = Mid(colString,Fix((mx - boardPosition.x)/fieldSize) + 1,1) mouserow = Mid(rowString,Fix((my - boardPosition.y)/fieldSize) + 1,1) Return mousecol + mouserow End Function Sub Shutdown Close CloseEngines ImageDestroy(boardImage) ImageDestroy(boardTemplate) ImageDestroy(srcFrame) ImageDestroy(dstFrame) For i As Integer = 0 To 11 ImageDestroy(iPiece(i)) Next End End Sub Sub updateScreenHaze Dim As Integer imgSizeX, imgSizeY Dim As Any Ptr boardHaze ImageInfo boardImage, imgSizeX, imgSizeY boardHaze = ImageCreate(imgSizeX, imgSizeY, cback) updateScreen Put (boardPosition.x,boardPosition.y),boardHaze,Alpha,180 ImageDestroy(boardHaze) End Sub Sub printInfo Locate 69,2 Print infoString(0) Print For x As Integer = 1 To UBound(infoKeyword) If infoKeyword(x) = "string" Then Locate 87,1 Print String(15 - Len(infoKeyword(x))," ");infoKeyword(x);" ";infoString(x) Next 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 ".........................................."