Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
chess_gui_engine_vs_engine_0.7
| Uploader: |  grindstone |
| Datum/Zeit: | 01.12.2013 04:19:00 |
#Include Once "windows.bi"
#Include "fbgfx.bi"
Type chessMove
x1 As Integer
x2 As Integer
y1 As Integer
y2 As Integer
t1 As Integer
t2 As Integer
End Type
Type wText
opponent As String
move As String
depth As String
End Type
Const As Integer castlingWhite = 1, castlingBlack = 2
Const As String w = "white", b = "black"
Dim Shared As Integer mx, my, btn, ox, oy, dx, dy, depth, moveTimePreset, currentWhite, currentBlack, _
errorCount, totalErrors, moveCount, relSpeed, animationSpeed, ExitCode, _
count50, pchoice, increaseMoveTime, drawnGames, mox, moy, mob, mow
Dim Shared As Integer board(12,12) 'internal representation of board
Dim Shared As Integer moveTime(2), winEngine(2)
Dim Shared As Integer mateFlag, errorFlag
Dim Shared As Integer bx, by 'position top/left of board
Dim Shared As wText wt
Dim Shared As FB.Image Ptr sImage
Dim Shared As FB.Image Ptr iPiece(12) '12 images
Dim Shared As String engine(2), matesign(2)
ReDim Shared As String fen(1), movetable(1) '
Dim Shared As String hod, moves, currDepth, nameWhite, castlingFlag, fenstr, _
nameBlack, WindowText, move, opponent, playmode, lastmove
Dim Shared As HANDLE hReadChildPipeWhite, hWriteChildPipeWhite, hReadChildPipeBlack, _
hWriteChildPipeBlack, hReadPipeWhite, hWritePipeWhite, hReadPipeBlack, _
hWritePipeBlack, hThisWindow, hProcessHandleWhite, hProcessHandleBlack
Dim Shared As Any Ptr thMouse
Declare Function GetEngineResponse(opponent As String) As String
Declare Function GetMove(opponent As String) As String
Declare Sub WriteEngineInfo(opponent As String, s As String)
Declare Sub update()
Declare Function strMoveToNumMove(move As String) As chessMove
Declare Sub makeMove(cMove As chessMove)
Declare Sub SetTitleBar
Declare Sub CloseEngines
Declare Sub PrintMoveTable
Declare Function makeFen() As String
Declare Function deleteFromString(text As String, character As String) As String
Declare Sub fenToBoard(fen As String)
Declare Sub showInternalBoard()
Declare Function checkForStale() As Integer
Declare Sub MouseThread(parameter As Any Ptr)
Dim As Double timerem
Dim As Integer x, y
Dim As String datum, g, matecomp, movecomp, winner
Dim As chessMove cMove
Dim As STARTUPINFO siWhite, siBlack
Dim As PROCESS_INFORMATION pi
Dim As SECURITY_ATTRIBUTES sa
Dim Shared As Integer gameCount
'***************************************************************
'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
increaseMoveTime = 1000
'playmode = "depth"
depth = 10
animationSpeed = 15
'***************************************************************
ScreenRes 640,600,32
hThisWindow = GetForegroundWindow() 'get the window handle
'generate a value to make the delay loop independent from the system speed
timerem = Timer
Do
relSpeed += 1
x = Log(Timer)
Loop Until Timer > timerem + .1
relSpeed = relSpeed / 100 'representing about 1ms
winEngine(1) = 0
winEngine(2) = 0
drawnGames = 0
moveTime(1) = moveTimePreset
moveTime(2) = moveTimePreset
'thMouse = ThreadCreate(@MouseThread)
Do 'turnament loop
'animationSpeed = 10
ReDim fen(1)
ReDim movetable(0)
Open ExePath + "\ucilog.txt" For Output As #3 'erase the file
Open ExePath + "\fenlog.txt" For Output As #4 'erase the file
Close 3
totalErrors = 0
count50 = 0
gameCount += 1 'game counter
castlingFlag = "KQkq"
'swap engines
If gameCount And 1 Then 'every odd game number
currentWhite = 1
currentBlack = 2
Else 'every even game number
currentWhite = 2
currentBlack = 1
EndIf
'install the pipes to the two engines
sa.nLength = SizeOf(SECURITY_ATTRIBUTES)
sa.lpSecurityDescriptor = NULL
sa.bInheritHandle = TRUE
'start and connect white engine
CreatePipe(@hReadChildPipeWhite,@hWritePipeWhite,@sa,0)
CreatePipe(@hReadPipeWhite,@hWriteChildPipeWhite,@sa,0)
GetStartupInfo(@siWhite)
siWhite.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
siWhite.wShowWindow = SW_HIDE
siWhite.hStdOutput = hWriteChildPipeWhite
siWhite.hStdError = hWriteChildPipeWhite
siWhite.hStdInput = hReadChildPipeWhite
CreateProcess(0,engine(currentWhite),0,0,TRUE,0,0,0,@siWhite,@pi)
hProcessHandleWhite = pi.hProcess
'start and connect black engine
CreatePipe(@hReadChildPipeBlack,@hWritePipeBlack,@sa,0)
CreatePipe(@hReadPipeBlack,@hWriteChildPipeBlack,@sa,0)
GetStartupInfo(@siBlack)
siBlack.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
siBlack.wShowWindow = SW_HIDE
siBlack.hStdOutput = hWriteChildPipeBlack
siBlack.hStdError = hWriteChildPipeBlack
siBlack.hStdInput = hReadChildPipeBlack
CreateProcess(0,engine(currentBlack),0,0,TRUE,0,0,0,@siBlack,@pi)
hProcessHandleBlack = pi.hProcess
CloseHandle(hWriteChildPipeWhite)
CloseHandle(hReadChildPipeWhite)
CloseHandle(hWriteChildPipeBlack)
CloseHandle(hReadChildPipeBlack)
sImage = ImageCreate( 42, 42, 0 ) 'save screen data
'THIS DETERMINES WHERE TO PLACE BOARD IN WINDOW
bx = 130
by = 30
'read board
Restore boardLayout
For j As Integer = 0 To 11
For i As Integer = 0 To 11
Read board(i,j)
Next i
Next j
'copy images from data statements to screen
Restore Pieces
For i As Integer = 0 To 5 'for each piece
For y As Integer = 0 To 41 'for each row
Read datum
For x As Integer = 0 To 41 'for each column
If Mid(datum,x+1,1)="." Then
PSet(x+i*42,y),RGB(255,0,255) 'transparent color
PSet(x+i*42+252,y),RGB(255,0,255)
End If
If Mid(datum,x+1,1)="#" Then
PSet(x+i*42,y),RGB(0,0,0)
PSet(x+i*42+252,y),RGB(0,0,0)
End If
If Mid(datum,x+1,1)="*" Then
PSet(x+i*42,y),RGB(120,120,180)
PSet(x+i*42+252,y),RGB(250,200,200)
End If
Next x
Next y
Next i
'sleep
'allocate memory for 12 images
For i As Integer = 0 To 11
iPiece(i) = ImageCreate(42,42,0)
Next i
'get set of 12 images
For i As Integer = 0 To 11
Get (i*42,0)-(i*42+41,41), iPiece(i)
Next i
update()
'sleep
move = ""
wt.move = "xx xx"
opponent = b '(!)
hod = "position startpos moves"
moves = ""
mateFlag = 0
moveCount = 0
Open ExePath + "\gamelog.txt" For Output As #1 'open the protocol file
Print #1, "spiel";gameCount
Locate 52,30
Print "LOADING ENGINES"
WriteEngineInfo(w,"uci")
WriteEngineInfo(b,"uci")
Do
g = GetEngineResponse(w)
Loop Until InStr(g,"uciok")
x = InStr(g,"id name ") + 8
nameWhite = Mid(g, x, InStr(x,g,Chr(13)) - x) 'get the name of the white engine
Do
g = GetEngineResponse(b)
Loop Until InStr(g,"uciok")
x = InStr(g,"id name ") + 8
nameBlack = Mid(g, x, InStr(x,g,Chr(13)) - x) 'get the name of the black engine
'write to protocol file
Print #1, "white ";nameWhite;" ";engine(currentWhite)
Print #1, "black ";nameBlack;" ";engine(currentBlack)
Print #1, "mode ";playmode;
Select Case playmode
Case "depth"
Print #1, depth
Case "movetime"
Print #1, moveTimePreset
End Select
Print #1, ""
Open ExePath + "\turnamentlog.txt" For Append As #2
Print #2, ""
Print #2, "game";gameCount
Print #2, "white ";nameWhite;" ";engine(currentWhite)
Print #2, "black ";nameBlack;" ";engine(currentBlack)
Print #2, "mode ";playmode;
Select Case playmode
Case "depth"
Print #2, depth
Case "movetime"
Print #2, moveTimePreset;" (+";increaseMoveTime;")"
End Select
Close 2
'get the "mate"-messages from engine 1
WriteEngineInfo(w,"position fen 7K/6q1/7b/8/8/8/8/6k1 w - - 3 41 moves")
WriteEngineInfo(w,"go movetime 10")
matesign(1) = GetMove("fullwhite")
'get the "mate"-messages from engine 2
WriteEngineInfo(b,"position fen 7K/6q1/7b/8/8/8/8/6k1 w - - 3 41 moves")
WriteEngineInfo(b,"go movetime 10")
matesign(2) = GetMove("fullblack")
Open ExePath + "\gamelog.txt" For Append As #1 'open the protocol file
Print #1, matesign(1);"*"
Print #1, matesign(2);"*"
Close 1
'******** 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 ************************
Do
'switch opponent
If opponent = w Then
opponent = b 'black
Else
opponent = w 'white
moveCount += 1 'move number
EndIf
g = makeFen
Open ExePath + "\fenlog.txt" For Append As #4 'write fen-string to log fole
Print #4, g
Close #4
Locate 57,1
'? g 'fen-string
'Sleep
ReDim Preserve fen(UBound(fen) + 1)
fen(UBound(fen)) = g 'write fen-string to table
mateFlag = 0
errorCount = 0 'reset the error counter
Print #1, Time;" ";moveCount;" ";opponent;" ";hod;moves 'write to protocol file
Print #1, ""
'calculate next move
WriteEngineInfo(opponent,hod + moves) 'send the actual board setup to the engine
update()
Select Case playmode
Case "depth"
WriteEngineInfo(opponent,"go depth " + Str(depth)) 'depth mode
Case "movetime"
Select Case opponent 'call the actual opponent with its movetime
Case w
WriteEngineInfo(opponent,"go movetime " + Str(moveTime(currentWhite)))
Case b
WriteEngineInfo(opponent,"go movetime " + Str(moveTime(currentBlack)))
End Select
End Select
move = GetMove(opponent) 'read the "bestmove" from the engine
'Locate 5,1
'? "*";move;"*"
'? matesign(1)
'? matesign(2)
'Sleep
lastmove = move
'check if the response is a correct move
If move = "mate" Then 'checkmate
If checkForStale Then
mateFlag = 2 'stalemate
Else
mateFlag = 1 'checkmate
EndIf
ElseIf InStr(Mid(move,1,1),Any "abcdefgh") + _ '1st character
InStr(Mid(move,2,1),Any "12345678") + _ '2nd character
InStr(Mid(move,3,1),Any "abcdefgh") + _ '3rd character
InStr(Mid(move,4,1),Any "12345678") + _ '4th character
InStr(Mid(move,5,1),Any "qrbn") <> Len(move) Then '5th character (if existing)
'error
Locate 52,30
Print #1, move
Print #1, "game aborted due to response error caused by ";
Select Case opponent
Case w
Print #1, nameWhite
Case b
Print #1, nameBlack
End Select
Open ExePath + "\turnamentlog.txt" For Append As #2
Print #2, hod;moves;" *";move;"*"
Print #2, "game aborted due to response error caused by ";
Select Case opponent
Case w
Print #2, nameWhite
Case b
Print #2, nameBlack
End Select
Close 2
Exit Do 'terminate current game
EndIf
Do 'check for draw game
If mateFlag Then 'mate or stale
Exit Do 'leave the loop
EndIf
'check for threefold repetition
g = makeFen 'create fen-string
g = Left(g,InStrRev(g," ",InStrRev(g," ")-1)-1)
y = 0
For x = UBound(fen) To 1 Step -1
If Left(fen(x),InStrRev(fen(x)," ",InStrRev(fen(x)," ")-1)-1) = g Then
y += 1
EndIf
If y > 1 Then
mateFlag = 3 'threefold repetition
Exit Do 'leave the loop
EndIf
Next
'check for dead position
g = ""
For x = 1 To InStr(fen(UBound(fen))," ") - 1
If InStr(Mid(fen(UBound(fen)),x,1),Any "012345678/") = 0 Then 'isolate pieces from fen-string
g += Mid(fen(UBound(fen)),x,1)
EndIf
Next
Do 'put 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
Case "kk","kbk","knk"
mateFlag = 4
Exit Do 'leave the loop
End Select
'check for 50-moves-rule
If count50 > 99 Then
mateFlag = 5
Exit Do 'leave the loop
EndIf
Loop Until 1 'always leave the loop
If mateFlag Then 'end game
'showInternalBoard
Open ExePath + "\turnamentlog.txt" For Append As #2
Print #2, "drawn because of ";
Select Case mateFlag
Case 1 'checkmate
Locate 51,29
Print " << CHECK MATE >> "
'write to protocol file
Print #1, " << CHECK MATE >> "
Locate 69,20
Select Case opponent 'set the win counter and write to protocol file
Case w
Print #1, "black (";nameBlack;
Print "<< BLACK (";nameBlack;
winEngine(currentBlack) += 1 'winner
moveTime(currentWhite) += increaseMoveTime 'loser
Case b
Print #1, "white (";nameWhite;
Print "<< WHITE (";nameWhite;
winEngine(currentWhite) += 1 'winner
moveTime(currentBlack) += increaseMoveTime 'loser
End Select
Print #1, ") wins in"; moveCount; " moves"
Print ") wins in"; moveCount; " moves >>"
'write to turnament log
Open ExePath + "\turnamentlog.txt" For Append As #2
Print #2, "check mate ";
Select Case opponent
Case w
Print #2, nameBlack;" wins as black ";
Case b
Print #2, nameWhite;" wins as white ";
End Select
Print #2, "in"; moveCount; " moves"
'showInternalBoard
Case 2 'stalemate
drawnGames += 1
Print #2, "drawn because of stalemate";
Locate 51,29
Print " << STALE MATE >> "
Case 3 'threefold repetition
drawnGames += 1
Print #2, "drawn because of threefold repetition";
Locate 51,29
Print " << THREEFOLD REPETITION >> "
Case 4 'dead position
drawnGames += 1
Print #2, "drawn because of dead position";
Locate 51,29
Print " << DEAD POSITION >> "
Case 5 '50-moves-rule
drawnGames += 1
Print #2, "drawn because of breaking the 50-moves-rule";
Locate 51,29
Print " << 50 MOVES >> "
End Select
Print #2, " after"; moveCount; " moves"
Print #2, Mid(moves,2)
Print #2, "*";lastmove;"*"
Print #2, "total wins ";engine(1);winEngine(1)
Print #2, "total wins ";engine(2);winEngine(2)
Print #2, "total drawn ";drawnGames
Close
Sleep 10000
Exit Do 'start next game
EndIf
moves += " " + move 'add the last move to the hod-string
'add the last move to the movetable
ReDim Preserve movetable(UBound(movetable) + 1)
If opponent = w Then
movetable(UBound(movetable)) = Right(" " + Str(moveCount),3)
Else
movetable(UBound(movetable)) = " "
EndIf
movetable(UBound(movetable)) += " " + UCase(Left(move,2)) + " " + _
UCase(Mid(move,3,2)) + " " + _
UCase(Mid(move,5,1)) + " "
wt.move = UCase(Left(move,2) + " " + Mid(move,3)) 'for title bar
SetTitleBar 'set screenwindow title bar
PrintMoveTable
'update castlig flag
Select Case Left(move,2)
Case "a1" 'left white rook
castlingFlag = deleteFromString(castlingFlag,"Q")
Case "h1" 'right white rook
castlingFlag = deleteFromString(castlingFlag,"K")
Case "e1" 'white king
castlingFlag = deleteFromString(castlingFlag,"QK")
Case "a8" 'left black rook
castlingFlag = deleteFromString(castlingFlag,"q")
Case "h8" 'right black rook
castlingFlag = deleteFromString(castlingFlag,"k")
Case "e8" 'black king
castlingFlag = deleteFromString(castlingFlag,"qk")
End Select
'show animated move
cMove = strMoveToNumMove(move)
makeMove(cMove)
'show animated castling
If (move = "e1g1") And pchoice = 6 Then
cMove = strMoveToNumMove("h1f1")
makeMove(cMove)
ElseIf (move = "e1c1") And pchoice = 6 Then
cMove = strMoveToNumMove("a1d1")
makeMove(cMove)
ElseIf (move = "e8g8") And pchoice = -6 Then
cMove = strMoveToNumMove("h8f8")
makeMove(cMove)
ElseIf (move = "e8c8") And pchoice = -6 Then
cMove = strMoveToNumMove("a8d8")
makeMove(cMove)
EndIf
'sleep
update()
g = InKey 'check for keyboard input
Do
Select Case g
Case Chr(27) 'terminate current game
drawnGames += 1
Case Chr(255,107) 'terminate program
End
Case "+"
animationSpeed += 1
Case "-"
If animationSpeed Then
animationSpeed -= 1
EndIf
End Select
g = InKey 'check for key pressed
Loop While Len(g)
Loop Until (g = Chr(27)) Or g = Chr(255,107) 'Esc, X
If g = Chr(27) Then
drawnGames += 1
EndIf
CloseEngines
Close
Loop 'next game
Print #1, Time;" turnament aborted" 'write to protocol file
Close
End
Sub update()
Dim As Integer x, y
ScreenLock()
'drawBoard
Color RGB(0,0,0),RGB(100,255,100)
Cls
Dim As Integer shade
shade = 1
For y As Integer = 0 To 7
shade = -shade
For x As Integer = 0 To 7
If shade = -1 Then
Line (bx+x*42,by+y*42)-(bx+x*42+41,by+y*42+41),RGB(252,206,156),bf
Else
Line (bx+x*42,by+y*42)-(bx+x*42+41,by+y*42+41),RGB(179,110,44),bf
End If
shade = -shade
Next x
Next y
'border of board
Line (bx-1,by-1)-(bx+336,by+336),RGB(0,0,0),b
'now draw image on square
For y As Integer = 0 To 7 'column
For x As Integer = 0 To 7 'line
'put image onto square
If board(x+2,y+2) <> 7 And board(x+2,y+2) <> 0 Then
If board(x+2,y+2) < 0 Then 'black
Put (bx+x*42,by+y*42),iPiece(Abs(board(x+2,y+2))-1),Trans
Else 'white
Put (bx+x*42,by+y*42),iPiece(Abs(board(x+2,y+2))+5),Trans
End If
End If
Next x
Next y
'print engine names and coordinates on screen
Locate 2,20
Print nameBlack
Locate 49,20
Print nameWhite
For x = 1 To 8
Locate 48 - 5.15 * x,14
Print x
Next
Locate 47,20
Print "A B C D E F G H"
Locate 53,20
Print "Game";gameCount
Locate 54,20
Print "Move";moveCount;" (";Str(count50);")"
Locate 53,45
Print "engine 1: ";engine(1)
Print Tab(45);"moveTime:";moveTime(1)
Print Tab(50);"win:";winEngine(1)
Print
Print Tab(45);"engine 2: ";engine(2)
Print Tab(45);"moveTime:";moveTime(2)
Print Tab(50);"win:";winEngine(2)
Print
Print Tab(41);"drawn games :";drawnGames
Print
Print Tab(38);"animation speed:";animationSpeed
PrintMoveTable
Locate 1,1
? mox;moy;mow;mob;" "
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
'If Len(move) = 5 Then
' animationSpeed = 20
'EndIf
'Locate 1,1
cMove.y1 = 8 - cMove.y1 'set correct line of internal board
cMove.y2 = 8 - cMove.y2
px1 = cMove.x1*42+bx 'screen pointer to chosen image
py1 = cMove.y1*42+by
px2 = cMove.x2*42+bx
py2 = cMove.y2*42+by
ox = px1
oy = py1
'make move on internal board
choice = board(cMove.x1+2,cMove.y1+2)
pchoice = choice
count50 += 1
If board(cMove.x2+2,cMove.y2+2) Then 'piece is captured
Mid(movetable(UBound(movetable)),7,1) = "x"
Mid(wt.move,3,1) = "x"
SetTitleBar
PrintMoveTable
count50 = 0
EndIf
If Abs(choice) = 1 Then 'pawn is moved
count50 = 0
EndIf
'wt.move = movetable(UBound(movetable)) 'for title bar
'SetTitleBar 'set screenwindow title bar
board(cMove.x2+2,cMove.y2+2) = choice
board(cMove.x1+2,cMove.y1+2)=0 'erase data
'convert to image ID of that number
If choice < 0 Then
choice = Abs(choice) - 1
Else
choice = choice + 5
End If
Line (px1,py1)-(px1+41,py1+41),Point(px1+2,py1+2),bf 'clear
For i = 0 To 3
Line (px1+i,py1+i)-(px1+41-i,py1+41-i),RGB(0,0,244),b 'source
Line (px2+i,py2+i)-(px2+41-i,py2+41-i),RGB(0,255,0),b 'destination
Next i
'compute direction of movement
If px1 > px2 Then
dx = -1
Else
dx = 1
End If
If py1 > py2 Then
dy = -1
Else
dy = 1
End If
Get (px1,py1)-(px1+41,py1+41),sImage
Put (px1,py1),iPiece(choice),Trans
ox = px1
oy = py1
While px1 <> px2 Or py1 <> py2
'update coordinates
'Sleep 4
If px1 <> px2 Then
px1 = px1 + dx
End If
If py1 <> py2 Then
py1 = py1 + dy
End If
'Sleep 4
Put (ox,oy),sImage,PSet 'restore old back ground
Get (px1,py1)-(px1+41,py1+41),sImage 'save new back ground
Put (px1,py1),iPiece(choice),Trans 'place on new back ground
ox = px1
oy = py1
'Sleep 4
If animationSpeed Then 'waste some time
For i = 1 To animationSpeed * relSpeed
x = Log(Timer)
Next
EndIf
Wend
If Len(move) = 5 Then 'pawn promotion
'animationSpeed = 20
'Sleep
Select Case Mid(move,5,1)
Case "q"
choice = Sgn(pchoice) * 5 'promote to queen
Case "b"
choice = Sgn(pchoice) * 4 'promote to bishop
Case "n"
choice = Sgn(pchoice) * 3 'promote to knight
Case "r"
choice = Sgn(pchoice) * 2 'promote to rook
End Select
board(cMove.x2+2,cMove.y2+2) = choice
EndIf
End Sub
'convert string chess moves to numbers
Function strMoveToNumMove(move As String) As chessMove
Dim As chessMove cm
Dim As String umove
umove = UCase(move)
cm.x1 = Asc(Mid(umove,1,1))-65
cm.y1 = Val(Mid(umove,2,1))
cm.x2 = Asc(Mid(umove,3,1))-65
cm.y2 = Val(Mid(umove,4,1))
Return cm
End Function
'convert chess move numbers to string format
Function numMovetoStrMove(cm As chessMove) As String
Return Chr(cm.x1+65)+Str(cm.y1)+Chr(cm.x2+65)+Str(cm.y2)
End Function
Function GetMove(opp As String) As String
Dim As String g, sRet
Dim As Integer x, full = 0
If Left(opp,4) = "full" Then 'don't edit the move message
full = 1
opp = Mid(opp,5)
EndIf
'REPLAY *************
Static As Integer anfang, ende
Dim As String replaylist
GoTo noreplay
'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
anfang = ende
ende = InStr(anfang + 1,replaylist," ")
If ende = 0 Then
ende = anfang
EndIf
sRet = Mid(replaylist,anfang + 1,ende - anfang - 1)
Locate 1,1
? "*";sRet;"*";anfang;ende
'sleep
GoTo replay
'Return sRet
'? "*";sRet;"*";anfang;ende
'Sleep
'GoTo s
'End
'END REPLAY *************
noreplay:
wt.opponent = opp 'for title bar
g = ""
Do
g += GetEngineResponse(opp) 'request a message from the engine
'currDepth = ""
'print opponent and current depth to the screen
x = InStrRev(g,"info depth ")
currDepth = Str(Val(Mid(g,x+11,2)))
'? "*";currDepth;"*"
'? "*";Str(Val(currDepth));"*"
'Sleep
Locate 56, 20
Print UCase(opp)
Locate 57, 20
Print "Current depth ";currDepth
wt.depth = currDepth 'for title bar
SetTitleBar 'set title bar
Locate 1,1
? mox;moy;mow;mob;" "
Sleep 1
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
'? "**";sRet;"**
'Sleep
replay:
If full Then ' don't edit the message
Return sRet
EndIf
For x = 1 To 2
If Left(sRet,4) = Left(matesign(x),4) Then
Return "mate"
EndIf
Next
Select Case Mid(sRet,5,1)
Case "q","b","n","r" 'pawn promotion
sRet = Left(sRet,5) 'clip string to 5 characters
Case Else
sRet = Left(sRet,4) 'clip string to 4 characters
End Select
Return sRet 'send the move to the gui
End Function
Function GetEngineResponse(opp As String) As String
Dim As Integer iTotalBytesAvail, iNumberOfBytesWritten, iBytesToRead
Dim As String sRet = "", sBuf
Const As Integer MaxBytesToRead = 4096 'maximum number of bytes to be returned at one 'ReadFile'-operation
Do
sBuf = "" 'clear buffer
'look if there's any data in the pipe
Select Case opp 'choose engine
Case "white"
PeekNamedPipe(hReadPipeWhite,NULL,NULL,NULL,@iTotalBytesAvail,NULL)
Case "black"
PeekNamedPipe(hReadPipeBlack,NULL,NULL,NULL,@iTotalBytesAvail,NULL)
End Select
If iTotalBytesAvail Then 'pipe is not empty
If iTotalBytesAvail < MaxBytesToRead Then
iBytesToRead = iTotalBytesAvail 'set all available bytes to be read
Else
iBytesToRead = MaxBytesToRead 'set the first 4096 bytes to be read
EndIf
sBuf = String(iBytesToRead,Chr(0)) 'set the length of the buffer string to the necessary value
'read the specified amount of bytes from the pipe
Select Case opp 'choose engine
Case "white"
ReadFile(hReadPipeWhite,StrPtr(sBuf),iBytesToRead,@iNumberOfBytesWritten,NULL)
Case "black"
ReadFile(hReadPipeBlack,StrPtr(sBuf),iBytesToRead,@iNumberOfBytesWritten,NULL)
End Select
sRet += sBuf 'add the buffer to the return string
Sleep 1
Else 'pipe is empty
Exit Do 'return
EndIf
Loop
Open ExePath + "\ucilog.txt" For Append As #3
Print #3, ""
Print #3, "RECEIVE FROM: ";opp
Print #3, sRet;"*"
Print #3, "----------"
Close 3
Return sRet
End Function
Sub WriteEngineInfo(opp As String, s As String)
Dim As Integer iNumberOfBytesWritten
Dim As String sBuf
sBuf = s + Chr(10)
Open ExePath + "\ucilog.txt" For Append As #3
Print #3,""
Print #3, "SEND TO: ";opp
Print #3, s
Print #3, "----------"
Close 3
'send the command string to the engine
Select Case opp 'choose engine
Case "white"
WriteFile(hWritePipeWhite,StrPtr(sBuf),Len(sBuf),@iNumberOfBytesWritten,NULL)
Case "black"
WriteFile(hWritePipeBlack,StrPtr(sBuf),Len(sBuf),@iNumberOfBytesWritten,NULL)
End Select
End Sub
Sub SetTitleBar
Dim As String text
'set the text of the screen window
text = Left(UCase(wt.opponent),1) + " " + wt.move + " " + wt.depth
SetWindowText(hThisWindow,StrPtr(text))
Sleep 1
End Sub
Sub CloseEngines
TerminateProcess(hProcessHandleWhite, @ExitCode)
TerminateProcess(hProcessHandleBlack, @ExitCode)
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 from internal board to fen
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(castlingFlag) Then 'castling
fenpcs += " " + castlingFlag
Else
fenpcs += " -"
EndIf
If Abs(pchoice) = 1 Then 'add en passant information
Select Case move
Case "a2a4"
fenpcs += " a3"
Case "b2b4"
fenpcs += " b3"
Case "c2c4"
fenpcs += " c3"
Case "d2d4"
fenpcs += " d3"
Case "e2e4"
fenpcs += " e3"
Case "f2f4"
fenpcs += " f3"
Case "g2g4"
fenpcs += " g3"
Case "h2h4"
fenpcs += " h3"
Case "a7a5"
fenpcs += " a6"
Case "b7b5"
fenpcs += " b6"
Case "c7c5"
fenpcs += " c6"
Case "d7d5"
fenpcs += " d6"
Case "e7e5"
fenpcs += " e6"
Case "f7f5"
fenpcs += " f6"
Case "g7g5"
fenpcs += " g6"
Case "h7h5"
fenpcs += " h6"
Case Else
fenpcs += " -"
End Select
Else
fenpcs += " -"
EndIf
fenpcs += " " + Str(count50) + " " + Str(moveCount) 'add counters
Return fenpcs
End Function
Sub PrintMoveTable
'print the movelist on the screen
Dim As Integer x, listlen
listlen = UBound(movetable)
If listlen > 42 Then
listlen = 42
EndIf
For x = 1 To listlen
Locate 46 - listlen + x , 62
Print movetable(UBound(movetable) - listlen + x)
Next
End Sub
Function deleteFromString(text As String, del As String) As String
Dim As String g
Dim As Integer x, y
For x = 1 To Len(text)
If InStr(Mid(text,x,1), Any del) = 0 Then
g += Mid(text,x,1)
EndIf
Next
Return g
End Function
Sub fenToBoard(fen As String)
Dim As Integer x, y, i, row, col
row = 2
col = 1
For x = 1 To InStr(fen," ") -1
Select Case Mid(fen,x,1)
Case "1","2","3","4","5","6","7","8"
i = Val(Mid(fen,x,1))
For y = 1 To i
board(col + y, row) = 0
Next
col += i
Case "/"
row += 1
col = 1
Case Else
col += 1
board(col,row) = InStr("PRNBQKprnbqk",Mid(fen,x,1))
If board(col,row) > 6 Then
board(col,row) = -1 * (board(col,row) - 6)
EndIf
End Select
Next
'rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1
'4N3/p5r1/1p2B2p/n1p2p2/2P2k2/1Pq5/P4P1P/3QR2K w - - 15 49
'Restore boardLayout
'For j As Integer = 0 To 11
' For i As Integer = 0 To 11
' Read board(i,j)
' Next i
'Next j
End Sub
Sub showInternalBoard()
Dim As Integer col, row
Locate 61,1
Print " 2 3 4 5 6 7 8 9"
For row = 2 To 9 'row
Print 10-row;"|";
For col = 2 To 9 'column
Print board(col,row);
Next
Print "|";row
Next
Print " A B C D E F G H"
End Sub
Function checkForStale() As Integer
Dim As Integer x, col, row, drow, dcol, kingrow, kingcol, kingsig
'set Sgn of the mated king
update
? opponent
'sleep
If opponent = w Then
kingsig = 1
Else
kingsig = -1
EndIf
'get the internal coordinates of the mated king
For row = 2 To 9
For col = 2 To 9
If board(col,row) = kingsig * 6 Then 'mated king found
kingrow = row
kingcol = col
Exit For,For 'terminate searching
EndIf
Next
Next
'let the mated king look around
Locate 60,20
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
? "check by pawn "
Return 0
Else
Exit Do 'next direction
EndIf
Case 2 'rook
If (dcol = 0) Or (drow = 0) Then 'mated king is looking straight
? "check by rook "
Return 0
EndIf
Case 4 'bishop
If (dcol <> 0) And (drow <> 0) Then 'mated king is looking diagonal
? "check by bishop "
Return 0
EndIf
Case 5 'queen
? "check by queen "
Return 0
End Select
EndIf
Loop
Next
Next
Restore knightCheck
For x = 1 To 8
Read dcol, drow
If Abs(board(kingcol + dcol, kingrow + drow)) = 3 Then 'knight
? "check by knight "
Return 0
EndIf
Next
Return 1
'Locate 65,30
'? lastmove
'Locate 66,30
'? "piece";movcol;movrow
'Locate 67,30
'? " king";kingcol;kingrow
'Locate 68,30
'? "dcol ";dcol;
'Select Case dcol
' Case -1
' ? " (links)"
' Case 0
' ?
' Case 1
' ? " (rechts)"
'End Select
'Locate 69,30
'? "drow ";drow;
'Select Case drow
' Case -1
' ? " (oben)"
' Case 0
' ?
' Case 1
' ? " (unten)"
'End Select
End Function
Sub MouseThread(parameter As Any Ptr)
Sleep 1000
Do
GetMouse(mox,moy,mow,mob)
'ScreenLock
'Locate 1,1
'Color RGB(0,0,0),RGB(100,255,100)
'
'? mox;moy;mow;mob;" "
'ScreenUnLock
Sleep 1
Loop
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 ".........................................."