Patch from Brian, adds pawn promotion + some changes from me

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1882 8e941d3f-bd1b-0410-a28a-d453659cc2b4

applications/fpchess/chessgame.pas

@@ -66,6 +66,7 @@ type
   end;
 
   TOnMoveCallback = procedure (AFrom, ATo: TPoint);
+  TPawnPromotionCallback = function (APawn: TChessTile): TChessTile of object;
 
   { TChessGame }
 
@@ -86,6 +87,7 @@ type
       var AEnpassantSquare, AEnpassantSquareToClear: TPoint) : boolean;
     function ValidatePawnSimpleCapture(AFrom,ATo: TPoint): Boolean;
     function IsSquareOccupied(ASquare: TPoint): Boolean;
+    procedure doPromotion(Position: TPoint);
   public
     Board: TChessBoard;
     msg : String;
@@ -108,6 +110,7 @@ type
     // Callbacks
     OnAfterMove: TOnMoveCallback;  // For the modules
     OnBeforeMove: TOnMoveCallback; // For the UI
+    OnPawnPromotion: TPawnPromotionCallback;
     //
     constructor Create;
     procedure StartNewGame(APlayAsWhite: Boolean; AUseTimer: Boolean; APlayerTime: Integer); overload;
@@ -261,6 +264,8 @@ begin
   DoMovePiece(AFrom, ATo, LEnpassantToClear);
   if Castle then DoCastle();
 
+  if ((Board[ATo.X][Ato.Y]=ctWPawn) and (Ato.Y=8)) or ((Board[ATo.X][Ato.Y]=ctBPawn) and (ATo.Y=1)) then //If a pawn will be promoted
+    doPromotion(Ato);
   //
   UpdateTimes();
 
@@ -286,6 +291,17 @@ begin
     Board[AEnpassantToClear.X][AEnpassantToClear.Y] := ctEmpty;
 end;
 
+procedure TChessGame.doPromotion(Position: TPoint);
+var
+  lNewPiece: TChessTile;
+begin
+  if Assigned(OnPawnPromotion) then
+  begin
+    lNewPiece := OnPawnPromotion(Board[position.X][position.Y]);
+    Board[position.X][position.Y] := lNewPiece;
+  end;
+end;
+
 procedure TChessGame.DoCastle();
 begin
   if CastleCord.X=8 then

applications/fpchess/fpchess.lpi

@@ -68,7 +68,7 @@
         <PackageName Value="LCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="15">
+    <Units Count="16">
       <Unit0>
         <Filename Value="fpchess.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -144,6 +144,13 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="mod_kcchess"/>
       </Unit14>
+      <Unit15>
+        <Filename Value="selectpromotionpiece.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="formPromotion"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="selectPromotionPiece"/>
+      </Unit15>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

applications/fpchess/fpchess.lpr

@@ -8,7 +8,8 @@ uses
   {$ENDIF}{$ENDIF}
   Interfaces, // this includes the LCL widgetset
   Forms, lnetbase, mainform, chessdrawer, chessgame, chessconfig,
-  chesstcputils, chessmodules, mod_samecomputer, mod_fics, mod_kcchess
+  chesstcputils, chessmodules, mod_samecomputer, mod_fics, mod_kcchess, 
+selectPromotionPiece
   {$ifdef FPCHESS_WEBSERVICES}
   ,IDelphiChess_Intf
   {$endif};
@@ -18,6 +19,7 @@ uses
 begin
   Application.Initialize;
   Application.CreateForm(TformChess, formChess);
+  Application.CreateForm(TformPromotion, formPromotion);
   Application.Run;
 end.
 

applications/fpchess/mainform.lfm

@@ -14,7 +14,7 @@ object formChess: TformChess
     Height = 500
     Top = 0
     Width = 360
-    PageIndex = 1
+    PageIndex = 0
     Align = alClient
     TabOrder = 0
     TabStop = True
@@ -45,17 +45,17 @@ object formChess: TformChess
       end
       object Label6: TLabel
         Left = 28
-        Height = 18
+        Height = 17
         Top = 128
-        Width = 56
+        Width = 52
         Caption = 'Start as:'
         ParentColor = False
       end
       object Label7: TLabel
         Left = 80
-        Height = 18
+        Height = 17
         Top = 175
-        Width = 152
+        Width = 150
         Caption = 'minutes for each player'
         ParentColor = False
       end
@@ -70,7 +70,7 @@ object formChess: TformChess
       end
       object editPlayerName: TLabeledEdit
         Left = 88
-        Height = 25
+        Height = 22
         Top = 104
         Width = 120
         EditLabel.AnchorSideLeft.Control = editPlayerName
@@ -78,10 +78,10 @@ object formChess: TformChess
         EditLabel.AnchorSideTop.Side = asrCenter
         EditLabel.AnchorSideRight.Control = editPlayerName
         EditLabel.AnchorSideBottom.Control = editPlayerName
-        EditLabel.Left = 2
-        EditLabel.Height = 18
+        EditLabel.Left = 6
+        EditLabel.Height = 17
         EditLabel.Top = 107
-        EditLabel.Width = 83
+        EditLabel.Width = 79
         EditLabel.Caption = 'Player Name'
         EditLabel.ParentColor = False
         LabelPosition = lpLeft
@@ -89,7 +89,7 @@ object formChess: TformChess
       end
       object comboStartColor: TComboBox
         Left = 88
-        Height = 27
+        Height = 21
         Top = 128
         Width = 120
         ItemHeight = 0
@@ -103,9 +103,9 @@ object formChess: TformChess
       end
       object checkTimer: TCheckBox
         Left = 24
-        Height = 21
+        Height = 18
         Top = 152
-        Width = 220
+        Width = 212
         Caption = 'Set a time limit for each Player'
         Checked = True
         State = cbChecked
@@ -113,7 +113,7 @@ object formChess: TformChess
       end
       object spinPlayerTime: TSpinEdit
         Left = 21
-        Height = 25
+        Height = 16
         Top = 176
         Width = 50
         TabOrder = 4
@@ -121,7 +121,7 @@ object formChess: TformChess
       end
       object comboGameMode: TComboBox
         Left = 8
-        Height = 27
+        Height = 21
         Top = 74
         Width = 346
         ItemHeight = 0
@@ -140,7 +140,7 @@ object formChess: TformChess
       end
       object editLocalIP: TLabeledEdit
         Left = 120
-        Height = 25
+        Height = 22
         Top = 200
         Width = 120
         EditLabel.AnchorSideLeft.Control = editLocalIP
@@ -148,10 +148,10 @@ object formChess: TformChess
         EditLabel.AnchorSideTop.Side = asrCenter
         EditLabel.AnchorSideRight.Control = editLocalIP
         EditLabel.AnchorSideBottom.Control = editLocalIP
-        EditLabel.Left = 15
-        EditLabel.Height = 18
+        EditLabel.Left = 12
+        EditLabel.Height = 17
         EditLabel.Top = 203
-        EditLabel.Width = 102
+        EditLabel.Width = 105
         EditLabel.Caption = 'Your IP Address:'
         EditLabel.ParentColor = False
         LabelPosition = lpLeft
@@ -169,8 +169,8 @@ object formChess: TformChess
       end
     end
     object pageGame: TPage
-      ClientWidth = 360
-      ClientHeight = 500
+      ClientWidth = 1440
+      ClientHeight = 2000
       object labelPos: TLabel
         Left = 8
         Height = 18
@@ -238,8 +238,8 @@ object formChess: TformChess
       end
     end
     object pageWebservice: TPage
-      ClientWidth = 5760
-      ClientHeight = 6928
+      ClientWidth = 11520
+      ClientHeight = 13856
       object Label8: TLabel
         Left = 0
         Height = 32

applications/fpchess/mainform.pas

@@ -1,3 +1,5 @@
+{
+}
 unit mainform;
 
 {$mode objfpc}{$H+}
@@ -9,7 +11,7 @@ uses
   ExtCtrls, ComCtrls, StdCtrls, Buttons, Spin,
   // fpchess
   chessdrawer, chessgame, chessconfig, chesstcputils,
-  chessmodules;
+  chessmodules, selectpromotionpiece;
 
 type
 
@@ -68,6 +70,7 @@ type
     { private declarations }
     function FormatTime(ATimeInMiliseconds: Integer): string;
     procedure UpdateChessModulesUI(ANewIndex: Integer);
+    function HandlePawnPromotion(APiece: TChessTile): TChessTile;
   public
     { public declarations }
     procedure UpdateCaptions;
@@ -133,6 +136,19 @@ begin
   GetChessModule(ANewIndex).ShowUserInterface(panelModules);
 end;
 
+function TformChess.HandlePawnPromotion(APiece: TChessTile): TChessTile;
+var
+  dlgPromotion: TformPromotion;
+begin
+  dlgPromotion := TformPromotion.Create(vChessGame.IsWhitePlayerTurn);
+  try
+    dlgPromotion.ShowModal;
+  finally
+    dlgPromotion.Free;
+    Result := selectPromotionPiece.pieceChosen;
+  end;
+end;
+
 procedure HandleOnMove(AFrom, ATo: TPoint);
 var
   lStr: String;
@@ -196,8 +212,9 @@ begin
   end;
   gChessModulesDebugOutputDestiny := memoDebug;
 
-  // Prepare the move callback
+  // Prepare the callbacks
   vChessGame.OnBeforeMove := @HandleOnMove;
+  vChessGame.OnPawnPromotion := @HandlePawnPromotion;
 end;
 
 procedure TformChess.btnQuitClick(Sender: TObject);