'#Include "d:\basic\freebasic\_tests\bipipe\bipipe.bi" #Include "bipipe.bi" Type direction col As Integer row As Integer End Type Type tFen pieces As String opponent As String castling As String enPassant As String halfmoves As Integer moves As Integer Declare Property fen As String 'read fen Declare Property fen(board() As Integer) As String 'generate fen from internal board Declare Property fen(f As String) 'write fen Declare Property fen(f As String, board() As Integer) 'write fen and set internal board End Type Property tFen.fen(f As String) 'parse fen Dim As Integer ptr1, ptr2 ptr1 = InStr(f, " ") pieces = Left(f, ptr1 - 1) ptr2 = InStr(ptr1 + 1, f, " ") opponent = Mid(f, ptr1 + 1, ptr2 - ptr1 - 1) ptr1 = InStr(ptr2 + 1, f, " ") castling = Mid(f, ptr2 + 1, ptr1 - ptr2 - 1) ptr2 = InStr(ptr1 + 1, f, " ") enPassant = Mid(f, ptr1 + 1, ptr2 - ptr1 - 1) ptr1 = InStr(ptr2 + 1,f," ") halfmoves = Val(Mid(f, ptr2 + 1, ptr1 - ptr2 - 1)) moves = Val(Mid(f, ptr1 + 1)) End Property Property tFen.fen As String Return pieces + " " + opponent + " " + castling + " " + enPassant + " " + _ Str(halfmoves) + " " + Str(moves) End Property Property tFen.fen(f As String, bo() As Integer) 'write fen and set internal board Dim As Integer x, y, i, row, col Dim As String opp, g If Len(f) Then fen = f 'write fen EndIf 'preset internal board For row = 0 To 11 For col = 0 To 11 bo(col, row) = 7 'border Next Next row = 2 col = 1 For x = 1 To Len(pieces) g = Mid(pieces, x, 1) Select Case g Case "1" To "8" 'empty field(s) i = Val(g) For y = 1 To i bo(col + y, row) = 0 'empty field Next col += i Case "/" 'next row row += 1 col = 1 Case Else col += 1 'next column bo(col, row) = InStr("kqbnrp0PRNBQK", g) - 7 'put piece to field End Select Next End Property Property tFen.fen(bo() As Integer) As String 'generate fen from internal board Dim As Integer col, lin, countFree Dim As String g pieces = "" For col = 2 To 9 For lin = 2 To 9 'convert internal board to fen-string g = Mid("kqbnrp0PRNBQK", bo(lin, col) + 7, 1) If g = "0" Then countFree += 1 Else If countFree Then pieces += Str(countFree) countFree = 0 EndIf pieces += g EndIf Next If countFree Then pieces += Str(countFree) countFree = 0 EndIf pieces += "/" Next pieces = RTrim(pieces, "/") Return fen End Property 'Const As String w = "white", b = "black" Dim Shared As direction north, northeast, east, southeast, south, southwest, west, northwest ', _ 'knightpattern(8) Dim Shared As Integer board(12,12), sBoard(12,12) 'internal representation of board Dim Shared As Double gameStamp 'Dim Shared As String enPassantField '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 Dim Shared As direction knightpattern(1 To ...) = {(-1,-2),(1,-2),(2,-1),(2,1), _ (1,2),(-1,2),(-2,1),(-2,-1)} 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 Function testForCheck(opp As String) As Integer Dim As Integer x, col, row, drow, dcol, kingrow, kingcol, kingsig 'set Sgn of the king kingsig = IIf(opp = "w", 1, -1) 'get the internal coordinates of the king For kingrow = 2 To 9 For kingcol = 2 To 9 If board(kingcol,kingrow) = kingsig * 6 Then 'king found 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 100*col + 10*row + 1 'Else ' Exit Do 'next direction EndIf Case 2 'rook If (dcol = 0) Or (drow = 0) Then 'king is looking straight Return 100*col + 10*row + 2 'Else ' Exit Do EndIf Case 3 'knight 'Exit Do 'next direction Case 4 'bishop If (dcol <> 0) And (drow <> 0) Then 'king is looking diagonal Return 100*col + 10*row + 3 'Else ' Exit Do EndIf Case 5 'queen Return 100*col + 10*row + 4 Case 6 'king If (Abs(kingcol - col) < 2) And (Abs(kingrow - row) < 2) Then Return 100*col + 10*row + 5 'Else ' Exit Do EndIf End Select Exit Do 'next direction EndIf Loop Next Next For x = 1 To 8 If board(kingcol + knightpattern(x).col, kingrow + knightpattern(x).row) = kingsig * -3 Then 'knight Return 100*col + 10*row + 6 EndIf Next Return 0 'no check End Function Sub restoreBoard Dim As Integer col, row CopyMemory(@board(0,0),@sBoard(0,0),13*13*SizeOf(Integer)) 'For row = 0 To 12 ' For col = 0 To 12 ' Board(col,row) = sBoard(col,row) ' Next 'Next End Sub Sub saveBoard Dim As Integer col, row 'dim as any ptr bp '= @board(lbound(board)), sbp = @sBoard(LBound(sBoard)) CopyMemory(@sBoard(0,0),@board(0,0),13*13*SizeOf(Integer)) 'For row = 0 To 12 ' For col = 0 To 12 ' sBoard(col,row) = board(col,row) ' Next 'Next 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