From 7fad6b83aa29247173adb645bde4e18f71389695 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Thu, 23 Sep 2010 15:40:21 +0000 Subject: [PATCH] fpchess is now playable in hotseat mode git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1327 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- applications/fpchess/chessgame.pas | 44 +++++++++-- applications/fpchess/fpchess.lpi | 114 ++++++++++++++--------------- applications/fpchess/mainform.lfm | 97 +++++++++++++++++------- applications/fpchess/mainform.pas | 34 +++++++-- 4 files changed, 192 insertions(+), 97 deletions(-) diff --git a/applications/fpchess/chessgame.pas b/applications/fpchess/chessgame.pas index 08e109a0e..228974064 100644 --- a/applications/fpchess/chessgame.pas +++ b/applications/fpchess/chessgame.pas @@ -5,7 +5,7 @@ unit chessgame; interface uses - Classes, SysUtils, fpimage; + Classes, SysUtils, fpimage, dateutils; const colA = 1; @@ -50,11 +50,17 @@ type CurrentPlayerIsWhite: Boolean; Dragging: Boolean; DragStart, MouseMovePos: TPoint; - procedure StartNewGame(APlayAsWhite: Boolean); overload; - procedure StartNewGame(APlayAsWhite: Integer); overload; + UseTimer: Boolean; + WhitePlayerTime: Integer; // milisseconds + BlackPlayerTime: Integer; // milisseconds + MoveStartTime: TDateTime; + constructor Create; + procedure StartNewGame(APlayAsWhite: Boolean; AUseTimer: Boolean; APlayerTime: Integer); overload; + procedure StartNewGame(APlayAsWhite: Integer; AUseTimer: Boolean; APlayerTime: Integer); overload; function ClientToBoardCoords(AClientCoords: TPoint): TPoint; function CheckStartMove(AFrom: TPoint): Boolean; function MovePiece(AFrom, ATo: TPoint): Boolean; + procedure UpdateTimes(); end; var @@ -64,13 +70,24 @@ implementation { TChessGame } -procedure TChessGame.StartNewGame(APlayAsWhite: Boolean); +constructor TChessGame.Create; +begin + inherited Create; + + +end; + +procedure TChessGame.StartNewGame(APlayAsWhite: Boolean; AUseTimer: Boolean; APlayerTime: Integer); var lWPawnRow, lWMainRow, lBPawnRow, lBMainRow: Byte; i: Integer; j: Integer; begin + UseTimer := AUseTimer; CurrentPlayerIsWhite := True; + WhitePlayerTime := APlayerTime * 60 * 1000; // minutes to milisseconds + BlackPlayerTime := APlayerTime * 60 * 1000; // minutes to milisseconds + MoveStartTime := Now; // if APlayAsWhite then @@ -122,9 +139,9 @@ begin Board[8][lBMainRow] := ctBRook; end; -procedure TChessGame.StartNewGame(APlayAsWhite: Integer); +procedure TChessGame.StartNewGame(APlayAsWhite: Integer; AUseTimer: Boolean; APlayerTime: Integer); begin - StartNewGame(APlayAsWhite = 0); + StartNewGame(APlayAsWhite = 0, AUseTimer, APlayerTime); end; { @@ -144,11 +161,26 @@ begin Board[ATo.X][ATo.Y] := Board[AFrom.X][AFrom.Y]; Board[AFrom.X][AFrom.Y] := ctEmpty; + UpdateTimes(); CurrentPlayerIsWhite := not CurrentPlayerIsWhite; Result := True; end; +procedure TChessGame.UpdateTimes(); +var + lNow: TDateTime; + lTimeDelta: Integer; +begin + lNow := Now; + + lTimeDelta := MilliSecondsBetween(lNow, MoveStartTime); + MoveStartTime := lNow; + + if CurrentPlayerIsWhite then WhitePlayerTime := WhitePlayerTime - lTimeDelta + else BlackPlayerTime := BlackPlayerTime - lTimeDelta; +end; + function TChessGame.ClientToBoardCoords(AClientCoords: TPoint): TPoint; begin Result.X := 1 + AClientCoords.X div INT_CHESSTILE_SIZE; diff --git a/applications/fpchess/fpchess.lpi b/applications/fpchess/fpchess.lpi index 54b3de982..a6925a4d0 100644 --- a/applications/fpchess/fpchess.lpi +++ b/applications/fpchess/fpchess.lpi @@ -36,7 +36,7 @@ - + @@ -44,11 +44,12 @@ + - - - + + + @@ -127,7 +128,7 @@ - + @@ -165,9 +166,9 @@ - + - + @@ -221,12 +222,11 @@ - - - - + + + @@ -237,7 +237,7 @@ - + @@ -290,124 +290,124 @@ - - + + - - + + - - + + - + - - + + - + - - + + - + - + - + - - + + - + - + - + - + - - + + - - + + - - + + - - + + - - + + - + - + - + - - + + - + - + - - + + - - + + - - + + - + diff --git a/applications/fpchess/mainform.lfm b/applications/fpchess/mainform.lfm index 43c973f30..554ac2b50 100644 --- a/applications/fpchess/mainform.lfm +++ b/applications/fpchess/mainform.lfm @@ -2,29 +2,29 @@ object formChess: TformChess Left = 181 Height = 433 Top = 209 - Width = 240 + Width = 360 Caption = 'FP Chess 0.1' ClientHeight = 433 - ClientWidth = 240 + ClientWidth = 360 OnCreate = FormCreate LCLVersion = '0.9.29' object notebookMain: TUntabbedNotebook Left = 0 Height = 433 Top = 0 - Width = 240 - PageIndex = 3 + Width = 360 + PageIndex = 0 Align = alClient TabOrder = 0 TabStop = True object pageStart: TUNBPage - ClientWidth = 240 - ClientHeight = 300 + ClientWidth = 360 + ClientHeight = 433 object Label1: TLabel Left = 0 Height = 32 Top = 8 - Width = 240 + Width = 360 Alignment = taCenter AutoSize = False Caption = 'Welcome to FP Chess 0.1' @@ -36,51 +36,52 @@ object formChess: TformChess Left = 8 Height = 30 Top = 40 - Width = 224 + Width = 352 AutoSize = False Caption = 'Please choose what kind of game you would like to play:' ParentColor = False WordWrap = True end object btnSinglePlayer: TBitBtn - Left = 8 + Left = 64 Height = 30 - Top = 152 + Top = 200 Width = 224 Caption = 'Play Against the Computer' + Enabled = False OnClick = HandleMainScreenButton TabOrder = 0 end object btnDirectComm: TBitBtn - Left = 8 + Left = 62 Height = 30 - Top = 184 + Top = 288 Width = 226 Caption = 'Play with a friend through a direct connection' OnClick = HandleMainScreenButton TabOrder = 1 end object BitBtn3: TBitBtn - Left = 8 + Left = 64 Height = 30 - Top = 232 + Top = 336 Width = 224 Caption = 'Quit' TabOrder = 2 end object editPlayerName: TLabeledEdit - Left = 104 + Left = 88 Height = 21 - Top = 80 + Top = 72 Width = 120 EditLabel.AnchorSideLeft.Control = editPlayerName EditLabel.AnchorSideTop.Control = editPlayerName EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = editPlayerName EditLabel.AnchorSideBottom.Control = editPlayerName - EditLabel.Left = 40 + EditLabel.Left = 24 EditLabel.Height = 14 - EditLabel.Top = 83 + EditLabel.Top = 75 EditLabel.Width = 61 EditLabel.Caption = 'Player Name' EditLabel.ParentColor = False @@ -88,17 +89,17 @@ object formChess: TformChess TabOrder = 3 end object Label6: TLabel - Left = 21 + Left = 28 Height = 14 - Top = 112 + Top = 104 Width = 43 Caption = 'Start as:' ParentColor = False end object comboStartColor: TComboBox - Left = 104 + Left = 88 Height = 21 - Top = 111 + Top = 104 Width = 120 ItemHeight = 13 ItemIndex = 0 @@ -109,10 +110,45 @@ object formChess: TformChess TabOrder = 4 Text = 'White' end + object checkTimer: TCheckBox + Left = 24 + Height = 17 + Top = 136 + Width = 163 + Caption = 'Set a time limit for each Player' + Checked = True + State = cbChecked + TabOrder = 5 + end + object spinPlayerTime: TSpinEdit + Left = 21 + Height = 21 + Top = 160 + Width = 50 + TabOrder = 6 + Value = 30 + end + object Label7: TLabel + Left = 80 + Height = 14 + Top = 163 + Width = 114 + Caption = 'minutes for each player' + ParentColor = False + end + object btnHotSeat: TBitBtn + Left = 64 + Height = 30 + Top = 240 + Width = 224 + Caption = 'Play with a friend in the same Computer' + OnClick = HandleMainScreenButton + TabOrder = 7 + end end object pageConfigConnection: TUNBPage - ClientWidth = 480 - ClientHeight = 600 + ClientWidth = 960 + ClientHeight = 1200 object Label3: TLabel Left = 0 Height = 32 @@ -176,8 +212,8 @@ object formChess: TformChess end end object pageConnecting: TUNBPage - ClientWidth = 480 - ClientHeight = 600 + ClientWidth = 960 + ClientHeight = 1200 object Label4: TLabel Left = 0 Height = 32 @@ -199,8 +235,8 @@ object formChess: TformChess end end object pageGame: TUNBPage - ClientWidth = 240 - ClientHeight = 433 + ClientWidth = 480 + ClientHeight = 866 object Label5: TLabel Left = 0 Height = 32 @@ -223,4 +259,9 @@ object formChess: TformChess end end end + object timerChessTimer: TTimer + OnTimer = timerChessTimerTimer + left = 296 + top = 152 + end end diff --git a/applications/fpchess/mainform.pas b/applications/fpchess/mainform.pas index 54b09c157..a4d7a144a 100644 --- a/applications/fpchess/mainform.pas +++ b/applications/fpchess/mainform.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, - ExtCtrls, ComCtrls, StdCtrls, Buttons, + ExtCtrls, ComCtrls, StdCtrls, Buttons, Spin, // chessdrawer, chessgame, chessconfig; @@ -30,6 +30,8 @@ type btnSinglePlayer: TBitBtn; btnDirectComm: TBitBtn; BitBtn3: TBitBtn; + btnHotSeat: TBitBtn; + checkTimer: TCheckBox; comboStartColor: TComboBox; Label1: TLabel; Label2: TLabel; @@ -37,6 +39,7 @@ type Label4: TLabel; Label5: TLabel; Label6: TLabel; + Label7: TLabel; labelPos: TLabel; LabeledEdit1: TLabeledEdit; LabeledEdit2: TLabeledEdit; @@ -47,8 +50,11 @@ type pageConnecting: TUNBPage; ProgressBar1: TProgressBar; pageGame: TUNBPage; + spinPlayerTime: TSpinEdit; + timerChessTimer: TTimer; procedure FormCreate(Sender: TObject); procedure HandleMainScreenButton(Sender: TObject); + procedure timerChessTimerTimer(Sender: TObject); private { private declarations } public @@ -71,20 +77,36 @@ begin if Sender = btnSinglePlayer then begin notebookMain.PageIndex := 3; - vChessGame.StartNewGame(comboStartColor.ItemIndex); + vChessGame.StartNewGame(comboStartColor.ItemIndex, checkTimer.Checked, spinPlayerTime.Value); + end + else if Sender = btnHotSeat then + begin + notebookMain.PageIndex := 3; + vChessGame.StartNewGame(comboStartColor.ItemIndex, checkTimer.Checked, spinPlayerTime.Value); end else if Sender = btnDirectComm then notebookMain.PageIndex := 1; end; +procedure TformChess.timerChessTimerTimer(Sender: TObject); +begin + vChessGame.UpdateTimes(); + UpdateCaptions(); +end; + procedure TformChess.UpdateCaptions; var - CurPlayerStr: string; + lStr: string; begin - if vChessGame.CurrentPlayerIsWhite then CurPlayerStr := 'White playing' - else CurPlayerStr := 'Black playing'; + if vChessGame.CurrentPlayerIsWhite then lStr := 'White playing' + else lStr := 'Black playing'; - formChess.labelPos.Caption := Format(CurPlayerStr + ' X: %d Y: %d', + lStr := lStr + Format(' X: %d Y: %d', [vChessGame.MouseMovePos.X, vChessGame.MouseMovePos.Y]); + + lStr := lStr + Format(' White time: %d Black time: %d', + [vChessGame.WhitePlayerTime, vChessGame.BlackPlayerTime]); + + formChess.labelPos.Caption := lStr; end; procedure TformChess.FormCreate(Sender: TObject);