'*******************************************************************************************
' 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"
#Include "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"

Randomize Timer

Dim Shared As bipdata Ptr pipeHuman
Dim Shared As HANDLE hWndThisWindow

Dim Shared As String opponent, castlingFlag, currentFen
                     
'Type tFen 'for parsed fen
'	castling As String
'	board As String
'	opponent As String
'	enPassant As String
'	halfmoves As String
'	moves As String
'End Type
                     
Dim Shared As Integer count50, moveCount, mx, my, mw, mb                    
Dim Shared As Integer rndFlag                  
ReDim Shared As String legalMove(1)
Dim Shared As Integer legalMoveCount

gameStamp = Now

Dim As Integer x, y, ff
Dim As String sRet = "", sBuf, g, fieldfrom, fieldto, mousefield

'#Include "common.bi" 'contains subs/functions which are used identically in the
'                     ' colocessum main program as well as in the human interface
                     
Declare Sub fenToBoard(fen As String)
Declare Sub showInternalBoard()
Declare Function StringNextItem(text As String = "") As String
Declare Sub legalMoves(opp As String)
Declare Sub setMove(move As String, opp As String = "")
Declare Sub explore(col As Integer, row As Integer, d As direction, opp As String, kingflag As Integer = 0)
Declare Function iMove(colfrom As Integer, rowfrom As Integer, colto As Integer = 1, rowto As Integer = 1) As String
Declare Sub printInternalBoard(move As String)

enPassantField = "-"

Randomize Timer

Do 
	Input g 'get message from GUI
	'Print "ECHO ";g
	Do
		Select Case StringNextItem(g) '1st item
			Case "uci" 'send startup message to GUI
				Print "id name Colochessum human interface"
				Print "id author grindstone"
				Print "version 0.3  2015"
				Print "option name random type combo default off var off var rightclick var auto"
				Print "uciok"
				Exit Do
				
			Case "debug"
				Select Case StringNextItem() '1st item
					Case"on"
					Case "off"
				End Select
			
			Case "isready"
				Print "readyok"
			
			Case "setoption"
				Select Case StringNextItem() '1st item
					Case "name"
						Select Case StringNextItem() '2nd item
							Case "random"
								Select Case StringNextItem() '3rd item
									Case "value"
										Select Case StringNextItem() '4th item
											Case "off"
												rndFlag = 0
											Case "rightclick"
												rndFlag = 1
											Case "auto"
												rndFlag = 2
										End Select
								End Select
							
						End Select
				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
							opponent = IIf(opponent = w, b, w) 'toggle opponent
							setMove(g)
							'showInternalBoard
							g = StringNextItem() 'get next move
						Loop
						Exit Do
					Case "legal" 'generates a list of all possible legal moves. this is not an official
					             ' uci keyword
						'showInternalBoard
						parseFen(currentFen)
						enPassantField = fenP.EnPassant
						ff = FreeFile
						Open ExePath + "\boardlog.txt" For Output As #11
						Print #11, currentFen
						Print #11, fenP.EnPassant
						Close 11
						Open ExePath + "\legalmoves2.txt" For Output As #10
						Close 10
						legalMoves(opponent)
						'ff = FreeFile
						'Open ExePath + "\legalmoves2.txt" For Output As #10
						'Print #10, legalMoveCount
						For x = 0 To legalMoveCount + 1
							Print legalMove(x);" ";
							'Print #10, x;" ";legalMove(x)
						Next
						'close 10
						'Print opponent;"#"
						Print " uciok"
						If testForCheck(opponent) Then
							Print #10, opponent ;" check"
							Print #10, currentFen
						EndIf
						close 10
				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
					Select Case rndFlag
						Case 0 'no random play
							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 chosen move is legal
												If Left(legalMove(x),4) = fieldfrom + fieldto Then
													Print "bestmove " + legalMove(x) + " ponder (none)" 'send move message to GUI
													fieldfrom = "" 'reset field variables
													mousefield = ""
													Exit Do
												EndIf
											Next
										EndIf
								End Select
							Loop
						Case 2 'auto random
							'ff = FreeFile
							'Open ExePath + "\legalmoves2.txt" For Output As #10
							'For x As Integer = 1 To legalMoveCount
							'	Print #10, legalMove(x)
							'Next
							'close 10
							Sleep 100
							Print "bestmove " + legalMove(Int(Rnd * legalMoveCount) + 1) + " ponder (none)" 'send move message to GUI
													
					End Select
				Else 'no legal moves --> mate
					Print "bestmove (mate) ponder (none)" 'send mate message to GUI
				EndIf
			
			Case "stop"
			
			Case "ponderhit"
			
			Case "quit"
				Close
				End
		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
	opponent = IIf(fenP.Opponent = "w",w,b)
	'If fenOpponent = "w" Then
	'	opponent = w
	'Else
	'	opponent = b
	'EndIf
	castlingFlag = fenP.Castling
	count50 = ValInt(fenP.Halfmoves)
	moveCount = ValInt(fenP.Moves)
	
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") 
	Sleep
	
	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

Sub legalMoves(opp As String)
	Dim As Integer col, row, mcol, mrow, dcol, drow, oppsig, piece, x, epcol, eprow, ff
			
	saveBoard
	ReDim legalMove(16 * 63)
	legalMoveCount = 0
		
	ff = FreeFile
	Open ExePath + "\legalmoves.txt" For Output As #ff
	Print #ff, gamestamp
	'Close ff
	'set Sgn of the opponent
	oppsig = IIf(opp = w,1,-1)
		
	'translate en passant sign
	'Open ExePath + "\legalmoves.txt" For Append As #ff
	Print #ff, "en Passant field ";enPassantField
	Close ff
	If enPassantField <> "-" Then
		epcol = Asc(Mid(enPassantField,1,1)) - Asc("a") + 2
		eprow = 10 - Val(Mid(enPassantField,2,1))
	EndIf
	
	Open ExePath + "\legalmoves2.txt" For Append As #10
	Print #10, "enPassant ";enPassantField;"*"
	Print #10, "epcol ";epcol
	Print #10, "eprow ";eprow
	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
						'ff = FreeFile
						'Open ExePath + "\legalmoves2.txt" For Append As #10
						Print #10, "bauer ";iMove(col,row);" / ";
						
												
						Select Case opp 'move pawn 2 fields
							Case w
								If row = 8 Then 'base line
									If (board(col,7) = 0) And (board(col,6) = 0) Then
										Print #10, iMove(col,6);
										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
										Print #10, iMove(col,5);
										setMove(iMove(col,3,col,5),opp)
									EndIf
								EndIf
						End Select
						
						mrow = row - oppsig '1 row forward
						
						If board(col,mrow) = 0 Then 'move pawn 1 field
							Print #10, iMove(col,mrow);
							setMove(iMove(col,row,col,mrow),opp)
						EndIf
						
						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    
							Print #10, iMove(mcol,mrow);
							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
							Print #10, iMove(mcol,mrow);
							setMove(iMove(col,row,mcol,mrow),opp)
						EndIf
						Print #10,
						'close 10
					Case 2 'rook
						'ff = FreeFile
						'Open ExePath + "\legalmoves2.txt" For Append As #10
						Print #10, "turm ";iMove(col,row);" / ";
						
						explore(col,row,north,opp)
						explore(col,row,east,opp)
						explore(col,row,south,opp)
						explore(col,row,west,opp)
						Print #10,
						'close 10
					Case 3 'knight
						'ff = FreeFile
						'Open ExePath + "\legalmoves2.txt" For Append As #10
						Print #10, "springer ";iMove(col,row);" / ";
						
						For x = 1 To 8
							mcol = col + knightpattern(x).col
							mrow = row + knightpattern(x).row
							piece = board(mcol,mrow)
							Print #10, iMove(mcol,mrow);
							If (piece <> 7) And ((piece = 0) Or (Sgn(piece) <> oppsig)) Then
								setMove(iMove(col,row,mcol,mrow),opp)
							EndIf
						Next
						Print #10,
						'close 10
						'sleep					
					Case 4 'bishop
						'ff = FreeFile
						'Open ExePath + "\legalmoves2.txt" For Append As #10
						Print #10, "läufer ";iMove(col,row);" / ";
						
						explore(col,row,northeast,opp)
						explore(col,row,southeast,opp)
						explore(col,row,northwest,opp)
						explore(col,row,southwest,opp)
						Print #10,
						'close 10
					Case 5 'queen
						'ff = FreeFile
						'Open ExePath + "\legalmoves2.txt" For Append As #10
						Print #10, "dame ";iMove(col,row);" / ";
						
						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)
						Print #10,
						'close 10
					Case 6 'king
						'ff = FreeFile
						'Open ExePath + "\legalmoves2.txt" For Append As #10
						Print #10, "könig ";iMove(col,row);" / ";
						
						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)
						Print #10,
						'close 10			
				End Select
			EndIf
		Next
		'showInternalBoard
	Next
	Close 10		
		
	Select Case opp 'test if castling is legal
		Case w
			If testForCheck(w) = 0 Then
				If InStr(fenP.Castling,"K") Then
					If (board(7,9) = 0) And (board(8,9) = 0) Then
						explore(6,9,east,opp,2)
					EndIf
				EndIf
				If InStr(fenP.Castling,"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(fenP.Castling,"k") Then
					If (board(7,2) = 0) And (board(8,2) = 0) Then
						explore(6,2,east,opp,2)
					EndIf
				EndIf
				If InStr(fenP.Castling,"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

Sub setMove(move As String, opp As String = "")
	Dim As Integer rowfrom, rowto, colfrom, colto, x, ff
	Dim As String promote, legm
			
	If Len(move) = 5 Then
		promote = Right(move,1)
		move = Left(move,4)
	ElseIf Len(move) <> 4 Then
		Return
	EndIf
		
	'Print "setMove ";move
	'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))
	
	legm = IIf(board(colto,rowto) = 0,"+/","c/")
		
	board(colto,rowto) = board(colfrom,rowfrom) 'put piece to destination field
	board(colfrom,rowfrom) = 0
	
	'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
				fenP.Castling = deleteFromString(fenP.Castling,"Q")
			Case "h1" 'right white rook
				fenP.Castling = deleteFromString(fenP.Castling,"K")
			Case "e1" 'white king
				fenP.Castling = deleteFromString(fenP.Castling,"QK")
			Case "a8" 'left black rook
				fenP.Castling = deleteFromString(fenP.Castling,"q")
			Case "h8" 'right black rook
				fenP.Castling = deleteFromString(fenP.Castling,"k")
			Case "e8" 'black king
				fenP.Castling = deleteFromString(fenP.Castling,"qk")	
		End Select
	EndIf
		
	'en passant
	If (Abs(board(colto,rowto)) = 1) And (Mid(move,3,2) = enPassantField) Then
		' \___________pawn__________/       \_________en passant_________/
		Select Case Right(enPassantField,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
	
	'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 'no test mode --> set en passant field, otherwise don't change 	
		If (Abs(board(colto,rowto)) = 1) And (Abs(rowfrom - rowto) = 2) Then
			' \_________pawn____________/       \pawn was moved 2 rows_/
			enPassantField = Mid(move,3,1) 'column
			Select Case Mid(move,4,1) 'row
				Case "4"
					enPassantField += "3"
				Case "5"
					enPassantField += "6"
			End Select
		Else 'no en passant
			enPassantField = "-" 'reset en passant field
		EndIf
	Else 'test mode
		x = testForCheck(opp)
		If x = 0 Then
			If Abs(board(colto,rowto)) = 1 And (move[3] = Asc("1") Or move[3] = Asc("8")) Then 'pawn promotion
				move += "q"
			EndIf
			legalMoveCount += 1
			legalMove(legalMoveCount) = move
			ff = FreeFile
			Open ExePath + "\legalmoves.txt" For Append As #ff
			Print #ff, move
			Close ff
			Print #10,legm;
		Else
			Print #10,x;"i/";
			printInternalBoard(move)
			move = "" 'move was illegal
			'sleep
		EndIf
		restoreBoard
	EndIf
	Return
		
End Sub

Sub explore(col As Integer, row As Integer, d As direction, opp As String, kingflag As Integer = 0)
	Dim As Integer x = 0, mcol, mrow, oppsig, ff
		
	oppsig = IIf(opp = w,1,-1)
		
	Do
		x += 1
		mcol = col + x * d.col
		mrow = row + x * d.row
		
		Print #10, iMove(mcol,mrow); 
		Select Case board(mcol,mrow) 'destination field
			Case 0 'destination field is empty 
				'Print #10, "+/";
				setMove(iMove(col,row,mcol,mrow),opp) 'test
			Case 7 'border
				Print #10, ":/";
				Return
			Case Else
				If Sgn(board(mcol,mrow)) = oppsig Then 'own piece
					Print #10, "o/";
					Return
				Else
					'Print #10, "x/";
					setMove(iMove(col,row,mcol,mrow),opp) 'test (capture)
					Return
				EndIf
		End Select
	Loop Until x = kingflag
		
End Sub

Function iMove(colfrom As Integer, rowfrom As Integer, colto As Integer = 1, rowto As Integer = 1) As String
	'translate internal format to move
		
	Return Mid(" abcdefgh",colfrom,1) + Mid(" 87654321",rowfrom,1) + _
	       Mid(" abcdefgh",colto,1) + Mid(" 87654321",rowto,1)
	       
End Function

Sub printInternalBoard(move As String)
	Dim As Integer col, row, ff
	
	ff = FreeFile
	Open ExePath + "\boardlog.txt" For Append As #11
		
	Print #11, "*********************************************************"
	Print #11, move
	Print #11, "    2 3 4 5 6 7 8 9 "
	For row = 2 To 9 'row
		Print #11, 10-row;"|";
		For col = 2 To 9 'column
			Print #11, board(col,row);
		Next
		Print #11, "|";row;" "
	Next
	Print #11, "    A B C D E F G H "
	'Print "*********************************************************"
	'Sleep 5000
	Close 11
	
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