fpchess: Moves the computer thinking to a separate thread and creates a configuration for the difficulty

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1901 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-09-05 15:54:52 +00:00
parent da76ec6e93
commit 84337f5721
2 changed files with 92 additions and 61 deletions

View File

@ -435,6 +435,56 @@
{$endif} {$endif}
end; {GetComputerMove} end; {GetComputerMove}
{ TKCChessThread }
procedure TKCChessThread.Execute;
var
UserMovement, AIMovement: MoveType;
Escape: boolean;
Score: Integer;
lMoved: Boolean;
lAnimation: TChessMoveAnimation;
begin
// initialization
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 := TKCChessModule.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);
MakeMove(AIMovement, True, Score);
{ And write it to our board }
lAnimation := TChessMoveAnimation.Create;
lAnimation.AFrom := Point(AIMovement.FromCol, AIMovement.FromRow);
lAnimation.ATo := Point(AIMovement.ToCol, AIMovement.ToRow);
vChessDrawer.AddAnimation(lAnimation);
{ lMoved := vChessGame.MovePiece(
Point(AIMovement.FromCol, AIMovement.FromRow),
Point(AIMovement.ToCol, AIMovement.ToRow));
if not lMoved then raise Exception.Create(Format('Moving failed from %s to %s',
[vChessGame.BoardPosToChessCoords(AFrom), vChessGame.BoardPosToChessCoords(ATo)]));}
end;
{****************************************************************************} {****************************************************************************}
{* Get Human Move: Returns the movement as input by the user. Invalid *} {* 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 *} {* moves are screened by this routine. The user moves the cursor to the *}

View File

@ -11,7 +11,7 @@ interface
uses uses
Classes, SysUtils, Classes, SysUtils,
StdCtrls, Forms, Controls, StdCtrls, Forms, Controls, Spin,
chessgame, chessmodules, chessdrawer; chessgame, chessmodules, chessdrawer;
const HIGH = 52; WIDE = 52; SINGLE_IMAGE_SIZE = 1500; const HIGH = 52; WIDE = 52; SINGLE_IMAGE_SIZE = 1500;
@ -131,14 +131,18 @@ var Game : GameType;
GraphDriver, GraphMode : integer; {*** for Turbo Pascal graphics ***} GraphDriver, GraphMode : integer; {*** for Turbo Pascal graphics ***}
type type
TKCChessThread = class;
{ TKCChessModule } { TKCChessModule }
TKCChessModule = class(TChessModule) TKCChessModule = class(TChessModule)
private private
textDifficulty: TStaticText;
spinDifficulty: TSpinEdit;
PlayerColor, ComputerColor: PieceColorType; PlayerColor, ComputerColor: PieceColorType;
function FPChessPieceToKCChessImage(APos: TPoint): PieceImageType; KCChessThread: TKCChessThread;
function FPChessPieceToKCChessColor(APos: TPoint): PieceColorType; class function FPChessPieceToKCChessImage(APos: TPoint): PieceImageType;
class function FPChessPieceToKCChessColor(APos: TPoint): PieceColorType;
public public
constructor Create(); override; constructor Create(); override;
procedure CreateUserInterface(); override; procedure CreateUserInterface(); override;
@ -150,6 +154,16 @@ type
procedure HandleOnMove(AFrom, ATo: TPoint); override; procedure HandleOnMove(AFrom, ATo: TPoint); override;
end; end;
{ TKCChessThread }
TKCChessThread = class(TThread)
protected
procedure Execute; override;
public
AFrom, ATo: TPoint;
PlayerColor, ComputerColor: PieceColorType;
end;
{ INIT.PAS } { INIT.PAS }
procedure InitPossibleMoves; procedure InitPossibleMoves;
procedure StartupInitialize; procedure StartupInitialize;
@ -192,7 +206,7 @@ implementation
{ TKCChessModule } { TKCChessModule }
function TKCChessModule.FPChessPieceToKCChessImage(APos: TPoint): PieceImageType; class function TKCChessModule.FPChessPieceToKCChessImage(APos: TPoint): PieceImageType;
begin begin
case vChessGame.Board[APos.X][APos.Y] of case vChessGame.Board[APos.X][APos.Y] of
ctEmpty: Result := BLANK; ctEmpty: Result := BLANK;
@ -205,7 +219,7 @@ begin
end; end;
end; end;
function TKCChessModule.FPChessPieceToKCChessColor(APos: TPoint): PieceColorType; class function TKCChessModule.FPChessPieceToKCChessColor(APos: TPoint): PieceColorType;
begin begin
case vChessGame.Board[APos.X][APos.Y] of case vChessGame.Board[APos.X][APos.Y] of
ctEmpty, ctWPawn, ctWKnight, ctWBishop, ctWRook, ctWQueen, ctWKing: Result := C_WHITE; ctEmpty, ctWPawn, ctWKnight, ctWBishop, ctWRook, ctWQueen, ctWKing: Result := C_WHITE;
@ -225,31 +239,33 @@ end;
procedure TKCChessModule.CreateUserInterface; procedure TKCChessModule.CreateUserInterface;
begin begin
{ textSecondPlayerName := TStaticText.Create(nil); textDifficulty := TStaticText.Create(nil);
textSecondPlayerName.SetBounds(20, 20, 180, 50); textDifficulty.SetBounds(20, 20, 180, 50);
textSecondPlayerName.Caption := 'Name of the second player'; textDifficulty.Caption := 'Difficulty (3=easiest)';
editSecondPlayerName := TEdit.Create(nil); spinDifficulty := TSpinEdit.Create(nil);
editSecondPlayerName.SetBounds(200, 20, 150, 50); spinDifficulty.SetBounds(200, 20, 50, 50);
editSecondPlayerName.Text := 'Second player';} spinDifficulty.Value := 3;
spinDifficulty.MinValue := 3;
spinDifficulty.MaxValue := 9;
end; end;
procedure TKCChessModule.ShowUserInterface(AParent: TWinControl); procedure TKCChessModule.ShowUserInterface(AParent: TWinControl);
begin begin
{ textSecondPlayerName.Parent := AParent; textDifficulty.Parent := AParent;
editSecondPlayerName.Parent := AParent;} spinDifficulty.Parent := AParent;
end; end;
procedure TKCChessModule.HideUserInterface(); procedure TKCChessModule.HideUserInterface();
begin begin
{ textSecondPlayerName.Parent := nil; textDifficulty.Parent := nil;
editSecondPlayerName.Parent := nil;} spinDifficulty.Parent := nil;
end; end;
procedure TKCChessModule.FreeUserInterface(); procedure TKCChessModule.FreeUserInterface();
begin begin
{ textSecondPlayerName.Free; textDifficulty.Free;
editSecondPlayerName.Free;} spinDifficulty.Free;
end; end;
procedure TKCChessModule.PrepareForGame; procedure TKCChessModule.PrepareForGame;
@ -269,6 +285,8 @@ begin
ComputerColor := C_WHITE; ComputerColor := C_WHITE;
PlayerColor := C_BLACK; PlayerColor := C_BLACK;
end; end;
Player[ComputerColor].LookAhead := spinDifficulty.Value;
end; end;
function TKCChessModule.GetSecondPlayerName: ansistring; function TKCChessModule.GetSecondPlayerName: ansistring;
@ -277,51 +295,14 @@ begin
end; end;
procedure TKCChessModule.HandleOnMove(AFrom, ATo: TPoint); procedure TKCChessModule.HandleOnMove(AFrom, ATo: TPoint);
var
UserMovement, AIMovement: MoveType;
Escape: boolean;
Score: Integer;
lMoved: Boolean;
lAnimation: TChessMoveAnimation;
begin begin
// initialization KCChessThread := TKCChessThread.Create(True);
Escape := False; KCChessThread.FreeOnTerminate := True;
Score := 0; KCChessThread.AFrom := AFrom;
KCChessThread.ATo := ATo;
{ First write the movement of the user } KCChessThread.PlayerColor := PlayerColor;
UserMovement.FromRow := AFrom.Y; KCChessThread.ComputerColor := ComputerColor;
UserMovement.FromCol := AFrom.X; KCChessThread.Resume();
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);
MakeMove(AIMovement, True, Score);
{ And write it to our board }
lAnimation := TChessMoveAnimation.Create;
lAnimation.AFrom := Point(AIMovement.FromCol, AIMovement.FromRow);
lAnimation.ATo := Point(AIMovement.ToCol, AIMovement.ToRow);
vChessDrawer.AddAnimation(lAnimation);
{ lMoved := vChessGame.MovePiece(
Point(AIMovement.FromCol, AIMovement.FromRow),
Point(AIMovement.ToCol, AIMovement.ToRow));
if not lMoved then raise Exception.Create(Format('Moving failed from %s to %s',
[vChessGame.BoardPosToChessCoords(AFrom), vChessGame.BoardPosToChessCoords(ATo)]));}
end; end;
initialization initialization