Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
common.bi
| Uploader: |  grindstone |
| Datum/Zeit: | 12.01.2021 16:22:42 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts Colochessum, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
'#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