From 2bd91fb276b16fd3ddb505f6c120bc504bdecc76 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Tue, 21 Sep 2010 06:33:18 +0000 Subject: [PATCH] Starts building more structure into the chess game git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1323 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- applications/fpchess/chessconfig.pas | 46 ++++++ applications/fpchess/chessdrawer.pas | 144 +++++++++++++++++ applications/fpchess/chessgame.pas | 124 +++++++++++++++ applications/fpchess/fpchess.lpi | 204 ++++++++++++------------- applications/fpchess/fpchess.lpr | 4 +- applications/fpchess/fpchessdrawer.pas | 59 ------- applications/fpchess/mainform.lfm | 102 ++++++++++--- applications/fpchess/mainform.pas | 48 ++++-- 8 files changed, 524 insertions(+), 207 deletions(-) create mode 100644 applications/fpchess/chessconfig.pas create mode 100644 applications/fpchess/chessdrawer.pas create mode 100644 applications/fpchess/chessgame.pas delete mode 100644 applications/fpchess/fpchessdrawer.pas diff --git a/applications/fpchess/chessconfig.pas b/applications/fpchess/chessconfig.pas new file mode 100644 index 000000000..3edbc8233 --- /dev/null +++ b/applications/fpchess/chessconfig.pas @@ -0,0 +1,46 @@ +unit chessconfig; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + + { TChessConfig } + + TChessConfig = class + public + function GetResourcesDir: string; + function GetCurrentSkinDir: string; + end; + +var + vChessConfig: TChessConfig; + +implementation + +{ TChessConfig } + +function TChessConfig.GetResourcesDir: string; +begin + +end; + +function TChessConfig.GetCurrentSkinDir: string; +begin + Result := GetResourcesDir() + 'skins' + PathDelim + 'classic' + PathDelim; +end; + +initialization + +vChessConfig := TChessConfig.Create; + +finalization + +vChessConfig.Free; + +end. + diff --git a/applications/fpchess/chessdrawer.pas b/applications/fpchess/chessdrawer.pas new file mode 100644 index 000000000..dbb5f5e43 --- /dev/null +++ b/applications/fpchess/chessdrawer.pas @@ -0,0 +1,144 @@ +unit chessdrawer; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Graphics, LCLType, + // + chessgame, chessconfig; + +type + + { TChessDrawer } + + TChessDrawer = class(TCustomControl) + private + imgBoard, + imgWPawn, imgWKnight, imgWBishop, imgWRook, imgWQueen, imgWKing, + imgBPawn, imgBKnight, imgBBishop, imgBRook, imgBQueen, imgBKing: + TPortableNetworkGraphic; + public + constructor Create(AOwner: TComponent); override; + procedure EraseBackground(DC: HDC); override; + procedure Paint; override; + procedure DrawToCanvas(ACanvas: TCanvas); + procedure DrawChessTile(ACanvas: TCanvas; ACol, ARow: Integer; + ATile: TChessTile); + procedure LoadImages(); + end; + +var + vChessDrawer: TChessDrawer; + +implementation + +constructor TChessDrawer.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + imgBoard := TPortableNetworkGraphic.Create; + imgWPawn := TPortableNetworkGraphic.Create; + imgWKnight := TPortableNetworkGraphic.Create; + imgWBishop := TPortableNetworkGraphic.Create; + imgWRook := TPortableNetworkGraphic.Create; + imgWQueen := TPortableNetworkGraphic.Create; + imgWKing := TPortableNetworkGraphic.Create; + imgBPawn := TPortableNetworkGraphic.Create; + imgBKnight := TPortableNetworkGraphic.Create; + imgBBishop := TPortableNetworkGraphic.Create; + imgBRook := TPortableNetworkGraphic.Create; + imgBQueen := TPortableNetworkGraphic.Create; + imgBKing := TPortableNetworkGraphic.Create; +end; + +procedure TChessDrawer.EraseBackground(DC: HDC); +begin + // Uncomment this to enable default background erasing + //inherited EraseBackground(DC); +end; + +procedure TChessDrawer.Paint; +var + x, y: Integer; + Bitmap: TBitmap; +begin + Bitmap := TBitmap.Create; + try + // Initializes the Bitmap Size + Bitmap.Height := Height; + Bitmap.Width := Width; + + DrawToCanvas(Bitmap.Canvas); + + Canvas.Draw(0, 0, Bitmap); + finally + Bitmap.Free; + end; + +// inherited Paint; +end; + +procedure TChessDrawer.DrawToCanvas(ACanvas: TCanvas); +var + col, row: Integer; +begin + // First draw the board + ACanvas.Draw(0, 0, imgBoard); + + // Now all pieces + for col := 1 to 8 do + for row := 1 to 8 do + DrawChessTile(ACanvas, col, row, vChessGame.Board[col][row]); +end; + +procedure TChessDrawer.DrawChessTile(ACanvas: TCanvas; ACol, ARow: Integer; + ATile: TChessTile); +var + X, Y: Integer; +begin + if ATile = ctEmpty then Exit; + + X := (ACol - 1) * INT_CHESSTILE_SIZE; + Y := (8 - ARow) * INT_CHESSTILE_SIZE; + + case ATile of + ctWPawn: ACanvas.Draw(X, Y, imgWPawn); + ctWKnight: ACanvas.Draw(X, Y, imgWKnight); + ctWBishop: ACanvas.Draw(X, Y, imgWBishop); + ctWRook: ACanvas.Draw(X, Y, imgWRook); + ctWQueen: ACanvas.Draw(X, Y, imgWQueen); + ctWKing: ACanvas.Draw(X, Y, imgWKing); + ctBPawn: ACanvas.Draw(X, Y, imgBPawn); + ctBKnight: ACanvas.Draw(X, Y, imgBKnight); + ctBBishop: ACanvas.Draw(X, Y, imgBBishop); + ctBRook: ACanvas.Draw(X, Y, imgBRook); + ctBQueen: ACanvas.Draw(X, Y, imgBQueen); + ctBKing: ACanvas.Draw(X, Y, imgBKing); + end; +end; + +procedure TChessDrawer.LoadImages(); +var + lDir: string; +begin + lDir := vChessConfig.GetCurrentSkinDir(); + + imgBoard.LoadFromFile(lDir + 'board.png'); + imgWPawn.LoadFromFile(lDir + 'wpawn.png'); + imgWKnight.LoadFromFile(lDir + 'wknight.png'); + imgWBishop.LoadFromFile(lDir + 'wbishop.png'); + imgWRook.LoadFromFile(lDir + 'wrook.png'); + imgWQueen.LoadFromFile(lDir + 'wqueen.png'); + imgWKing.LoadFromFile(lDir + 'wking.png'); + imgBPawn.LoadFromFile(lDir + 'bpawn.png'); + imgBKnight.LoadFromFile(lDir + 'bknight.png'); + imgBBishop.LoadFromFile(lDir + 'bbishop.png'); + imgBRook.LoadFromFile(lDir + 'brook.png'); + imgBQueen.LoadFromFile(lDir + 'bqueen.png'); + imgBKing.LoadFromFile(lDir + 'bking.png'); +end; + +end. + diff --git a/applications/fpchess/chessgame.pas b/applications/fpchess/chessgame.pas new file mode 100644 index 000000000..164bd7444 --- /dev/null +++ b/applications/fpchess/chessgame.pas @@ -0,0 +1,124 @@ +unit chessgame; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +const + colA = 1; + colB = 2; + colC = 3; + colD = 4; + colE = 5; + colF = 6; + colG = 7; + colH = 8; + + INT_CHESSTILE_SIZE = 20; + INT_CHESSBOARD_SIZE = 200; + +type + + TChessTile = (ctEmpty, + ctWPawn, ctWKnight, ctWBishop, ctWRook, ctWQueen, ctWKing, + ctBPawn, ctBKnight, ctBBishop, ctBRook, ctBQueen, ctBKing + ); + + {@@ + The index [1][1] refers to the left-bottom corner of the table, + also known as A1. + The first index is the column, to follow the same standard used to + say coordinates, for example: C7 = [3][7] + } + TChessBoard = array[1..8] of array[1..8] of TChessTile; + + { TChessGame } + + TChessGame = class + public + Board: TChessBoard; + procedure StartNewGame(APlayAsWhite: Boolean); overload; + procedure StartNewGame(APlayAsWhite: Integer); overload; + end; + +var + vChessGame: TChessGame; + +implementation + +{ TChessGame } + +procedure TChessGame.StartNewGame(APlayAsWhite: Boolean); +var + lWPawnRow, lWMainRow, lBPawnRow, lBMainRow: Byte; + i: Integer; + j: Integer; +begin + // + if APlayAsWhite then + begin + lWPawnRow := 2; + lWMainRow := 1; + lBPawnRow := 7; + lBMainRow := 8; + end + else + begin + lWPawnRow := 7; + lWMainRow := 8; + lBPawnRow := 2; + lBMainRow := 1; + end; + + // First, clear the board + for i := 1 to 8 do + for j := 1 to 8 do + Board[i][j] := ctEmpty; + + // White pawns + for i := 1 to 8 do + Board[i][lWPawnRow] := ctWPawn; + + // White main row + Board[1][lWMainRow] := ctWRook; + Board[2][lWMainRow] := ctWKnight; + Board[3][lWMainRow] := ctWBishop; + Board[4][lWMainRow] := ctWQueen; + Board[5][lWMainRow] := ctWKing; + Board[6][lWMainRow] := ctWBishop; + Board[7][lWMainRow] := ctWKnight; + Board[8][lWMainRow] := ctWRook; + + // White pawns + for i := 1 to 8 do + Board[i][lBPawnRow] := ctBPawn; + + // Black main row + Board[1][lBMainRow] := ctBRook; + Board[2][lBMainRow] := ctBKnight; + Board[3][lBMainRow] := ctBBishop; + Board[4][lBMainRow] := ctBQueen; + Board[5][lBMainRow] := ctBKing; + Board[6][lBMainRow] := ctBBishop; + Board[7][lBMainRow] := ctBKnight; + Board[8][lBMainRow] := ctBRook; +end; + +procedure TChessGame.StartNewGame(APlayAsWhite: Integer); +begin + StartNewGame(APlayAsWhite = 0); +end; + +initialization + +vChessGame := TChessGame.Create; + +finalization + +vChessGame.Free; + +end. + diff --git a/applications/fpchess/fpchess.lpi b/applications/fpchess/fpchess.lpi index 03e66fa3b..25f142f43 100644 --- a/applications/fpchess/fpchess.lpi +++ b/applications/fpchess/fpchess.lpi @@ -31,102 +31,86 @@ - + - + - + - - - + + + - - - - - - - - - - - - - - - - @@ -139,242 +123,242 @@ - - - - - - - - - - - + - - + + + - - - + + + - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + @@ -385,7 +369,7 @@ - + diff --git a/applications/fpchess/fpchess.lpr b/applications/fpchess/fpchess.lpr index 9668414b0..f8a5f0023 100644 --- a/applications/fpchess/fpchess.lpr +++ b/applications/fpchess/fpchess.lpr @@ -7,14 +7,14 @@ uses cthreads, {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset - Forms, mainform, fpchessdrawer + Forms, mainform, chessdrawer, chessgame, chessconfig { you can add units after this }; {$R *.res} begin Application.Initialize; - Application.CreateForm(TForm1, Form1); + Application.CreateForm(TformChess, formChess); Application.Run; end. diff --git a/applications/fpchess/fpchessdrawer.pas b/applications/fpchess/fpchessdrawer.pas deleted file mode 100644 index e354bec37..000000000 --- a/applications/fpchess/fpchessdrawer.pas +++ /dev/null @@ -1,59 +0,0 @@ -unit fpchessdrawer; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, SysUtils, Controls, Graphics, LCLType; - -type - - { TFPChessDrawer } - - TFPChessDrawer = class(TCustomControl) - public - procedure EraseBackground(DC: HDC); override; - procedure Paint; override; - procedure DrawToCanvas(ACanvas: TCanvas); - end; - -var - vFPChessDrawer: TFPChessDrawer; - -implementation - -procedure TFPChessDrawer.EraseBackground(DC: HDC); -begin - // Uncomment this to enable default background erasing - //inherited EraseBackground(DC); -end; - -procedure TFPChessDrawer.Paint; -var - x, y: Integer; - Bitmap: TBitmap; -begin - Bitmap := TBitmap.Create; - try - // Initializes the Bitmap Size - Bitmap.Height := Height; - Bitmap.Width := Width; - - DrawToCanvas(Bitmap.Canvas); - - Canvas.Draw(0, 0, Bitmap); - finally - Bitmap.Free; - end; - - inherited Paint; -end; - -procedure TFPChessDrawer.DrawToCanvas(ACanvas: TCanvas); -begin - -end; - -end. - diff --git a/applications/fpchess/mainform.lfm b/applications/fpchess/mainform.lfm index 7b0f37da9..e51311434 100644 --- a/applications/fpchess/mainform.lfm +++ b/applications/fpchess/mainform.lfm @@ -1,4 +1,4 @@ -object Form1: TForm1 +object formChess: TformChess Left = 181 Height = 300 Top = 209 @@ -6,13 +6,14 @@ object Form1: TForm1 Caption = 'FP Chess 0.1' ClientHeight = 300 ClientWidth = 240 + OnCreate = FormCreate LCLVersion = '0.9.29' object notebookMain: TUntabbedNotebook Left = 0 Height = 300 Top = 0 Width = 240 - PageIndex = 2 + PageIndex = 0 Align = alClient TabOrder = 0 TabStop = True @@ -46,29 +47,70 @@ object Form1: TForm1 object btnSinglePlayer: TBitBtn Left = 8 Height = 30 - Top = 112 + Top = 152 Width = 224 Caption = 'Play Against the Computer' OnClick = HandleMainScreenButton TabOrder = 0 end - object buttonDirectComm: TBitBtn + object btnDirectComm: TBitBtn Left = 8 Height = 30 - Top = 144 + Top = 184 Width = 226 Caption = 'Play with a friend through a direct connection' - OnClick = buttonDirectCommClick + OnClick = HandleMainScreenButton TabOrder = 1 end object BitBtn3: TBitBtn Left = 8 Height = 30 - Top = 264 + Top = 232 Width = 224 Caption = 'Quit' TabOrder = 2 end + object editPlayerName: TLabeledEdit + Left = 104 + Height = 22 + Top = 80 + Width = 120 + EditLabel.AnchorSideLeft.Control = editPlayerName + EditLabel.AnchorSideTop.Control = editPlayerName + EditLabel.AnchorSideTop.Side = asrCenter + EditLabel.AnchorSideRight.Control = editPlayerName + EditLabel.AnchorSideBottom.Control = editPlayerName + EditLabel.Left = 22 + EditLabel.Height = 17 + EditLabel.Top = 83 + EditLabel.Width = 79 + EditLabel.Caption = 'Player Name' + EditLabel.ParentColor = False + LabelPosition = lpLeft + TabOrder = 3 + end + object Label6: TLabel + Left = 21 + Height = 17 + Top = 112 + Width = 52 + Caption = 'Start as:' + ParentColor = False + end + object comboStartColor: TComboBox + Left = 104 + Height = 21 + Top = 111 + Width = 120 + ItemHeight = 0 + ItemIndex = 0 + Items.Strings = ( + 'White' + 'Black' + ) + TabOrder = 4 + Text = 'White' + end end object pageConfigConnection: TUNBPage Left = 0 @@ -88,8 +130,8 @@ object Form1: TForm1 ParentFont = False end object LabeledEdit1: TLabeledEdit - Left = 104 - Height = 21 + Left = 112 + Height = 22 Top = 72 Width = 120 EditLabel.AnchorSideLeft.Control = LabeledEdit1 @@ -97,10 +139,10 @@ object Form1: TForm1 EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = LabeledEdit1 EditLabel.AnchorSideBottom.Control = LabeledEdit1 - EditLabel.Left = 23 - EditLabel.Height = 14 + EditLabel.Left = 8 + EditLabel.Height = 17 EditLabel.Top = 75 - EditLabel.Width = 78 + EditLabel.Width = 101 EditLabel.Caption = 'Your friend''s IP:' EditLabel.ParentColor = False LabelPosition = lpLeft @@ -108,8 +150,8 @@ object Form1: TForm1 Text = 'LabeledEdit1' end object LabeledEdit2: TLabeledEdit - Left = 104 - Height = 21 + Left = 112 + Height = 22 Top = 104 Width = 120 EditLabel.AnchorSideLeft.Control = LabeledEdit2 @@ -117,10 +159,10 @@ object Form1: TForm1 EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = LabeledEdit2 EditLabel.AnchorSideBottom.Control = LabeledEdit2 - EditLabel.Left = 19 - EditLabel.Height = 14 + EditLabel.Left = 4 + EditLabel.Height = 17 EditLabel.Top = 107 - EditLabel.Width = 82 + EditLabel.Width = 105 EditLabel.Caption = 'Your IP Address:' EditLabel.ParentColor = False LabelPosition = lpLeft @@ -129,11 +171,11 @@ object Form1: TForm1 Text = 'LabeledEdit2' end object BitBtn1: TBitBtn - Left = 16 + Left = 8 Height = 30 - Top = 144 - Width = 208 - Caption = 'BitBtn1' + Top = 184 + Width = 224 + Caption = 'Connect' TabOrder = 2 end end @@ -162,5 +204,23 @@ object Form1: TForm1 TabOrder = 0 end end + object pageGame: TUNBPage + Left = 0 + Height = 300 + Top = 0 + Width = 240 + object Label5: TLabel + Left = 0 + Height = 32 + Top = 8 + Width = 240 + Alignment = taCenter + AutoSize = False + Caption = 'Playing' + Font.Height = -19 + ParentColor = False + ParentFont = False + end + end end end diff --git a/applications/fpchess/mainform.pas b/applications/fpchess/mainform.pas index d11c2de59..110c9febc 100644 --- a/applications/fpchess/mainform.pas +++ b/applications/fpchess/mainform.pas @@ -1,4 +1,4 @@ -unit mainform; +unit mainform; {$mode objfpc}{$H+} @@ -6,29 +6,36 @@ interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, - ComCtrls, StdCtrls, Buttons; + ComCtrls, StdCtrls, Buttons, + // + chessdrawer, chessgame, chessconfig; type - { TForm1 } + { TformChess } - TForm1 = class(TForm) + TformChess = class(TForm) BitBtn1: TBitBtn; btnSinglePlayer: TBitBtn; - buttonDirectComm: TBitBtn; + btnDirectComm: TBitBtn; BitBtn3: TBitBtn; + comboStartColor: TComboBox; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; + Label5: TLabel; + Label6: TLabel; LabeledEdit1: TLabeledEdit; LabeledEdit2: TLabeledEdit; + editPlayerName: TLabeledEdit; pageStart: TUNBPage; pageConfigConnection: TUNBPage; notebookMain: TUntabbedNotebook; pageConnecting: TUNBPage; ProgressBar1: TProgressBar; - procedure buttonDirectCommClick(Sender: TObject); + pageGame: TUNBPage; + procedure FormCreate(Sender: TObject); procedure HandleMainScreenButton(Sender: TObject); private { private declarations } @@ -37,25 +44,36 @@ type end; var - Form1: TForm1; + formChess: TformChess; implementation {$R *.lfm} -{ TForm1 } +{ TformChess } -procedure TForm1.buttonDirectCommClick(Sender: TObject); -begin - notebookMain.PageIndex := 1; -end; - -procedure TForm1.HandleMainScreenButton(Sender: TObject); +procedure TformChess.HandleMainScreenButton(Sender: TObject); begin if Sender = btnSinglePlayer then begin notebookMain.PageIndex := 2; - end; + vChessGame.StartNewGame(comboStartColor.ItemIndex); + end + else if Sender = btnDirectComm then notebookMain.PageIndex := 1; +end; + +procedure TformChess.FormCreate(Sender: TObject); +begin + // Creation of internal components + vChessDrawer := TChessDrawer.Create(Self); + vChessDrawer.Parent := pageGame; + vChessDrawer.Top := 20; + vChessDrawer.Left := 20; + vChessDrawer.Height := INT_CHESSBOARD_SIZE; + vChessDrawer.Width := INT_CHESSBOARD_SIZE; + + // Loading of resources + vChessDrawer.LoadImages(); end; end.