From ec7ac2a03b977f4cd2d62f0f459dc906c81249ba Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Tue, 30 Aug 2011 13:21:59 +0000 Subject: [PATCH] fpchess: Adds more kcchess files git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1872 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- applications/fpchess/chessmodules.pas | 11 +- applications/fpchess/engines/kcchess/INIT.PAS | 124 +++ applications/fpchess/engines/kcchess/PLAY.PAS | 743 ++++++++++++++++++ .../fpchess/engines/kcchess/SETUP.PAS | 328 ++++++++ .../fpchess/engines/kcchess/mod_kcchess.pas | 170 +++- applications/fpchess/mod_fics.pas | 6 - applications/fpchess/mod_samecomputer.pas | 2 +- 7 files changed, 1371 insertions(+), 13 deletions(-) create mode 100644 applications/fpchess/engines/kcchess/INIT.PAS create mode 100644 applications/fpchess/engines/kcchess/PLAY.PAS create mode 100644 applications/fpchess/engines/kcchess/SETUP.PAS diff --git a/applications/fpchess/chessmodules.pas b/applications/fpchess/chessmodules.pas index 04470d7e8..5fe244f0e 100644 --- a/applications/fpchess/chessmodules.pas +++ b/applications/fpchess/chessmodules.pas @@ -12,6 +12,8 @@ uses type TChessModuleKind = (cmkSinglePlayer, cmkInternet, cmkAI); + { TChessModule } + TChessModule = class public Kind: TChessModuleKind; @@ -21,7 +23,7 @@ type procedure HideUserInterface(); virtual; abstract; procedure FreeUserInterface(); virtual; abstract; procedure PrepareForGame(); virtual; abstract; - function IsMovingAllowedNow(): Boolean; virtual; abstract; + function IsMovingAllowedNow(): Boolean; virtual; function GetSecondPlayerName(): string; virtual; abstract; procedure HandleOnMove(AFrom, ATo: TPoint); virtual; abstract; end; @@ -87,6 +89,13 @@ begin gChessModulesDebugOutputDestiny.Lines.Add(AStr); end; +{ TChessModule } + +function TChessModule.IsMovingAllowedNow: Boolean; +begin + Result := not (vChessGame.IsWhitePlayerTurn xor vChessGame.FirstPlayerIsWhite); +end; + initialization gChessModules := TList.Create; vChessGame.OnMove := @HandleOnMove; diff --git a/applications/fpchess/engines/kcchess/INIT.PAS b/applications/fpchess/engines/kcchess/INIT.PAS new file mode 100644 index 000000000..ebef1932f --- /dev/null +++ b/applications/fpchess/engines/kcchess/INIT.PAS @@ -0,0 +1,124 @@ +{****************************************************************************} +{* INIT.PAS: this file contains the routines which initialize the global *} +{* variables. *} +{****************************************************************************} + +{****************************************************************************} +{* Init Possible Moves: put the constant values into the data structure *} +{* which gives the possible moves for each piece, the point values for *} +{* capturing enemy pieces, and the opposite color to the given one. *} +{****************************************************************************} + procedure InitPossibleMoves; + var index: integer; + begin + PossibleMoves [BISHOP].NumDirections := 4; + PossibleMoves [BISHOP].MaxDistance := 7; + PossibleMoves [BISHOP].UnitMove[1].DirRow := 1; + PossibleMoves [BISHOP].UnitMove[1].DirCol := -1; + PossibleMoves [BISHOP].UnitMove[2].DirRow := 1; + PossibleMoves [BISHOP].UnitMove[2].DirCol := 1; + PossibleMoves [BISHOP].UnitMove[3].DirRow := -1; + PossibleMoves [BISHOP].UnitMove[3].DirCol := -1; + PossibleMoves [BISHOP].UnitMove[4].DirRow := -1; + PossibleMoves [BISHOP].UnitMove[4].DirCol := 1; + PossibleMoves [KNIGHT].NumDirections := 8; + PossibleMoves [KNIGHT].MaxDistance := 1; + PossibleMoves [KNIGHT].UnitMove[1].DirRow := 1; + PossibleMoves [KNIGHT].UnitMove[1].DirCol := -2; + PossibleMoves [KNIGHT].UnitMove[2].DirRow := 2; + PossibleMoves [KNIGHT].UnitMove[2].DirCol := -1; + PossibleMoves [KNIGHT].UnitMove[3].DirRow := 2; + PossibleMoves [KNIGHT].UnitMove[3].DirCol := 1; + PossibleMoves [KNIGHT].UnitMove[4].DirRow := 1; + PossibleMoves [KNIGHT].UnitMove[4].DirCol := 2; + PossibleMoves [KNIGHT].UnitMove[5].DirRow := -1; + PossibleMoves [KNIGHT].UnitMove[5].DirCol := 2; + PossibleMoves [KNIGHT].UnitMove[6].DirRow := -2; + PossibleMoves [KNIGHT].UnitMove[6].DirCol := 1; + PossibleMoves [KNIGHT].UnitMove[7].DirRow := -2; + PossibleMoves [KNIGHT].UnitMove[7].DirCol := -1; + PossibleMoves [KNIGHT].UnitMove[8].DirRow := -1; + PossibleMoves [KNIGHT].UnitMove[8].DirCol := -2; + PossibleMoves [ROOK].NumDirections := 4; + PossibleMoves [ROOK].MaxDistance := 7; + PossibleMoves [ROOK].UnitMove[1].DirRow := 1; + PossibleMoves [ROOK].UnitMove[1].DirCol := 0; + PossibleMoves [ROOK].UnitMove[2].DirRow := 0; + PossibleMoves [ROOK].UnitMove[2].DirCol := -1; + PossibleMoves [ROOK].UnitMove[3].DirRow := 0; + PossibleMoves [ROOK].UnitMove[3].DirCol := 1; + PossibleMoves [ROOK].UnitMove[4].DirRow := -1; + PossibleMoves [ROOK].UnitMove[4].DirCol := 0; + PossibleMoves [QUEEN].NumDirections := 8; + PossibleMoves [QUEEN].MaxDistance := 7; + PossibleMoves [KING].NumDirections := 8; + PossibleMoves [KING].MaxDistance := 1; + for index := 1 to 4 do begin + PossibleMoves [QUEEN].UnitMove[index] := PossibleMoves [BISHOP].UnitMove[index]; + PossibleMoves [KING].UnitMove[index] := PossibleMoves [BISHOP].UnitMove[index]; + end; + for index := 1 to 4 do begin + PossibleMoves [QUEEN].UnitMove[index + 4] := PossibleMoves [ROOK].UnitMove[index]; + PossibleMoves [KING].UnitMove[index + 4] := PossibleMoves [ROOK].UnitMove[index]; + end; + + CapturePoints[BLANK] := 0; + CapturePoints[PAWN] := 10; + CapturePoints[KNIGHT] := 35; + CapturePoints[BISHOP] := 35; + CapturePoints[ROOK] := 50; + CapturePoints[QUEEN] := 90; + CapturePoints[KING] := 2000; + + EnemyColor[C_WHITE] := C_BLACK; + EnemyColor[C_BLACK] := C_WHITE; + end; + +{****************************************************************************} +{* Startup Initialize: set the default player info and options, and set *} +{* valid and invalid squares of the board. *} +{****************************************************************************} + procedure StartupInitialize; + var row, col: RowColType; + begin + Randomize; + InitPossibleMoves; + DefaultFileName := 'EXAMPLE'; + + {*** default options ***} + Game.TimeLimit := 0; + Game.EnPassentAllowed := true; + Game.SoundFlag := true; + Game.FlashCount := 2; + Game.WatchDelay := 600; + + {*** default player attributes ***} + with Player[C_WHITE] do begin + Name := 'PERSON'; + IsHuman := true; + LookAhead := 3; + PosEval := false; + end; + with Player[C_BLACK] do begin + Name := 'COMPUTER'; + IsHuman := false; + LookAhead := 3; + PosEval := false; + end; + + {*** initialize board ***} + for col := -1 to 10 do + for row := -1 to 10 do + with Board[row, col] do begin + image := BLANK; + color := C_WHITE; + HasMoved := false; + ValidSquare := false; + end; + for col := 1 to BOARD_SIZE do + for row := 1 to BOARD_SIZE do + Board[row, col].ValidSquare := true; + end; + +{*** end of INIT.PAS include file ***} + \ No newline at end of file diff --git a/applications/fpchess/engines/kcchess/PLAY.PAS b/applications/fpchess/engines/kcchess/PLAY.PAS new file mode 100644 index 000000000..d8c7350ad --- /dev/null +++ b/applications/fpchess/engines/kcchess/PLAY.PAS @@ -0,0 +1,743 @@ +{****************************************************************************} +{* PLAY.PAS: This file contains the computer thinking routines, the *} +{* human player move input routine, and the play game routines. *} +{****************************************************************************} + +{****************************************************************************} +{* Get Computer Move: Given whose turn, return the "best" move for that *} +{* player. Also given is whether to display the best move found so far *} +{* information, and returned is a flag telling if the user typed escape *} +{* to terminate this routine. A recursive depth-first tree search *} +{* algorithm is used, and enhancements like cutting off unnecessary *} +{* subtrees, pre-scanning to select the best candidate moves, and a *} +{* positional evaluation are also included. The actual algorithm is very *} +{* simple, but it is burried in all kinds of special cases. *} +{****************************************************************************} + procedure GetComputerMove (Turn : PieceColorType; Display : boolean; + var HiMovement : MoveType; var Escape : boolean); + var MoveList : MoveListType; + i, MaxDepth, NegInfinity, L1CutOff: integer; + HiScore, SubHiScore, InitialScore, SubEnemyMaxScore : integer; + Movement : MoveType; + Attacked, _Protected : integer; + PosStrength, HiPosStrength : integer; + cstr : string10; + key : char; + PosEvalOn : boolean; + +{----------------------------------------------------------------------------} +{ Search: This routine handles all of the tree searching except the first } +{ level which of the tree which is handled by the main routine. Given the } +{ player, all of his moves are generated, and then each one is made. The } +{ enemy's maximum countermove score is subtracted from the move score, and } +{ this gives the net value for the player making the move. The maximum } +{ net score is remembered and returned by this function. The player's move } +{ is then taken back, and all of his other possible moves are tried in this } +{ same way. If the score of any move exceeds the given cutoff value, then } +{ no other of the player's moves are checked, and the score that exceeded } +{ (or matched) the cutoff value is returned. If the given depth is one or } +{ less, then the enemy's countermoves are not checked, only the points for } +{ taking the pieces, minus the points of the player's piece if the enemy's } +{ piece is _Protected. However, if the current player's move being } +{ considered is a take and it is given that all of moves to that point } +{ have been AllTakes, then enemy countermoves will be checked down to a } +{ given depth of -1. To calculate the enemy's best score in retaliation } +{ to the given player's move, this routine is called recursively with the } +{ enemy as the player to move, and a depth of the one originally given, -1. } +{ The new cutoff value is the score of the move that was just made, minus } +{ the the best score that was found so far. If the enemy's countermoves } +{ score exceeds or matches this countermove value, then the net score of } +{ the original player's move cannot exceed the best found so far, and the } +{ move will be thrown out. The new value for AllTakes is passed on as true } +{ if all moves heretofor have been takes, and the current player's move is } +{ a take. This routine is the core of the computer's 'thinking'. } +{----------------------------------------------------------------------------} + function Search (Turn: PieceColorType; CutOff, Depth: integer; AllTakes : boolean) : integer; + var MoveList: MoveListType; + j, LineScore, Score, BestScore, STCutOff: integer; + Movement: MoveType; + Attacked, _Protected: integer; + NoMoves, TakingPiece: boolean; + begin + {*** get the player's move list ***} + GenMoveList (Turn, MoveList); + NoMoves := true; + BestScore := NegInfinity; + j := MoveList.NumMoves; + + {*** go through all of the possible moves ***} + while (j > 0) do begin + Movement := MoveList.Move[j]; + {*** make the move ***} + MakeMove (Movement, false, Score); + {*** make sure it is legal (not moving into check) ***} + AttackedBy (Player[Turn].KingRow, Player[Turn].KingCol, Attacked, _Protected); + if (Attacked = 0) then begin + NoMoves := false; + if (Score = STALE_SCORE) then + {*** end the search on a stalemate ***} + LineScore := Score + else begin + TakingPiece := Movement.PieceTaken.image <> BLANK; + if (Depth <= 1) and not (AllTakes and TakingPiece and (Depth >= PLUNGE_DEPTH)) then begin + {*** have reached horizon node of tree: score points for piece taken ***} + {*** but assume own piece will be taken if enemy's piece is _Protected ***} + if Movement.PieceTaken.image <> BLANK then begin + AttackedBy (Movement.ToRow, Movement.ToCol, Attacked, _Protected); + if Attacked > 0 then + LineScore := Score - CapturePoints[Movement.PieceMoved.image] + else + LineScore := Score; + end else + LineScore := Score; + end else begin + {*** new cutoff value ***} + STCutOff := Score - BestScore; + {*** recursive call for enemy's best countermoves score ***} + LineScore := Score - Search (EnemyColor[Turn], STCutOff, + Depth - 1, AllTakes and TakingPiece); + end; + end; + {*** remember player's maximum net score ***} + if (LineScore > BestScore) then BestScore := LineScore; + end; + {*** un-do the move and check for cutoff ***} + UnMakeMove (Movement); + if BestScore >= CutOff then j := 0 else j := j - 1; + end; + if (BestScore = STALE_SCORE) then + BestScore := -STALE_SCORE; {stalemate means both players lose} + if NoMoves then + {*** player cannot move ***} + if Player[Turn].InCheck then + {*** if he is in check and cannot move, he loses ***} + BestScore := - CapturePoints[KING] + else + {*** if he is not in check, then both players lose ***} + BestScore := -STALE_SCORE; {prefer stalemate to checkmate} + Search := BestScore; + end; {Search} + +{----------------------------------------------------------------------------} +{ Pre Search: Returns the given move list of the given player, sorted into } +{ the order of ascending score for the given depth to look ahead. The } +{ main computer move routine calls this routine to sort the move list such } +{ that it will probably find a good move early in a greater depth search. } +{----------------------------------------------------------------------------} + procedure PreSearch (Turn : PieceColorType; Depth : integer; var MoveList : MoveListType); + var i, j, Attacked, _Protected : integer; + Score : integer; + Movement : MoveType; + TempScore : integer; + Temp : string80; + PreScanScore : array [1..MOVE_LIST_LEN] of integer; + BestScore : integer; + begin + + {*** display message ***} + {$ifdef FPCHESS_DISPLAY_ON} + if Display then begin + DisplayClearLines (MSG_HINT, 21); + SetTextStyle (TriplexFont, HorizDir, 1); + SetColor (LightGreen); + CenterText (MSG_HINT, 'Pre Scanning...'); + end; + {$endif} + BestScore := NegInfinity; + + {*** scan each move in same order as main routine ***} + for i := MoveList.NumMoves downto 1 do begin + {*** get points for move as in Search routine ***} + Movement := MoveList.Move[i]; + MakeMove (Movement, false, Score); + AttackedBy (Player[Turn].KingRow, Player[Turn].KingCol, Attacked, _Protected); + if (Attacked = 0) then begin + Score := Score - Search (EnemyColor[Turn], Score - BestScore, Depth - 1, false); + {*** remember the score of the move ***} + PreScanScore[i] := Score; + end else + {*** invalid moves get lowest score ***} + PreScanScore[i] := NegInfinity; + UnMakeMove (Movement); + {*** remember best score for purpose of making cutoffs ***} + if (Score > BestScore) then BestScore := Score; + end; + + {*** sort the movelist by score: O(n^2) selection sort used ***} + for i := 1 to MoveList.NumMoves do + for j := i + 1 to MoveList.NumMoves do + if PreScanScore[i] > PreScanScore[j] then begin + Movement := MoveList.Move[i]; + MoveList.Move[i] := MoveList.Move[j]; + MoveList.Move[j] := Movement; + TempScore := PreScanScore[i]; + PreScanScore[i] := PreScanScore[j]; + PreScanScore[j] := TempScore; + end; + end; {PreSearch} + +{----------------------------------------------------------------------------} +{ Eval Pos Strength: Use a number of ad-hoc rules to evaluate the } +{ positional content (rather than material content) of the given move, } +{ considering the current board configuration. Generally important } +{ considerations are friendly piece protection and enemy piece threatening, } +{ as well as number of possible future moves allowed for the player. } +{----------------------------------------------------------------------------} + function EvalPosStrength (Turn : PieceColorType; Movement : MoveType) : integer; + var PosMoveList : MoveListType; + PosStrength : integer; + row, col, KingRow, KingCol : RowColType; + Attacked, _Protected : integer; + CumOwnAttacked, CumOwn_Protected : integer; + CumEnemyAttacked, CumEnemy_Protected : integer; + PawnDir, KingProtection, KingFront : integer; + CheckCol : RowColType; + CastlePossible, IsDevMove : boolean; + NoDevCount : integer; + + begin + {*** points for putting enemy in check ***} + NoDevCount := Game.NonDevMoveCount[Game.MovesPointer]; + if Player[EnemyColor[Turn]].InCheck then begin + if NoDevCount < 9 then + PosStrength := 40 + else begin + if NoDevCount < 12 then + PosStrength := 4 + else + PosStrength := 0; + end; + end else + PosStrength := 0; + + {*** points for pieces in front of king if he is (probably) in castled position ***} + KingProtection := 0; + KingRow := Player[Turn].KingRow; + KingCol := Player[Turn].KingCol; + if ((KingRow = 1) or (KingRow = 8)) and (KingCol <> 5) then begin + if KingRow = 1 then KingFront := 2 else KingFront := 7; + for CheckCol := KingCol - 1 to KingCol + 1 do + with Board[KingFront, CheckCol] do begin + if ValidSquare and (image <> BLANK) and (color = Turn) then + KingProtection := KingProtection + 1; + end; + end; + PosStrength := PosStrength + KingProtection * 3; + + {*** determine if castling is still possible ***} + with Board[KingRow, 1] do + CastlePossible := (image = ROOK) and (not HasMoved); + with Board[KingRow, 8] do + CastlePossible := CastlePossible or ((image = ROOK) and (not HasMoved)); + CastlePossible := CastlePossible and (not Board[KingRow, KingCol].HasMoved); + + {*** points for castling or not moving king/rook if castling still possible ***} + if Movement.PieceMoved.image = KING then begin + if (abs(Movement.FromCol - Movement.ToCol) > 1) + and (KingProtection >= 2) then + PosStrength := PosStrength + 140 + else + if CastlePossible then PosStrength := PosStrength - 80; + end; + + {*** points for pushing a pawn; avoids pushing potential castling protection ***} + IsDevMove := false; + if Movement.PieceMoved.image = PAWN then begin + if ((Movement.FromCol <= 3) or (Movement.FromCol >= 6)) + and ((Movement.FromRow = 1) or (Movement.FromRow = 8)) + and CastlePossible then + PosStrength := PosStrength - 12 + else + PosStrength := PosStrength + 1; + IsDevMove := true; + end; + + {*** points for developmental move if one has not happened in a while ***} + IsDevMove := IsDevMove or (Movement.PieceTaken.image <> BLANK); + if IsDevMove then begin + if NoDevCount >= 9 then + PosStrength := PosStrength + NoDevCount; + end; + + {*** points for number of positions that can be moved to ***} + GenMoveList (Turn, PosMoveList); + PosStrength := PosStrength + PosMoveList.NumMoves; + + {*** points for pieces attacked / _Protected ***} + CumOwnAttacked := 0; + CumOwn_Protected := 0; + CumEnemyAttacked := 0; + CumEnemy_Protected := 0; + for row := 1 to BOARD_SIZE do + for col := 1 to BOARD_SIZE do + if (Board[row, col].image <> BLANK) then begin + AttackedBy (row, col, Attacked, _Protected); + if (Board[row, col].color = Turn) then begin + CumOwnAttacked := CumOwnAttacked + Attacked; + CumOwn_Protected := CumOwn_Protected + _Protected; + end else begin + CumEnemyAttacked := CumEnemyAttacked + Attacked; + CumEnemy_Protected := CumEnemy_Protected + _Protected; + end; + end; + PosStrength := PosStrength + 2 * CumOwn_Protected + - 2 * CumOwnAttacked + 2 * CumEnemyAttacked; + EvalPosStrength := PosStrength; + end; {EvalPosStrength} + +{----------------------------------------------------------------------------} + begin {GetComputerMove} + {*** initialize ***} + PosEvalOn := Player[Turn].PosEval; + MaxDepth := Player[Turn].LookAhead; + NegInfinity := - CapturePoints[KING] * 5; + Escape := false; + HiScore := NegInfinity; + HiPosStrength := -maxint; + HiMovement.FromRow := NULL_MOVE; + + {*** get the move list and scramble it (to randomly choose between ties) ***} + GenMoveList (Turn, MoveList); + RandomizeMoveList (MoveList); + {$ifdef FPCHESS_DISPLAY_ON} + key := GetKey; {*** check for user pressing ESCape ***} + if key <> 'x' then begin + {$endif} + {*** perform pre-scan of two or three-ply if feasible ***} + if MaxDepth >= 3 then begin + if MaxDepth = 3 then + PreSearch (Turn, 2, MoveList) + else + PreSearch (Turn, 3, MoveList); + end; + i := MoveList.NumMoves; + {$ifdef FPCHESS_DISPLAY_ON} + key := GetKey; + end; + {*** check for user pressing ESCape after pre-scan ***} + if key = 'x' then begin + Escape := true; + i := 0; + end; + {$endif} + + {*** check each possible move - same method as in Search ***} + while (i > 0) do + begin + {$ifdef FPCHESS_DISPLAY_ON} + UpDateTime (Turn); {*** player's elapsed time ***} + {$endif} + Movement := MoveList.Move[i]; + MakeMove (Movement, false, InitialScore); + AttackedBy (Player[Turn].KingRow, Player[Turn].KingCol, Attacked, _Protected); + if (Attacked = 0) then begin + if (InitialScore = STALE_SCORE) then + SubHiScore := STALE_SCORE + else begin + {*** display scan count-down ***} + {$ifdef FPCHESS_DISPLAY_ON} + if Display and (MaxDepth >= 3) then begin + DisplayClearLines (MSG_HINT, 21); + SetTextStyle (TriplexFont, HorizDir, 1); + SetColor (LightGreen); + Str (i, cstr); + CenterText (MSG_HINT, 'Scan=' + cstr); + end; + {$endif} + + {*** calculate one-ply score ***} + if (MaxDepth <= 1) then begin + if Movement.PieceTaken.image <> BLANK then begin + AttackedBy (Movement.ToRow, Movement.ToCol, Attacked, _Protected); + if Attacked > 0 then + SubEnemyMaxScore := CapturePoints[Movement.PieceMoved.image] + else + SubEnemyMaxScore := 0; + end else + SubEnemyMaxScore := 0; + end else begin + {*** get net score ***} + if PosEvalOn then + {*** position evaluation needs to check all scores tying for best ***} + L1CutOff := InitialScore - HiScore + 1 + else + L1CutOff := InitialScore - HiScore; + SubEnemyMaxScore := Search (EnemyColor[Turn], L1CutOff, MaxDepth - 1, + Movement.PieceTaken.image <> BLANK); + end; + {*** subtree score ***} + SubHiScore := InitialScore - SubEnemyMaxScore; + end; + + {*** check if new score is highest ***} + if (SubHiScore > HiScore) or (PosEvalOn and (SubHiScore = HiScore)) then begin + if PosEvalOn then + PosStrength := EvalPosStrength (Turn, Movement) + else + PosStrength := 0; + if (SubHiScore > HiScore) or (PosStrength > HiPosStrength) then begin + {*** remember new high score ***} + HiMovement := Movement; + HiScore := SubHiScore; + HiPosStrength := PosStrength; + {*** display new best movement ***} + {$ifdef FPCHESS_DISPLAY_ON} + if Display then begin + DisplayClearLines (MSG_MOVE, 15); + SetTextStyle (DefaultFont, HorizDir, 2); + SetColor (White); + CenterText (MSG_MOVE, MoveStr (HiMovement)); + DisplayClearLines (MSG_SCORE, MSG_POS_EVAL+8-MSG_SCORE); + SetTextStyle (DefaultFont, HorizDir, 1); + SetColor (LightCyan); + Str (HiScore, cstr); + CenterText (MSG_SCORE, 'Score=' + cstr); + Str (SubEnemyMaxScore, cstr); + CenterText (MSG_ENEMY_SCORE, 'EnemyScore=' + cstr); + Str (HiPosStrength, cstr); + CenterText (MSG_POS_EVAL, 'Pos=' + cstr); + end; + {$endif} + {*** for zero-ply lookahead, take first move looked at ***} + if MaxDepth = 0 then i := 1; + end; + end; + end; + UnMakeMove (Movement); + i := i - 1; + + {*** check for escape or forced move by user ***} + {$ifdef FPCHESS_DISPLAY_ON} + key := GetKey; + if key = 'x' then begin + Escape := true; + i := 0; + end else + if (key = 'M') and (HiScore <> NegInfinity) then i := 0; + {$endif} + end; + {*** beep when done thinking ***} + {$ifdef FPCHESS_DISPLAY_ON} + MakeSound (true); + {$endif} + end; {GetComputerMove} + +{****************************************************************************} +{* Get Human Move: Returns the movement as input by the user. Invalid *} +{* moves are screened by this routine. The user moves the cursor to the *} +{* piece to pick up and presses RETURN, and then moves the cursor to the *} +{* location to which the piece is to be moved and presses RETURN. *} +{* Pressing ESCape will exit this routine and return a flag indicating *} +{* escape; pressing H will make the computer suggest a move (hint); and *} +{* pressing A will report the attack/protect count of the cursor square. *} +{* BACKSPACE will delete the from-square and allow the user to select a *} +{* different piece. *} +{****************************************************************************} +{$ifdef FPCHESS_DISPLAY_ON} + procedure GetHumanMove (Turn : PieceColorType; var Movement : MoveType; + var Escape : boolean); + const MSG1X = 510; + var key : char; + HumanMoveList : MoveListType; + ValidMove, BadFromSq, PickingUp : boolean; + i : integer; + +{----------------------------------------------------------------------------} +{ Move Cursor With Hint: Moves the cursor around until the player presses } +{ RETURN or SPACE. Also handles keys A (Attack/protect) and H (Hint). } +{----------------------------------------------------------------------------} + procedure MoveCursorWithHint; + var HintMove : MoveType; + Att, Pro, i : integer; + cstr : string10; + bstr : string80; + + begin + repeat + {*** position cursor ***} + MoveCursor(Player[Turn].CursorRow, Player[Turn].CursorCol, Turn, true, key); + if key = ' ' then key := 'e'; + + {*** check your move list ***} + if key = 'C' then begin + RestoreCrtMode; + writeln ('Your list of possible moves:'); + writeln; + for i := 1 to HumanMoveList.NumMoves do + write (i:2, '.', copy(MoveStr(HumanMoveList.Move[i]) + ' ',1,7)); + writeln; + writeln; + write ('Press any key to continue...'); + key := ReadKey; + SetGraphMode (GraphMode); + DisplayGameScreen; + if not PickingUp then begin + SetTextStyle (DefaultFont, HorizDir, 2); + SetColor (White); + OutTextXY (MSG1X, MSG_MOVE, SqStr(Movement.FromRow, Movement.FromCol) + '-'); + end; + DisplayInstructions (INS_GAME); + end; + + {*** attack / protect count ***} + if key = 'A' then begin + DisplayClearLines (MSG_HINT, 17); + SetTextStyle (TriplexFont, HorizDir, 1); + SetColor (LightRed); + with Player[Turn] do begin + if Board[CursorRow, CursorCol].image = BLANK then + Board[CursorRow, CursorCol].color := Turn; + AttackedBy (CursorRow, CursorCol, Att, Pro); + end; + Str (Att, cstr); + bstr := 'Attk=' + cstr; + Str (Pro, cstr); + bstr := bstr + ' Prot=' + cstr; + CenterText (MSG_HINT, bstr); + end; + + {*** ask computer for hint ***} + if key = 'H' then begin + DisplayClearLines (MSG_HINT, 17); + SetTextStyle (TriplexFont, HorizDir, 1); + SetColor (LightRed); + CenterText (MSG_HINT, 'Thinking...'); + GetComputerMove (Turn, false, HintMove, Escape); + if not Escape then begin + SetTextStyle (TriplexFont, HorizDir, 1); + SetColor (LightRed); + DisplayClearLines (MSG_HINT, 21); + CenterText (MSG_HINT, 'Hint: ' + MoveStr (HintMove)); + end; + end else begin + Escape := key = 'x'; + end; + until (key = 'e') or (key = 'b') or Escape; + end; {MoveCursorWithHint} + +{----------------------------------------------------------------------------} +{ Sq Move: Returns whether the given two moves are equal on the basis of } +{ the from/to squares. } +{----------------------------------------------------------------------------} + function EqMove (M1, M2 : MoveType) : boolean; + begin + EqMove := (M1.FromRow = M2.FromRow) and (M1.FromCol = M2.FromCol) + and (M1.ToRow = M2.ToRow) and (M1.ToCol = M2.ToCol); + end; {EqMove} + +{----------------------------------------------------------------------------} + begin {GetHumanMove} + Escape := false; + + {*** make sure the human has a move to make ***} + GenMoveList (Turn, HumanMoveList); + TrimChecks (Turn, HumanMoveList); + if HumanMoveList.NumMoves = 0 then + Movement.FromRow := NULL_MOVE + else begin + repeat + repeat + {*** get the from-square ***} + DisplayClearLines (MSG_MOVE, 15); + PickingUp := true; + MoveCursorWithHint; + DisplayClearLines (MSG_HINT, 21); + if not Escape then begin + {*** make sure there is a piece of player's color on from-square ***} + with Player[Turn] do + BadFromSq := (Board[CursorRow, CursorCol].image = BLANK) + or (Board[CursorRow, CursorCol].color <> Turn); + if (BadFromSq) then + MakeSound (false); + end; + if (not Escape) and (key <> 'b') and (not BadFromSq) then begin + {*** if all is well, display the from square ***} + Movement.FromRow := Player[Turn].CursorRow; + Movement.FromCol := Player[Turn].CursorCol; + SetTextStyle (DefaultFont, HorizDir, 2); + SetColor (White); + OutTextXY (MSG1X, MSG_MOVE, SqStr(Movement.FromRow, Movement.FromCol) + '-'); + {*** get the to-square ***} + PickingUp := false; + MoveCursorWithHint; + end; + {*** if user typed Backspace, go back to getting the from-square ***} + until ((key = 'e') and (not BadFromSq)) or Escape; + ValidMove := false; + if not Escape then begin + {*** store rest of move attributes ***} + Movement.ToRow := Player[Turn].CursorRow; + Movement.ToCol := Player[Turn].CursorCol; + Movement.PieceMoved := Board[Movement.FromRow, Movement.FromCol]; + Movement.MovedImage := Board[Movement.FromRow, Movement.FromCol].image; + Movement.PieceTaken := Board[Movement.ToRow, Movement.ToCol]; + {*** display the move ***} + DisplayClearLines (MSG_MOVE, 15); + SetTextStyle (DefaultFont, HorizDir, 2); + SetColor (White); + CenterText (MSG_MOVE, MoveStr (Movement)); + + {*** search for the move in the move list ***} + ValidMove := false; + for i := 1 to HumanMoveList.NumMoves do + if EqMove(HumanMoveList.Move[i], Movement) then ValidMove := true; + DisplayClearLines (MSG_HINT, 17); + {*** if not found then move is not valid: give message ***} + if not ValidMove then begin + SetTextStyle (TriplexFont, HorizDir, 1); + SetColor (LightRed); + CenterText (MSG_HINT, 'Invalid Move'); + MakeSound (false); + end; + end; + {*** keep trying until the user gets it right ***} + until ValidMove or Escape; + end; + end; {GetHumanMove} +{$endif} + +{****************************************************************************} +{* Get Player Move: Updates the display, starts the timer, figures out *} +{* whose turn it is, calls either GetHumanMove or GetComputerMove, stops *} +{* the timer, and returns the move selected by the player. *} +{****************************************************************************} +{$ifdef FPCHESS_DISPLAY_ON} + procedure GetPlayerMove (var Movement : MoveType; var Escape : boolean); + var Turn : PieceColorType; + Dummy: longint; + begin + DisplayWhoseMove; + {*** start timer ***} + Dummy := ElapsedTime; + {*** which color is to move ***} + if Game.MoveNum mod 2 = 1 then + Turn := C_WHITE + else + Turn := C_BLACK; + {*** human or computer ***} + if Player[Turn].IsHuman then + GetHumanMove (Turn, Movement, Escape) + else + GetComputerMove (Turn, true, Movement, Escape); + {*** stop timer ***} + UpDateTime (Turn); + end; {GetPlayerMove} +{$endif} + +{****************************************************************************} +{* Play Game: Call for the move of the current player, make it, and go on *} +{* to the next move and the next player. Continue until the game is over *} +{* (for whatever reason) or the user wishes to escape back to the main *} +{* menu. When making the move, this routine checks if it is a pawn *} +{* promotion of a human player. This routine is called from the main menu.*} +{****************************************************************************} +{$ifdef FPCHESS_DISPLAY_ON} + procedure PlayGame; + var Movement : MoveType; + DummyScore : integer; + NoMoves, Escape : boolean; + TimeOutWhite, TimeOutBlack, Stalemate, NoStorage : boolean; + +{----------------------------------------------------------------------------} +{ Check Finish Status: Updates the global variables which tell if the } +{ game is over and for what reason. This routine checks for a player } +{ exceeding the set time limit, the 50-move stalemate rule occuring, or } +{ the game being too long and there being not enough room to store it. } +{----------------------------------------------------------------------------} + procedure CheckFinishStatus; + begin + Game.TimeOutWhite := (Game.TimeLimit > 0) and (Player[C_WHITE].ElapsedTime >= Game.TimeLimit); + Game.TimeOutBlack := (Game.TimeLimit > 0) and (Player[C_BLACK].ElapsedTime >= Game.TimeLimit); + Game.Stalemate := Game.NonDevMoveCount[Game.MovesPointer] >= NON_DEV_MOVE_LIMIT; + Game.NoStorage := Game.MovesStored >= GAME_MOVE_LEN - MAX_LOOKAHEAD + PLUNGE_DEPTH - 2; + end; {CheckFinishStatus} + +{----------------------------------------------------------------------------} +{ Check Human Pawn Promotion: Checks if the given pawn move is a promotion } +{ by a human player. If not, the move is displayed. If so, the move is } +{ displayed as usual, but then the player is asked what piece he wants to } +{ promote the pawn to. The possible responses are: Q = Queen, R = Rook, } +{ B = Bishop, and N = kNight. Then, the piece is promoted. Note that the } +{ computer will always promote to a queen. } +{----------------------------------------------------------------------------} + procedure CheckHumanPawnPromotion (var Movement : MoveType); + var Turn : PieceColorType; + LegalPiece : boolean; + key : char; + NewImage : PieceImageType; + row, col : RowColType; + + begin + {*** check if the destination row is an end row ***} + row := Movement.ToRow; + col := Movement.ToCol; + if (row = 1) or (row = 8) then begin + {*** see if the player is a human ***} + Turn := Movement.PieceMoved.color; + if Player[Turn].IsHuman then begin + {*** show the pawn trotting up to be promoted ***} + Board[row, col].image := PAWN; + DisplayMove (Movement); + DisplaySquare (row, col, true); + DisplayInstructions (INS_PAWN_PROMOTE); + + {*** wait for the user to indicate what to promote to ***} + repeat + repeat key := GetKey until key <> 'n'; + LegalPiece := true; + case key of + 'Q': NewImage := QUEEN; + 'R': NewImage := ROOK; + 'B': NewImage := BISHOP; + 'N': NewImage := KNIGHT; + else begin + {*** buzz at user for pressing wrong key ***} + LegalPiece := false; + MakeSound (false); + end; + end; + until LegalPiece; + + {*** put in the new piece image ***} + Board[row, col].image := NewImage; + Game.Move[Game.MovesPointer].MovedImage := NewImage; + DisplaySquare (row, col, false); + DisplayInstructions (INS_GAME); + end else + DisplayMove (Movement); + end else + DisplayMove (Movement); + end; {CheckHumanPawnPromotion} + +{----------------------------------------------------------------------------} + begin {PlayGame} + Game.GameFinished := false; + DisplayInstructions (INS_GAME); + Escape := false; + NoMoves := false; + CheckFinishStatus; + + {*** play until escape or game over ***} + while not (NoMoves or Escape or Game.TimeOutWhite or Game.TimeOutBlack + or Game.Stalemate or Game.NoStorage) do begin + GetPlayerMove (Movement, Escape); + CheckFinishStatus; + NoMoves := Movement.FromRow = NULL_MOVE; + if not (NoMoves or Escape or Game.TimeOutWhite or Game.TimeOutBlack) then begin + {*** display the move if everything is ok ***} + MakeMove (Movement, true, DummyScore); + if (Movement.PieceMoved.image = PAWN) then + CheckHumanPawnPromotion (Movement) + else + DisplayMove (Movement); + end; + CheckFinishStatus; + end; + + {*** game is over unless the exit reason is the user pressing ESCape ***} + if not Escape then Game.GameFinished := true; + end; {PlayGame} +{$endif} + +{*** end of PLAY.PAS include file ***} + diff --git a/applications/fpchess/engines/kcchess/SETUP.PAS b/applications/fpchess/engines/kcchess/SETUP.PAS new file mode 100644 index 000000000..8b0c34769 --- /dev/null +++ b/applications/fpchess/engines/kcchess/SETUP.PAS @@ -0,0 +1,328 @@ +{****************************************************************************} +{* SETUP.PAS: This file contains the routines to either put the board in *} +{* its normal start of game setup or a custom user defined setup. *} +{****************************************************************************} + +{****************************************************************************} +{* Default Board Set Pieces: Puts the pieces on the board for the normal *} +{* initial configuration. *} +{****************************************************************************} + procedure DefaultBoardSetPieces; + var row, col : RowColType; + begin + {*** put in the row of pawns for each player ***} + for col := 1 to BOARD_SIZE do begin + Board[2,col].image := PAWN; + Board[7,col].image := PAWN; + end; + + {*** blank out the middle of the board ***} + for row := 3 to 6 do + for col := 1 to BOARD_SIZE do + Board[row,col].image := BLANK; + + {*** put in white's major pieces and then copy for black ***} + Board[1,1].image := ROOK; + Board[1,2].image := KNIGHT; + Board[1,3].image := BISHOP; + Board[1,4].image := QUEEN; + Board[1,5].image := KING; + Board[1,6].image := BISHOP; + Board[1,7].image := KNIGHT; + Board[1,8].image := ROOK; + for col := 1 to BOARD_SIZE do + Board[8,col] := Board[1,col]; + + {*** set the piece colors for each side ***} + for row := 1 to 4 do + for col := 1 to BOARD_SIZE do begin + Board[row,col].color := C_WHITE; + Board[row,col].HasMoved := false; + Board[row+4,col].color := C_BLACK; + Board[row+4,col].HasMoved := false; + end; + end; {DefaultBoardSetPieces} + +{****************************************************************************} +{* Default Board: Sets the pieces in their default positions and sets *} +{* some of the player attributes to their defaults. Some of the *} +{* attributes of the game are also set to their startup values. *} +{****************************************************************************} + procedure DefaultBoard; + var row,col : RowColType; + begin + DefaultBoardSetPieces; + + {*** player attributes ***} + with Player[C_WHITE] do begin + CursorRow := 2; + CursorCol := 4; + InCheck := false; + KingRow := 1; + KingCol := 5; + ElapsedTime := 0; + LastMove.FromRow := NULL_MOVE; + end; + + with Player[C_BLACK] do begin + CursorRow := 7; + CursorCol := 4; + InCheck := false; + KingRow := 8; + KingCol := 5; + ElapsedTime := 0; + LastMove.FromRow := NULL_MOVE; + end; + + {*** game attributes ***} + Game.MoveNum := 1; + Game.MovesStored := 0; + Game.GameFinished := false; + Game.MovesPointer := 0; + Game.InCheck[0] := false; + Game.NonDevMoveCount[0] := 0; + end; {DefaultBoard} + +{****************************************************************************} +{* Setup Board: Input a custom configuration of the pieces on the board *} +{* from the user. Will anyone actually read these comments. The user *} +{* moves the cursor to the square to be changed, and presses the key to *} +{* select the piece to put there. The standards K Q R B N P select a *} +{* piece and SPACE blanks out the square. The user can also clear the *} +{* board or ask for the default setup. RETURN saves the changes and asks *} +{* the user for the move number to continue the game from. ESCAPE *} +{* restores the setup upon entry to this routine and exits back to the *} +{* main menu. This routine is called from the main menu. *} +{****************************************************************************} +{$ifdef FPCHESS_DISPLAY_ON} + procedure SetupBoard; + var row, col, ClearRow, ClearCol : RowColType; + key : char; + image : PieceImageType; + LegalKey, InvalidSetup : boolean; + KingCount, Attacked, _Protected, Error, NewMoveNum : integer; + TempStr : string80; + SaveGame : GameType; + +{----------------------------------------------------------------------------} +{ Put Piece On Board: Puts the global Image onto the board at the cursor } +{ position. If the image is not a blank, then the user is asked for the } +{ color (B or W). If the piece is a rook or king being placed in the } +{ piece's startup position, the user is asked if the piece has been moved } +{ since the start of the game. } +{----------------------------------------------------------------------------} + procedure PutPieceOnBoard; + var KingHomeRow, PawnHomeRow : RowColType; + begin + Board[row,col].image := image; + if (image = BLANK) then begin + Board[row,col].color := C_WHITE; + Board[row,col].HasMoved := false; + end else begin + {*** get color ***} + DisplayInstructions (INS_SETUP_COLOR); + repeat + key := GetKey; + until (key = 'B') or (key = 'W'); + + {*** check if piece has moved ***} + if key = 'W' then begin + Board[row,col].color := C_WHITE; + KingHomeRow := 1; + PawnHomeRow := 2; + end else begin + Board[row,col].color := C_BLACK; + KingHomeRow := 8; + PawnHomeRow := 7; + end; + {*** may have to ask if piece has been moved ***} + if ((image = KING) and (row = KingHomeRow) and (col = 5)) + or ((image = ROOK) and (row = KingHomeRow) and ((col = 1) or (col = 8))) then begin + DisplayInstructions (INS_SETUP_MOVED); + repeat + key := GetKey; + until (key = 'Y') or (key = 'N'); + Board[row,col].HasMoved := key = 'Y'; + end else + Board[row, col].HasMoved := not ((image = PAWN) and (row = PawnHomeRow)); + DisplaySquare (row, col, false); + DisplayInstructions (INS_SETUP); + end; + end; {PutPieceOnBoard} + +{----------------------------------------------------------------------------} +{ Check Valid Setup: Makes sure that each player has exactly one king on } +{ the board and updates the Player's King location attributes. Both kings } +{ cannot be in check. The other relevant player attributes are set to. } +{----------------------------------------------------------------------------} + procedure CheckValidSetup; + const NULL_ROW = NULL_MOVE; + var row, col : RowColType; + begin + {*** locate kings ***} + Player[C_WHITE].KingRow := NULL_ROW; + Player[C_BLACK].KingRow := NULL_ROW; + KingCount := 0; + for row := 1 to BOARD_SIZE do + for col := 1 to BOARD_SIZE do + if (Board[row, col].image = KING) then begin + KingCount := KingCount + 1; + Player[Board[row, col].color].KingRow := row; + Player[Board[row, col].color].KingCol := col; + end; + InvalidSetup := (KingCount <> 2) or (Player[C_WHITE].KingRow = NULL_ROW) + or (Player[C_BLACK].KingRow = NULL_ROW); + + {*** make sure both kings are not in check ***} + if not InvalidSetup then begin + AttackedBy (Player[C_WHITE].KingRow, Player[C_WHITE].KingCol, Attacked, _Protected); + Player[C_WHITE].InCheck := (Attacked <> 0); + AttackedBy (Player[C_BLACK].KingRow, Player[C_BLACK].KingCol, Attacked, _Protected); + Player[C_BLACK].InCheck := (Attacked <> 0); + InvalidSetup := (Player[C_WHITE].InCheck) and (Player[C_BLACK].InCheck); + end; + + {*** set other player attributes ***} + Game.GameFinished := false; + with Player[C_WHITE] do begin + CursorRow := 2; + CursorCol := 4; + LastMove.FromRow := NULL_MOVE; + end; + with Player[C_BLACK] do begin + CursorRow := 7; + CursorCol := 4; + LastMove.FromRow := NULL_MOVE; + end; + DisplayConversationArea; + + {*** report invalid setup ***} + if InvalidSetup then begin + SetColor (White); + SetFillStyle (SolidFill, Black); + Bar (0,INSTR_LINE, GetMaxX, GetMaxY); + SetTextStyle (TriplexFont, HorizDir, 3); + OutTextXY (0,INSTR_LINE, 'Illegal Setup - King(s) not set correctly. Press Key.'); + MakeSound (false); + while GetKey = 'n' do ; + DisplayInstructions (INS_SETUP); + end; + end; {CheckValidSetup} + +{----------------------------------------------------------------------------} +{ Get Move Num: Asks the user for the next move number of the game and } +{ whose turn it is to move next. If one of the players is in check, then } +{ that player is the one who must move next and the latter question is not } +{ asked. } +{----------------------------------------------------------------------------} + procedure GetMoveNum; + const ex = 190; ey = 40; + var cx, cy : integer; + begin + DisplayInstructions (INS_SETUP_MOVENUM); + Game.MovesStored := 0; + Game.MovesPointer := 0; + Game.InCheck[0] := (Player[C_WHITE].InCheck) or (Player[C_BLACK].InCheck); + + {*** open up 'window' ***} + cx := (BOARD_X1 + BOARD_X2) div 2; + cy := (BOARD_Y1 + BOARD_Y2) div 2; + SetFillStyle (SolidFill, DarkGray); + Bar (cx - ex, cy - ey, cx + ex, cy + ey); + + {*** ask for move number ***} + SetTextStyle (DefaultFont, HorizDir, 2); + SetColor (Yellow); + Str ((Game.MoveNum + 1) div 2, TempStr); + UserInput (67, cy - 18, 4, 'Move Number: ', TempStr); + Val (TempStr, NewMoveNum, Error); + if Error <> 0 then + NewMoveNum := 1 + else + NewMoveNum := NewMoveNum * 2 - 1; + + {*** ask for whose turn to move next if not in check ***} + if Game.InCheck[0] then begin + if Player[C_BLACK].InCheck then NewMoveNum := NewMoveNum + 1 + end else begin + if Game.MoveNum mod 2 = 1 then + TempStr := 'W' + else + TempStr := 'B'; + UserInput (67, cy + 4, 1, 'Next Player (B/W): ', TempStr); + if TempStr = 'B' then NewMoveNum := NewMoveNum + 1; + end; + + Game.MoveNum := NewMoveNum; + Game.NonDevMoveCount[0] := 0; + DisplayWhoseMove; + end; {GetMoveNum} + +{----------------------------------------------------------------------------} + begin {SetupBoard} + DisplayInstructions (INS_SETUP); + {*** remember old setup incase of escape ***} + SaveGame := Game; + SaveGame.Player := Player; + SaveGame.FinalBoard := Board; + row := 4; + col := 4; + repeat + repeat + {*** move cursor and get key ***} + MoveCursor (row, col, C_WHITE, false, key); + LegalKey := true; + {*** interpret key ***} + case key of + 'K': image := KING; + 'Q': image := QUEEN; + 'R': image := ROOK; + 'B': image := BISHOP; + 'N': image := KNIGHT; + 'P': begin + image := PAWN; + if (row = 1) or (row = 8) then begin + LegalKey := false; + MakeSound (false); + end; + end; + ' ': image := BLANK; + {*** clear board ***} + 'C': begin + for ClearRow := 1 to BOARD_SIZE do + for ClearCol := 1 to BOARD_SIZE do + Board[ClearRow, ClearCol].image := BLANK; + DisplayBoard; + LegalKey := false; + end; + {*** default setup of pieces ***} + 'D': begin + DefaultBoardSetPieces; + DisplayBoard; + LegalKey := false; + end; + else LegalKey := false; + end; + if LegalKey then PutPieceOnBoard; + until (key = 'e') or (key = 'x'); + + {*** make sure setup is valid and repeat above if not ***} + if (key = 'x') then + InvalidSetup := false + else + CheckValidSetup; + until not InvalidSetup; + + if (key = 'x') then begin + {*** restore the old setup if user presses escape ***} + Game := SaveGame; + Player := SaveGame.Player; + Board := SaveGame.FinalBoard; + end else + GetMoveNum; + DisplayBoard; + end; {SetupBoard} +{$endif} + +{*** end of SETUP.PAS include file ***} + diff --git a/applications/fpchess/engines/kcchess/mod_kcchess.pas b/applications/fpchess/engines/kcchess/mod_kcchess.pas index d238cd8a8..8e1ee5ade 100644 --- a/applications/fpchess/engines/kcchess/mod_kcchess.pas +++ b/applications/fpchess/engines/kcchess/mod_kcchess.pas @@ -1,11 +1,13 @@ unit mod_kcchess; -{$mode objfpc}{$H+} +{$mode objfpc} interface uses - Classes, SysUtils; + Classes, SysUtils, + StdCtrls, Forms, Controls, + chessgame, chessmodules; const HIGH = 52; WIDE = 52; SINGLE_IMAGE_SIZE = 1500; BOARD_SIZE = 8; ROW_NAMES = '12345678'; COL_NAMES = 'ABCDEFGH'; @@ -123,6 +125,30 @@ var Game : GameType; ImageStore : ImageTypePt; GraphDriver, GraphMode : integer; {*** for Turbo Pascal graphics ***} +type + + { TKCChessModule } + + TKCChessModule = class(TChessModule) + private + PlayerColor, ComputerColor: PieceColorType; + function FPChessPieceToKCChessImage(APos: TPoint): PieceImageType; + function FPChessPieceToKCChessColor(APos: TPoint): PieceColorType; + public + constructor Create(); + procedure CreateUserInterface(); override; + procedure ShowUserInterface(AParent: TWinControl); override; + procedure HideUserInterface(); override; + procedure FreeUserInterface(); override; + procedure PrepareForGame(); override; + function GetSecondPlayerName(): ansistring; override; + procedure HandleOnMove(AFrom, ATo: TPoint); override; + end; + +{ INIT.PAS } +procedure InitPossibleMoves; +procedure StartupInitialize; +{ MOVES.PAS } procedure AttackedBy (row, col : RowColType; var Attacked, _Protected : integer); procedure GenMoveList (Turn : PieceColorType; var Movelist : MoveListType); procedure MakeMove (Movement : MoveType; PermanentMove : boolean; var Score : integer); @@ -130,19 +156,153 @@ procedure UnMakeMove (var Movement: Movetype); procedure TrimChecks (Turn : PieceColorType; var MoveList : MoveListType); procedure RandomizeMoveList (var MoveList : MoveListType); procedure GotoMove (GivenMoveTo : integer); +{ SETUP.PAS } +procedure DefaultBoardSetPieces; +procedure DefaultBoard; +//procedure SetupBoard; +{ PLAY.PAS } +procedure GetComputerMove (Turn : PieceColorType; Display : boolean; + var HiMovement : MoveType; var Escape : boolean); +// procedure GetHumanMove (Turn : PieceColorType; var Movement : MoveType; +// var Escape : boolean); +// procedure GetPlayerMove (var Movement : MoveType; var Escape : boolean); +// procedure PlayGame; +// procedure CheckFinishStatus; +// procedure CheckHumanPawnPromotion (var Movement : MoveType); implementation {*** include files ***} //{$I MISC.PAS} {*** miscellaneous functions ***} -//{$I INIT.PAS} {*** initialization of global variables ***} +{$I INIT.PAS} {*** initialization of global variables ***} //{$I DISPLAY.PAS} {*** display-oriented routines ***} //{$I INPUT.PAS} {*** keyboard input routines ***} {$I MOVES.PAS} {*** move generation and making routines ***} -//{$I SETUP.PAS} {*** default board and custom setup routines ***} -//{$I PLAY.PAS} {*** computer thinking and player input routines ***} +{$I SETUP.PAS} {*** default board and custom setup routines ***} +{$I PLAY.PAS} {*** computer thinking and player input routines ***} //{$I MENU.PAS} {*** main menu routines ***} +{ TKCChessModule } + +function TKCChessModule.FPChessPieceToKCChessImage(APos: TPoint): PieceImageType; +begin + case vChessGame.Board[APos.X][APos.Y] of + ctEmpty: Result := BLANK; + ctWPawn, ctBPawn: Result := PAWN; + ctWKnight, ctBKnight: Result := KNIGHT; + ctWBishop, ctBBishop: Result := BISHOP; + ctWRook, ctBRook: Result := ROOK; + ctWQueen, ctBQueen: Result := QUEEN; + ctWKing, ctBKing: Result := KING; + end; +end; + +function TKCChessModule.FPChessPieceToKCChessColor(APos: TPoint): PieceColorType; +begin + case vChessGame.Board[APos.X][APos.Y] of + ctEmpty, ctWPawn, ctWKnight, ctWBishop, ctWRook, ctWQueen, ctWKing: Result := C_WHITE; + ctBPawn, ctBKnight, ctBBishop, ctBRook, ctBQueen, ctBKing: Result := C_BLACK; + end; +end; + +constructor TKCChessModule.Create; +begin + inherited Create; + + Description := 'Play against the computer - KCChess Engine'; + Kind := cmkSinglePlayer; +end; + +procedure TKCChessModule.CreateUserInterface; +begin +{ textSecondPlayerName := TStaticText.Create(nil); + textSecondPlayerName.SetBounds(20, 20, 180, 50); + textSecondPlayerName.Caption := 'Name of the second player'; + + editSecondPlayerName := TEdit.Create(nil); + editSecondPlayerName.SetBounds(200, 20, 150, 50); + editSecondPlayerName.Text := 'Second player';} +end; + +procedure TKCChessModule.ShowUserInterface(AParent: TWinControl); +begin +{ textSecondPlayerName.Parent := AParent; + editSecondPlayerName.Parent := AParent;} +end; + +procedure TKCChessModule.HideUserInterface(); +begin +{ textSecondPlayerName.Parent := nil; + editSecondPlayerName.Parent := nil;} +end; + +procedure TKCChessModule.FreeUserInterface(); +begin +{ textSecondPlayerName.Free; + editSecondPlayerName.Free;} +end; + +procedure TKCChessModule.PrepareForGame; +begin + StartupInitialize(); + DefaultBoard(); + + if vChessGame.FirstPlayerIsWhite then + begin + ComputerColor := C_BLACK; + PlayerColor := C_WHITE; + end + else + begin + ComputerColor := C_WHITE; + PlayerColor := C_BLACK; + end; +end; + +function TKCChessModule.GetSecondPlayerName: ansistring; +begin + Result := 'KCChess Engine'; +end; + +procedure TKCChessModule.HandleOnMove(AFrom, ATo: TPoint); +var + UserMovement, AIMovement: MoveType; + Escape: boolean; + Score: Integer; +begin + Escape := False; + Score := 0; + + { First write the movement of the user } + UserMovement.FromRow := AFrom.Y; + UserMovement.FromCol := AFrom.X; + UserMovement.ToRow := ATo.Y; + UserMovement.ToCol := ATo.X; + UserMovement.PieceMoved.image := FPChessPieceToKCChessImage(ATo); + UserMovement.PieceMoved.color := PlayerColor; +// HasMoved : boolean; +// ValidSquare : boolean; + UserMovement.PieceTaken.image := BLANK; + UserMovement.PieceTaken.color := ComputerColor; +// HasMoved : boolean; +// ValidSquare : boolean; + UserMovement.MovedImage := BLANK; + + MakeMove(UserMovement, True, Score); + + { Now get the computer move } + GetComputerMove(ComputerColor, False, AIMovement, Escape); + + { And write it to our board } + + vChessGame.DoMovePiece( + Point(UserMovement.FromRow, UserMovement.FromCol), + Point(UserMovement.ToRow, UserMovement.ToCol), + Point(-1, -1)); +end; + +initialization + RegisterChessModule(TKCChessModule.Create); end. diff --git a/applications/fpchess/mod_fics.pas b/applications/fpchess/mod_fics.pas index e695fca9d..ef1d8fcfd 100644 --- a/applications/fpchess/mod_fics.pas +++ b/applications/fpchess/mod_fics.pas @@ -40,7 +40,6 @@ type procedure HideUserInterface(); override; procedure FreeUserInterface(); override; procedure PrepareForGame(); override; - function IsMovingAllowedNow(): Boolean; override; function GetSecondPlayerName(): string; override; procedure HandleOnMove(AFrom, ATo: TPoint); override; end; @@ -186,11 +185,6 @@ begin *) end; -function TFICSChessModule.IsMovingAllowedNow: Boolean; -begin - Result := not (vChessGame.IsWhitePlayerTurn xor vChessGame.FirstPlayerIsWhite); -end; - function TFICSChessModule.GetSecondPlayerName: string; begin // Result := SecondPlayerName; diff --git a/applications/fpchess/mod_samecomputer.pas b/applications/fpchess/mod_samecomputer.pas index 74babd2d2..47d22c3c3 100644 --- a/applications/fpchess/mod_samecomputer.pas +++ b/applications/fpchess/mod_samecomputer.pas @@ -11,7 +11,7 @@ uses type - { TSinglePlayerChessModule } + { TSameComputerChessModule } TSameComputerChessModule = class(TChessModule) private