diff --git a/applications/fpchess/chessgame.pas b/applications/fpchess/chessgame.pas index 1eb35c626..0407d1b56 100644 --- a/applications/fpchess/chessgame.pas +++ b/applications/fpchess/chessgame.pas @@ -65,6 +65,8 @@ type PieceMoved, PieceEaten: TChessTile; end; + TOnMoveCallback = procedure (AFrom, ATo: TPoint); + { TChessGame } TChessGame = class @@ -72,7 +74,7 @@ type public Board: TChessBoard; msg : String; - CurrentPlayerIsWhite: Boolean; + FirstPlayerIsWhite, IsWhitePlayerTurn: Boolean; Dragging: Boolean; DragStart, MouseMovePos: TPoint; UseTimer: Boolean; @@ -88,6 +90,8 @@ type IsBlackLeftRoquePossible, IsBlackRightRoquePossible: Boolean; Castle:boolean;//If the move will be a castle. CastleCord: TPoint; + // Callbacks + OnMove: TOnMoveCallback; // constructor Create; procedure StartNewGame(APlayAsWhite: Boolean; AUseTimer: Boolean; APlayerTime: Integer); overload; @@ -142,7 +146,8 @@ var j: Integer; begin UseTimer := AUseTimer; - CurrentPlayerIsWhite := True; + FirstPlayerIsWhite := APlayAsWhite; + IsWhitePlayerTurn := True; WhitePlayerTime := APlayerTime * 60 * 1000; // minutes to milisseconds BlackPlayerTime := APlayerTime * 60 * 1000; // minutes to milisseconds MoveStartTime := Now; @@ -255,7 +260,7 @@ begin UpdateTimes(); // Change player - CurrentPlayerIsWhite := not CurrentPlayerIsWhite; + IsWhitePlayerTurn := not IsWhitePlayerTurn; end; { Really moves the piece without doing any check } @@ -268,6 +273,9 @@ begin // If Enpassant, clear the remaining pawn if AEnpassantToClear.X <> -1 then Board[AEnpassantToClear.X][AEnpassantToClear.Y] := ctEmpty; + + // Notify of the move + if Assigned(OnMove) then OnMove(AFrom, ATo); end; procedure TChessGame.DoCastle(); @@ -424,7 +432,7 @@ begin Result := False; // Verify the possibility of a Roque - if CurrentPlayerIsWhite then + if IsWhitePlayerTurn then begin // Castle to the right if IsWhiteRightRoquePossible and (AFrom.X = 5) and (AFrom.Y = 1) @@ -490,7 +498,7 @@ begin LocalBoard:=Board; - if CurrentPlayerIsWhite then + if IsWhitePlayerTurn then begin if side then begin @@ -553,7 +561,7 @@ begin AEnpassantSquareToClear := Point(-1, -1); Result := False; - if CurrentPlayerIsWhite then + if IsWhitePlayerTurn then begin // Normal move forward if (AFrom.X = ATo.X) and (AFrom.Y = ATo.Y - 1) then @@ -638,7 +646,7 @@ end; function TChessGame.ValidatePawnSimpleCapture(AFrom,ATo: TPoint): Boolean; begin result:=false; - if not CurrentPlayerIsWhite then + if not IsWhitePlayerTurn then begin // Normal capture in the left if (ATo.X = AFrom.X-1) and (ATo.Y = AFrom.Y+1) and IsSquareOccupied(ATo) then @@ -681,7 +689,7 @@ begin lTimeDelta := MilliSecondsBetween(lNow, MoveStartTime); MoveStartTime := lNow; - if CurrentPlayerIsWhite then WhitePlayerTime := WhitePlayerTime - lTimeDelta + if IsWhitePlayerTurn then WhitePlayerTime := WhitePlayerTime - lTimeDelta else BlackPlayerTime := BlackPlayerTime - lTimeDelta; end; @@ -694,7 +702,7 @@ end; // Check if we are moving to either an empty space or to an enemy piece function TChessGame.CheckEndMove(ATo: TPoint): Boolean; begin - if CurrentPlayerIsWhite then + if IsWhitePlayerTurn then Result := Board[ATo.X][ATo.Y] in BlackPiecesOrEmpty else Result := Board[ATo.X][ATo.Y] in WhitePiecesOrEmpty; @@ -707,7 +715,7 @@ end; } function TChessGame.CheckStartMove(AFrom: TPoint): Boolean; begin - if CurrentPlayerIsWhite then + if IsWhitePlayerTurn then Result := Board[AFrom.X][AFrom.Y] in WhitePieces else Result := Board[AFrom.X][AFrom.Y] in BlackPieces; @@ -744,7 +752,7 @@ begin for j:=1 to 8 do begin piecePos := Point(i, j); - if not (CurrentPlayerIsWhite) then + if not (IsWhitePlayerTurn) then begin case Board[i][j] of ctWRook: Result:= ValidateRookMove(piecePos,AKingPos); @@ -779,12 +787,12 @@ begin for i:=1 to 8 do for j:=1 to 8 do - if (CurrentPlayerIsWhite) and (Board[i][j]=ctWKing) then + if (IsWhitePlayerTurn) and (Board[i][j]=ctWKing) then begin Result := Point(i, j); Exit; end - else if (not CurrentPlayerIsWhite) and (Board[i][j]=ctBKing) then + else if (not IsWhitePlayerTurn) and (Board[i][j]=ctBKing) then begin Result := Point(i, j); Exit; diff --git a/applications/fpchess/chessmodules.pas b/applications/fpchess/chessmodules.pas index 757b289f3..5a14fe917 100644 --- a/applications/fpchess/chessmodules.pas +++ b/applications/fpchess/chessmodules.pas @@ -6,7 +6,8 @@ interface uses Classes, SysUtils, - Controls; + Controls, + chessgame; type TChessModuleKind = (cmkSinglePlayer, cmkInternet, cmkAI); @@ -19,21 +20,35 @@ type procedure ShowUserInterface(AParent: TWinControl); virtual; abstract; procedure HideUserInterface(); virtual; abstract; procedure FreeUserInterface(); virtual; abstract; + procedure PrepareForGame(); virtual; abstract; + function IsMovingAllowedNow(): Boolean; virtual; abstract; + function GetSecondPlayerName(): string; virtual; abstract; + procedure HandleOnMove(AFrom, ATo: TPoint); virtual; abstract; end; var - gSelectedModuleIndex: Integer; + gSelectedModuleIndex: Integer = -1; + gChessModulesDebugOutputDestiny: TStrings = nil; procedure RegisterChessModule(AModule: TChessModule); procedure PopulateChessModulesList(AList: TStrings); function GetChessModule(AIndex: Integer): TChessModule; function GetChessModuleCount(): Integer; +procedure ChessModuleDebugLn(AStr: string); implementation var gChessModules: TList; +procedure HandleOnMove(AFrom, ATo: TPoint); +var + lModule: TChessModule; +begin + lModule := GetChessModule(gSelectedModuleIndex); + lModule.HandleOnMove(AFrom, ATo); +end; + procedure RegisterChessModule(AModule: TChessModule); begin if AModule = nil then raise Exception.Create('[RegisterChessModule] Attempted to register a nil module'); @@ -66,9 +81,15 @@ begin Result := gChessModules.Count; end; +procedure ChessModuleDebugLn(AStr: string); +begin + if Assigned(gChessModulesDebugOutputDestiny) then + gChessModulesDebugOutputDestiny.Add(AStr); +end; + initialization gChessModules := TList.Create; - gSelectedModuleIndex := -1; + vChessGame.OnMove := @HandleOnMove; finalization gChessModules.Free; end. diff --git a/applications/fpchess/fpchess.lpi b/applications/fpchess/fpchess.lpi index 1544180cb..1873a9e58 100644 --- a/applications/fpchess/fpchess.lpi +++ b/applications/fpchess/fpchess.lpi @@ -68,7 +68,7 @@ - + @@ -134,6 +134,11 @@ + + + + + diff --git a/applications/fpchess/fpchess.lpr b/applications/fpchess/fpchess.lpr index 00bf5c574..eb7a9f042 100644 --- a/applications/fpchess/fpchess.lpr +++ b/applications/fpchess/fpchess.lpr @@ -8,7 +8,7 @@ uses {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset Forms, lnetbase, mainform, chessdrawer, chessgame, chessconfig, - chesstcputils, chessmodules, mod_singleplayer + chesstcputils, chessmodules, mod_singleplayer, mod_fics {$ifdef FPCHESS_WEBSERVICES} ,IDelphiChess_Intf {$endif}; diff --git a/applications/fpchess/mainform.lfm b/applications/fpchess/mainform.lfm index 7e6dd4e6c..59b485075 100644 --- a/applications/fpchess/mainform.lfm +++ b/applications/fpchess/mainform.lfm @@ -14,7 +14,7 @@ object formChess: TformChess Height = 433 Top = 0 Width = 360 - PageIndex = 0 + PageIndex = 1 Align = alClient TabOrder = 0 TabStop = True @@ -157,11 +157,11 @@ object formChess: TformChess TabOrder = 7 end end - object pageConfigureGame: TPage - ClientWidth = 1440 - ClientHeight = 1732 - object Label3: TLabel - AnchorSideRight.Control = pageConfigureGame + object pageGame: TPage + ClientWidth = 360 + ClientHeight = 433 + object Label5: TLabel + AnchorSideRight.Control = pageGame AnchorSideRight.Side = asrBottom Left = 0 Height = 32 @@ -170,81 +170,6 @@ object formChess: TformChess Alignment = taCenter Anchors = [akTop, akLeft, akRight] AutoSize = False - Caption = 'Configure Game' - Font.Height = -19 - ParentColor = False - ParentFont = False - end - object editRemoteID: TLabeledEdit - Left = 112 - Height = 22 - Top = 104 - Width = 120 - EditLabel.AnchorSideLeft.Control = editRemoteID - EditLabel.AnchorSideTop.Control = editRemoteID - EditLabel.AnchorSideTop.Side = asrCenter - EditLabel.AnchorSideRight.Control = editRemoteID - EditLabel.AnchorSideBottom.Control = editRemoteID - EditLabel.Left = 8 - EditLabel.Height = 17 - EditLabel.Top = 107 - EditLabel.Width = 101 - EditLabel.Caption = 'Your friend''s IP:' - EditLabel.ParentColor = False - LabelPosition = lpLeft - TabOrder = 0 - end - object btnConnect: TBitBtn - Left = 49 - Height = 30 - Top = 264 - Width = 224 - Caption = 'Connect' - OnClick = btnConnectClick - TabOrder = 1 - end - object Label10: TLabel - Left = 8 - Height = 17 - Top = 48 - Width = 170 - Caption = 'Please choose how to play:' - ParentColor = False - end - end - object pageConnecting: TPage - ClientWidth = 11520 - ClientHeight = 13856 - object Label4: TLabel - Left = 0 - Height = 32 - Top = 8 - Width = 240 - Alignment = taCenter - AutoSize = False - Caption = 'Connecting' - Font.Height = -19 - ParentColor = False - ParentFont = False - end - object ProgressBar1: TProgressBar - Left = 8 - Height = 20 - Top = 56 - Width = 100 - TabOrder = 0 - end - end - object pageGame: TPage - ClientWidth = 11520 - ClientHeight = 13856 - object Label5: TLabel - Left = 0 - Height = 32 - Top = 8 - Width = 240 - Alignment = taCenter - AutoSize = False Caption = 'Playing' Font.Height = -19 ParentColor = False @@ -268,8 +193,8 @@ object formChess: TformChess end end object pageWebservice: TPage - ClientWidth = 11520 - ClientHeight = 13856 + ClientWidth = 720 + ClientHeight = 866 object Label8: TLabel Left = 0 Height = 32 @@ -292,7 +217,7 @@ object formChess: TformChess EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = editPlayerName EditLabel.AnchorSideBottom.Control = editPlayerName - EditLabel.Left = -1062 + EditLabel.Left = -6462 EditLabel.Height = 17 EditLabel.Top = 75 EditLabel.Width = 79 diff --git a/applications/fpchess/mainform.pas b/applications/fpchess/mainform.pas index 4bf60f5f0..e0302cea8 100644 --- a/applications/fpchess/mainform.pas +++ b/applications/fpchess/mainform.pas @@ -27,7 +27,6 @@ type { TformChess } TformChess = class(TForm) - btnConnect: TBitBtn; BitBtn3: TBitBtn; btnPlayAgainstAI: TButton; checkTimer: TCheckBox; @@ -36,11 +35,8 @@ type editLocalIP: TLabeledEdit; editWebserviceURL: TLabeledEdit; Label1: TLabel; - Label10: TLabel; labelTime: TLabel; Label2: TLabel; - Label3: TLabel; - Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; @@ -48,19 +44,14 @@ type Label9: TLabel; editWebServiceAI: TLabeledEdit; labelPos: TLabel; - editRemoteID: TLabeledEdit; editPlayerName: TLabeledEdit; pageStart: TPage; - pageConfigureGame: TPage; notebookMain: TNotebook; - pageConnecting: TPage; panelModules: TPanel; - ProgressBar1: TProgressBar; pageGame: TPage; spinPlayerTime: TSpinEdit; timerChessTimer: TTimer; pageWebservice: TPage; - procedure btnConnectClick(Sender: TObject); procedure btnPlayAgainstAIClick(Sender: TObject); procedure comboGameModeSelect(Sender: TObject); procedure FormCreate(Sender: TObject); @@ -85,10 +76,8 @@ implementation const INT_PAGE_START = 0; - INT_PAGE_CONFIGUREGAME = 1; - INT_PAGE_CONNECTING = 2; - INT_PAGE_GAME = 3; - INT_PAGE_AI = 4; + INT_PAGE_GAME = 1; + INT_PAGE_WEBSERVICE = 2; { TformChess } @@ -138,7 +127,7 @@ procedure TformChess.UpdateCaptions; var lStr: string; begin - if vChessGame.CurrentPlayerIsWhite then lStr := 'White playing' + if vChessGame.IsWhitePlayerTurn then lStr := 'White playing' else lStr := 'Black playing'; lStr := lStr + Format(' X: %d Y: %d', @@ -182,12 +171,6 @@ begin end; end; -procedure TformChess.btnConnectClick(Sender: TObject); -begin - notebookMain.PageIndex := INT_PAGE_CONNECTING; - -end; - procedure TformChess.btnPlayAgainstAIClick(Sender: TObject); begin InitializeGameModel(); @@ -217,7 +200,11 @@ procedure TFormDrawerDelegate.HandleMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var lCoords: TPoint; + lModule: TChessModule; begin + lModule := GetChessModule(gSelectedModuleIndex); + if not lModule.IsMovingAllowedNow() then Exit; + vChessGame.Dragging := False; lCoords := vChessGame.ClientToBoardCoords(Point(X, Y)); @@ -231,7 +218,11 @@ procedure TFormDrawerDelegate.HandleMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var lCoords: TPoint; + lModule: TChessModule; begin + lModule := GetChessModule(gSelectedModuleIndex); + if not lModule.IsMovingAllowedNow() then Exit; + lCoords := vChessGame.ClientToBoardCoords(Point(X, Y)); if not vChessGame.CheckStartMove(lCoords) then Exit; diff --git a/applications/fpchess/mod_fics.pas b/applications/fpchess/mod_fics.pas new file mode 100644 index 000000000..e1db0095d --- /dev/null +++ b/applications/fpchess/mod_fics.pas @@ -0,0 +1,107 @@ +{ + For playing through the internet via FICS - Free Internet Chess Server + + Based on this article: + http://blog.mekk.waw.pl/archives/7-How-to-write-a-FICS-bot-part-I.html + + FICS website: + http://www.freechess.org/ +} +unit mod_fics; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + StdCtrls, Forms, Controls, + chessmodules, chessgame; + +type + + { TSinglePlayerChessModule } + + TSinglePlayerChessModule = class(TChessModule) + public + SecondPlayerName: string; + constructor Create(); + procedure CreateUserInterface(); override; + procedure ShowUserInterface(AParent: TWinControl); override; + procedure HideUserInterface(); override; + procedure FreeUserInterface(); override; + procedure PrepareForGame(); override; + function IsMovingAllowedNow(): Boolean; override; + function GetSecondPlayerName(): string; override; + procedure HandleOnMove(AFrom, ATo: TPoint); override; + end; + +implementation + +{ TSinglePlayerChessModule } + +constructor TSinglePlayerChessModule.Create; +begin + inherited Create; + + Description := 'Play online via the Free Internet Chess Server'; + Kind := cmkSinglePlayer; +end; + +procedure TSinglePlayerChessModule.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 TSinglePlayerChessModule.ShowUserInterface(AParent: TWinControl); +begin +{ textSecondPlayerName.Parent := AParent; + editSecondPlayerName.Parent := AParent;} +end; + +procedure TSinglePlayerChessModule.HideUserInterface(); +begin +{ textSecondPlayerName.Parent := nil; + editSecondPlayerName.Parent := nil;} +end; + +procedure TSinglePlayerChessModule.FreeUserInterface; +begin +{ textSecondPlayerName.Free; + editSecondPlayerName.Free;} +end; + +procedure TSinglePlayerChessModule.PrepareForGame; +begin +// SecondPlayerName := editSecondPlayerName.Text; + + +end; + +function TSinglePlayerChessModule.IsMovingAllowedNow: Boolean; +begin + Result := not (vChessGame.IsWhitePlayerTurn xor vChessGame.FirstPlayerIsWhite); +end; + +function TSinglePlayerChessModule.GetSecondPlayerName: string; +begin +// Result := SecondPlayerName; +end; + +// If a move came, it is because the local player did a move +// so send this move and start listening for a move +procedure TSinglePlayerChessModule.HandleOnMove(AFrom, ATo: TPoint); +begin + +end; + +initialization + RegisterChessModule(TSinglePlayerChessModule.Create); +end. + diff --git a/applications/fpchess/mod_singleplayer.pas b/applications/fpchess/mod_singleplayer.pas index 9cbaa231b..93cd3105c 100644 --- a/applications/fpchess/mod_singleplayer.pas +++ b/applications/fpchess/mod_singleplayer.pas @@ -24,6 +24,10 @@ type procedure ShowUserInterface(AParent: TWinControl); override; procedure HideUserInterface(); override; procedure FreeUserInterface(); override; + procedure PrepareForGame(); override; + function IsMovingAllowedNow(): Boolean; override; + function GetSecondPlayerName(): string; override; + procedure HandleOnMove(AFrom, ATo: TPoint); override; end; implementation @@ -67,6 +71,26 @@ begin editSecondPlayerName.Free; end; +procedure TSinglePlayerChessModule.PrepareForGame; +begin + SecondPlayerName := editSecondPlayerName.Text; +end; + +function TSinglePlayerChessModule.IsMovingAllowedNow: Boolean; +begin + Result := True; +end; + +function TSinglePlayerChessModule.GetSecondPlayerName: string; +begin + Result := SecondPlayerName; +end; + +procedure TSinglePlayerChessModule.HandleOnMove(AFrom, ATo: TPoint); +begin + +end; + initialization RegisterChessModule(TSinglePlayerChessModule.Create); end.