pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpchess: Adds more kcchess files

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1872 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-08-30 13:21:59 +00:00
parent 8659c35b4f
commit ec7ac2a03b
7 changed files with 1371 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
applications/fpchess/chessmodules.pas
View File

@ -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;

124
applications/fpchess/engines/kcchess/INIT.PAS Normal file
View File

@ -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 ***}


743
applications/fpchess/engines/kcchess/PLAY.PAS Normal file
View File

@ -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 ***}

328
applications/fpchess/engines/kcchess/SETUP.PAS Normal file
View File

@ -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 ***}

170
applications/fpchess/engines/kcchess/mod_kcchess.pas
View File

@ -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.

6
applications/fpchess/mod_fics.pas
View File

@ -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;

2
applications/fpchess/mod_samecomputer.pas
View File

@ -11,7 +11,7 @@ uses
type
{ TSinglePlayerChessModule }
{ TSameComputerChessModule }
TSameComputerChessModule = class(TChessModule)
private