'******************************************************************************************* ' This "dummy chess engine" is meant to be used as human interface with the "Colochessum" ' engine vs. engine chess GUI. Please compile this source code with "fbc -s console", rename ' the compiled program "human.exe" and place it in the "engines" folder of Colochessum. ' Then you can play against any engine Colochessum can handle. '******************************************************************************************* #Include Once "windows.bi" #Include "fbgfx.bi" #Include "vbcompat.bi" Const As String w = "white", b = "black" Randomize Timer Type direction col As Integer row As Integer End Type Dim Shared As direction north, northeast, east, southeast, south, southwest, west, northwest, _ knightpattern(8) 'set direction offsets north.col = 0 north.row = -1 northeast.col = 1 northeast.row = -1 east.col = 1 east.row = 0 southeast.col = 1 southeast.row = 1 south.col = 0 south.row = 1 southwest.col = -1 southwest.row = 1 west.col = -1 west.row = 0 northwest.col = -1 northwest.row = -1 'set knight movement pattern Restore kpat For x As Integer = 1 To 8 Read knightpattern(x).col Read knightpattern(x).row Next kpat: Data -1,-2, 1,-2, 2,-1, 2,1, 1,2, -1,2, -2,1, -2,-1 Dim Shared As HANDLE hReadChildPipe, hWriteChildPipe, hReadPipe, hWritePipe, hWndThisWindow Dim Shared As Integer board(12,12), sBoard(12,12) ReDim Shared As String legalMove(16 * 63) Dim Shared As String fenBoard, fenOpponent, fenCastling, fenEnPassant, fenHalfmoves, _ fenMoves, opponent, castlingFlag, currentFen Dim Shared As Integer count50, moveCount, legalMoveCount, mx, my, mw, mb Dim As STARTUPINFO si Dim As PROCESS_INFORMATION pi Dim As SECURITY_ATTRIBUTES sa Dim As OVERLAPPED ol Dim As Integer iTotalBytesAvail, iNumberOfBytesWritten, iBytesToRead, x, y Dim As String sRet = "", sBuf, g, fieldfrom, fieldto, mousefield Declare Sub fenToBoard(fen As String) Declare Sub parseFen(fen As String) Declare Sub showInternalBoard() Declare Function StringNextItem(text As String = "") As String Declare Sub setMove(move As String, opp As String = "") Declare Function testForCheck(opp As String) As Integer Declare Sub saveBoard Declare Sub restoreBoard Declare Sub legalMoves(opp As String) Declare Function iMove(colfrom As Integer, rowfrom As Integer, colto As Integer, rowto As Integer) As String Declare Sub explore(col As Integer, row As Integer, d As direction, opp As String, kingflag As Integer = 0) Declare Function deleteFromString(text As String, del As String) As String Do Input g 'get message from GUI Do Select Case StringNextItem(g) '1st item Case "uci" 'send startup message to GUI Print "id name Colochessum human interface" Print "author grindstone" Print "version 0.1 2014 Print "uciok" Exit Do Case "debug" Select Case StringNextItem() '2nd item Case"on" Case "off" End Select Case "isready" Print "readyok" Case "setoption" Select Case StringNextItem() '2nd item Case "name" End Select Case "ucinewgame" Case "position" Select Case StringNextItem() '2nd item Case "startpos" currentFen = "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1" 'startposition fenToBoard(currentFen) Print "startpos OK" Case "fen" currentFen = StringNextItem() 'board setup currentFen += " " + StringNextItem() 'opponent currentFen += " " + StringNextItem() 'castling flag currentFen += " " + StringNextItem() 'en passant currentFen += " " + StringNextItem() 'halfmove counter currentFen += " " + StringNextItem() 'move counter fenToBoard(currentFen) Case Else 'error End Select Select Case StringNextItem() '3rd item Case "moves" g = StringNextItem() 'showInternalBoard Do While Len(g) 'do moves If opponent = w Then 'toggle opponent opponent = b Else opponent = w EndIf setMove(g) 'showInternalBoard g = StringNextItem() 'get next move Loop Exit Do End Select Case "go" '1st item Select Case StringNextItem() '2nd item Case "searchmoves" Case "ponder" Case "wtime" Case "btime" Case "winc" Case "binc" Case "movestogo" Case "depth" Case "nodes" Case "mate" Case "movetime" Print "movetime OK" Case "infinite" End Select 'wait for human input legalMoves(opponent) If legalMoveCount Then 'manual move input Do 'mouse input loop Input g 'get clicked field from GUI Select Case StringNextItem(g) Case "field" mousefield = StringNextItem() 'field coordinates If fieldfrom = "" Then 'no source field selected yet For x = 1 To legalMoveCount If Left(legalMove(x),2) = mousefield Then 'at least one legal move fieldfrom = mousefield Print "fieldset " + fieldfrom 'send source field to GUI Exit Select EndIf Next ElseIf mousefield = fieldfrom Then 'source filed already selected --> deselect source field fieldfrom = "" Print "fieldreset" 'send reset command to GUI Else fieldto = mousefield 'destination field For x = 1 To legalMoveCount 'check if choosen move is legal If legalMove(x) = fieldfrom + fieldto Then Print "bestmove " + fieldfrom + fieldto + " ponder (none)" 'send move message to GUI fieldfrom = "" 'reset field variables mousefield = "" Exit Do EndIf Next EndIf End Select Loop Else 'no legal moves --> mate Print "bestmove (mate) ponder (none)" 'send mate message to GUI EndIf Case "stop" Case "ponderhit" Case "quit" End Select Loop Until 1 'always leave the loop Sleep 1 Loop Sub fenToBoard(fen As String) Dim As Integer x, y, i, row, col Dim As String opp, g 'preset board For col = 0 To 11 For row = 0 To 11 board(col,row) = 7 'border Next Next row = 2 col = 1 parseFen(fen) 'setup board For x = 1 To InStr(fen," ") - 1 Select Case Mid(fen,x,1) Case "1" To "8" 'empty field(s) i = Val(Mid(fen,x,1)) For y = 1 To i board(col + y, row) = 0 'empty field Next col += i Case "/" 'next row row += 1 col = 1 Case Else col += 1 'next column board(col,row) = InStr("PRNBQKprnbqk",Mid(fen,x,1)) 'put piece to field If board(col,row) > 6 Then 'black piece board(col,row) = -1 * (board(col,row) - 6) 'convert sign EndIf End Select Next If fenOpponent = "w" Then opponent = w Else opponent = b EndIf castlingFlag = fenCastling count50 = ValInt(fenHalfmoves) moveCount = ValInt(fenMoves) 'Open ExePath + "\hdmoves.txt" For Output As #1 ' Print #1, " " ' For i1 As Integer = 0 To 12 ' For i2 As Integer = 0 To 12 ' Print #1, board(i2,i1); ' Next ' Print #1, "" ' Next ' Close #1 End Sub Sub parseFen(fen As String) Dim As Integer ptr1, ptr2 ptr1 = InStr(fen," ") fenBoard = Left(fen,ptr1 - 1) ptr2 = InStr(ptr1 + 1,fen," ") fenOpponent = Mid(fen,ptr1 + 1,ptr2 - ptr1 - 1) ptr1 = InStr(ptr2 + 1,fen," ") fenCastling = Mid(fen,ptr2 + 1,ptr1 - ptr2 - 1) ptr2 = InStr(ptr1 + 1,fen," ") fenEnPassant = Mid(fen,ptr1 + 1,ptr2 - ptr1 - 1) ptr1 = InStr(ptr2 + 1,fen," ") fenHalfmoves = Mid(fen,ptr2 + 1,ptr1 - ptr2 - 1) fenMoves = Mid(fen,ptr1 + 1) End Sub Sub showInternalBoard() Dim As Integer col, row, breit, hoch ScreenRes 300,300,32 Sleep 100 ScreenInfo breit, hoch Sleep 100 Width breit\8, hoch\16 Sleep 100 ShowWindow(hWndThisWindow,SW_SHOW) Print " 2 3 4 5 6 7 8 9" For row = 2 To 9 'row Print 10-row;"|"; For col = 2 To 9 'column If board(col,row) < 0 Then Print " ";Mid(".prnbqk",Abs(board(col,row))+1,1); Else Print " ";Mid(".PRNBQK",board(col,row)+1,1); EndIf Next Print "|";row Next Print " A B C D E F G H" Do Sleep 100 Loop Until (Inkey = "c") Screen 0 ShowWindow(hWndThisWindow,SW_MINIMIZE) End Sub Function StringNextItem(text As String = "") As String Static As Integer begptr, endptr Static As String strRem, g If Len(text) Then strRem = text + " " begptr = 1 endptr = 1 EndIf endptr = InStr(begptr,strRem," ") If endptr = 0 Then Return "" EndIf g = Mid(strRem,begptr, endptr - begptr) begptr = endptr + 1 Return g End Function Function iMove(colfrom As Integer, rowfrom As Integer, colto As Integer, rowto As Integer) As String 'translate internal format to move Return Mid(" abcdefgh",colfrom,1) + Str(10 - rowfrom) + _ Mid(" abcdefgh",colto,1) + Str(10 - rowto) End Function Sub setMove(move As String, opp As String = "") Dim As Integer rowfrom, rowto, colfrom, colto, x Dim As String promote Static As String enPassant If Len(move) = 5 Then promote = Right(move,1) move = Left(move,4) ElseIf Len(move) <> 4 Then Return EndIf 'translate move to internal format colfrom = Asc(Mid(move,1,1)) - Asc("a") + 2 rowfrom = 10 - Val(Mid(move,2,1)) colto = Asc(Mid(move,3,1)) - Asc("a") + 2 rowto = 10 - Val(Mid(move,4,1)) board(colto,rowto) = board(colfrom,rowfrom) board(colfrom,rowfrom) = 0 If opp <> "" Then If fenEnPassant = "-" Then enPassant = "" Else enPassant = fenEnPassant EndIf EndIf 'castling If (move = "e1g1") And board(colto,rowto) = 6 Then setMove("h1f1") ElseIf (move = "e1c1") And board(colto,rowto) = 6 Then setMove("a1d1") ElseIf (move = "e8g8") And board(colto,rowto) = -6 Then setMove("h8f8") ElseIf (move = "e8c8") And board(colto,rowto) = -6 Then setMove("a8d8") EndIf 'update castlig flag If opp = "" Then 'normal play Select Case Left(move,2) Case "a1" 'left white rook fenCastling = deleteFromString(fenCastling,"Q") Case "h1" 'right white rook fenCastling = deleteFromString(fenCastling,"K") Case "e1" 'white king fenCastling = deleteFromString(fenCastling,"QK") Case "a8" 'left black rook fenCastling = deleteFromString(fenCastling,"q") Case "h8" 'right black rook fenCastling = deleteFromString(fenCastling,"k") Case "e8" 'black king fenCastling = deleteFromString(fenCastling,"qk") End Select EndIf 'en passant If (Abs(board(colto,rowto)) = 1) And (colto <> colfrom) And (Mid(move,3,2) = enPassant) Then Select Case Right(enPassant,1) 'remove captured pawn Case "3" board(colto,rowto - 1) = 0 'remove white pawn Case "6" board(colto,rowto + 1) = 0 'remove black pawn End Select EndIf If (Abs(board(colto,rowto)) = 1) And (Abs(rowfrom - rowto) = 2) Then 'en passant enPassant = Mid(move,3,1) Select Case Mid(move,4,1) Case "4" enPassant += "3" Case "5" enPassant += "6" End Select Else If opp = "" Then enPassant = "" EndIf EndIf 'pawn promotion Select Case promote 'promote pawn to... Case "q" board(colto,rowto) *= 5 'queen Case "b" board(colto,rowto) *= 4 'bishop Case "n" board(colto,rowto) *= 3 'knight Case "r" board(colto,rowto) *= 2 'rook End Select If opp <> "" Then If testForCheck(opp) = 0 Then legalMoveCount += 1 legalMove(legalMoveCount) = move EndIf restoreBoard EndIf End Sub Function testForCheck(opp As String) As Integer Dim As Integer x, col, row, drow, dcol, kingrow, kingcol, kingsig 'set Sgn of the king If opp = w Then kingsig = 1 Else kingsig = -1 EndIf 'get the internal coordinates of the king For row = 2 To 9 For col = 2 To 9 If board(col,row) = kingsig * 6 Then 'king found kingrow = row kingcol = col Exit For,For 'terminate searching EndIf Next Next 'let the king look around For dcol = -1 To 1 'left -> rest -> right For drow = -1 To 1 'up -> rest -> down col = kingcol 'start at king coordinates row = kingrow Do 'look along the desired direction col += dcol 'next field row += drow If board(col,row) Then 'field not empty If (board(col,row) = 7) Or (Sgn(board(col,row)) = kingsig) Then 'border or piece of own colour Exit Do 'next direction EndIf Select Case Abs(board(col,row)) 'kind of piece Case 1 'pawn If (Abs(kingcol - col) = 1) And ((kingrow - row) = kingsig) Then 'check by pawn Return 1 Else Exit Do 'next direction EndIf Case 2 'rook If (dcol = 0) Or (drow = 0) Then 'king is looking straight Return 1 EndIf Case 4 'bishop If (dcol <> 0) And (drow <> 0) Then 'king is looking diagonal Return 1 EndIf Case 5 'queen Return 1 Case 6 'king If (Abs(kingcol - col) < 2) Or (Abs(kingrow - row) < 2) Then Return 1 EndIf End Select EndIf Loop Next Next Restore knightCheck For x = 1 To 8 Read dcol, drow If board(kingcol + dcol, kingrow + drow) = kingsig * -3 Then 'knight Return 1 EndIf Next Return 0 'no check End Function knightCheck: Data -1,-2, 1,-2, 2,-1, 2,1, 1,2, -1,2, -2,1, -2,-1 Sub saveBoard Dim As Integer col, row For row = 0 To 12 For col = 0 To 12 sBoard(col,row) = board(col,row) Next Next End Sub Sub restoreBoard Dim As Integer col, row For row = 0 To 12 For col = 0 To 12 Board(col,row) = sBoard(col,row) Next Next End Sub Sub legalMoves(opp As String) Dim As Integer col, row, mcol, mrow, dcol, drow, oppsig, piece, x, epcol, eprow saveBoard ReDim legalMove(16 * 63) legalMoveCount = 0 'set Sgn of the opponent If opp = w Then oppsig = 1 Else oppsig = -1 EndIf 'translate en passant sign If fenEnPassant <> "-" Then epcol = Asc(Mid(fenEnPassant,1,1)) - Asc("a") + 2 eprow = 10 - Val(Mid(fenEnPassant,2,1)) EndIf For row = 2 To 9 'all rows For col = 2 To 9 'all columns If Sgn(board(col,row)) = oppsig Then 'own piece Select Case Abs(board(col,row)) 'kind of piece Case 1 'pawn mcol = col mrow = row - oppsig If board(col,mrow) = 0 Then 'move setMove(iMove(col,row,mcol,mrow),opp) 'test EndIf Select Case opp Case w If row = 8 Then 'base line If (board(col,7) = 0) And (board(col,6) = 0) Then setMove(iMove(col,8,col,6),opp) EndIf EndIf Case b If row = 3 Then 'base line If (board(col,4) = 0) And (board(col,5) = 0) Then setMove(iMove(col,3,col,5),opp) EndIf EndIf End Select mrow = row - oppsig mcol = col + 1 'capture right piece = board(mcol,mrow) If ((piece <> 0) Or ((epcol = mcol) And (eprow = mrow))) And (Sgn(piece) <> oppsig) And (piece <> 7) Then 'field not empty \________ en passant _________/ \_not an own piece_/ not border setMove(iMove(col,row,mcol,mrow),opp) EndIf mcol = col - 1 'capture left piece = board(mcol,mrow) If ((piece <> 0) Or ((epcol = mcol) And (eprow = mrow))) And (Sgn(piece) <> oppsig) And (piece <> 7) Then setMove(iMove(col,row,mcol,mrow),opp) EndIf Case 2 'rook explore(col,row,north,opp) explore(col,row,east,opp) explore(col,row,south,opp) explore(col,row,west,opp) Case 3 'knight For x = 1 To 8 mcol = col + knightpattern(x).col mrow = row + knightpattern(x).row piece = board(mcol,mrow) If (piece <> 7) And ((piece = 0) Or (Sgn(piece) <> oppsig)) Then setMove(iMove(col,row,mcol,mrow),opp) EndIf Next 'sleep Case 4 'bishop explore(col,row,northeast,opp) explore(col,row,southeast,opp) explore(col,row,northwest,opp) explore(col,row,southwest,opp) Case 5 'queen explore(col,row,north,opp) explore(col,row,east,opp) explore(col,row,south,opp) explore(col,row,west,opp) explore(col,row,northeast,opp) explore(col,row,southeast,opp) explore(col,row,northwest,opp) explore(col,row,southwest,opp) Case 6 'king explore(col,row,north,opp,1) explore(col,row,east,opp,1) explore(col,row,south,opp,1) explore(col,row,west,opp,1) explore(col,row,northeast,opp,1) explore(col,row,southeast,opp,1) explore(col,row,southwest,opp,1) explore(col,row,northwest,opp,1) End Select EndIf Next 'showInternalBoard Next Select Case opp 'test if castling is legal Case w If testForCheck(w) = 0 Then If InStr(fenCastling,"K") Then If (board(7,9) = 0) And (board(8,9) = 0) Then explore(6,9,east,opp,2) EndIf EndIf If InStr(fenCastling,"Q") Then If (board(5,9) = 0) And (board(4,9) = 0) And (board(3,9) = 0) Then explore(6,9,west,opp,2) EndIf EndIf EndIf Case b If testForCheck(b) = 0 Then If InStr(fenCastling,"k") Then If (board(7,2) = 0) And (board(8,2) = 0) Then explore(6,2,east,opp,2) EndIf EndIf If InStr(fenCastling,"q") Then If (board(5,2) = 0) And (board(4,2) = 0) And (board(3,2) = 0) Then explore(6,2,west,opp,2) EndIf EndIf EndIf End Select End Sub 'move a piece field by field along the desired direction as far as possible and check for every ' field if the move would be legal Sub explore(col As Integer, row As Integer, d As direction, opp As String, kingflag As Integer = 0) Dim As Integer x, mcol, mrow, oppsig If opp = w Then oppsig = 1 Else oppsig = -1 EndIf Do x += 1 mcol = col + x * d.col mrow = row + x * d.row Select Case board(mcol,mrow) 'destination field Case 0 'destination field is empty setMove(iMove(col,row,mcol,mrow),opp) 'test Case 7 'border Return Case Else If Sgn(board(mcol,mrow)) = oppsig Then 'own piece Return Else setMove(iMove(col,row,mcol,mrow),opp) 'test (capture) Return EndIf End Select Loop Until x = kingflag End Sub Function deleteFromString(text As String, del As String) As String Dim As String g Dim As Integer x, y For x = 1 To Len(text) If InStr(Mid(text,x,1), Any del) = 0 Then g += Mid(text,x,1) EndIf Next Return g End Function