{ } unit mainform; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls, StdCtrls, Buttons, Spin, // fpchess chessdrawer, chessgame, chessconfig, chesstcputils, chessmodules, selectpromotionpiece; type { TFormDrawerDelegate } TFormDrawerDelegate = class(TChessDrawerDelegate) public procedure HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); override; procedure HandleMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure HandleMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; end; { TformChess } TformChess = class(TForm) btnGameNewGame: TBitBtn; btnResign: TBitBtn; btnQuitGame: TBitBtn; btnQuit: TBitBtn; btnStartGame: TBitBtn; btnPlayAgainstAI: TButton; checkTimer: TCheckBox; comboGameMode: TComboBox; comboStartColor: TComboBox; editLocalIP: TLabeledEdit; editWebserviceURL: TLabeledEdit; Label1: TLabel; labelMode: TLabel; labelTime: TLabel; Label2: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; Label9: TLabel; editWebServiceAI: TLabeledEdit; labelPos: TLabel; editPlayerName: TLabeledEdit; memoDebug: TMemo; pageStart: TPage; notebookMain: TNotebook; panelModules: TPanel; pageGame: TPage; spinPlayerTime: TSpinEdit; timerChessTimer: TTimer; pageWebservice: TPage; procedure btnGameNewGameClick(Sender: TObject); procedure btnQuitClick(Sender: TObject); procedure btnQuitGameClick(Sender: TObject); procedure btnStartGameClick(Sender: TObject); procedure comboGameModeSelect(Sender: TObject); procedure FormCreate(Sender: TObject); procedure timerChessTimerTimer(Sender: TObject); private { private declarations } function FormatTime(ATimeInMiliseconds: Integer): string; procedure UpdateChessModulesUI(ANewIndex: Integer); function HandlePawnPromotion(APiece: TChessTile): TChessTile; public { public declarations } procedure UpdateCaptions; procedure InitializeGameModel; end; var formChess: TformChess; vFormDrawerDelegate: TFormDrawerDelegate; procedure HandleOnMove(AFrom, ATo: TPoint); implementation {$R *.lfm} const INT_PAGE_START = 0; INT_PAGE_GAME = 1; INT_PAGE_WEBSERVICE = 2; { TformChess } procedure TformChess.timerChessTimerTimer(Sender: TObject); begin vChessGame.UpdateTimes(); UpdateCaptions(); vChessDrawer.HandleOnTimer(Sender); GetCurrentChessModule().HandleOnTimer(); end; function TformChess.FormatTime(ATimeInMiliseconds: Integer): string; var lTimePart: Integer; begin Result := ''; // Hours lTimePart := ATimeInMiliseconds div (60*60*1000); if lTimePart > 0 then Result := IntToStr(lTimePart) + 'h'; // Minutes lTimePart := (ATimeInMiliseconds div (60*1000)) mod 60; if (lTimePart > 0) or (Result <> '') then Result := Result + IntToStr(lTimePart) + 'm'; // Seconds lTimePart := (ATimeInMiliseconds div (1000)) mod 60; Result := Result + IntToStr(lTimePart) + 's'; // Miliseconds lTimePart := ATimeInMiliseconds mod (1000); Result := Result + IntToStr(lTimePart); end; procedure TformChess.UpdateChessModulesUI(ANewIndex: Integer); var lModule: TChessModule; begin if ANewIndex = gSelectedModuleIndex then Exit; lModule := GetChessModule(gSelectedModuleIndex); if lModule <> nil then lModule.HideUserInterface(); 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; begin lStr := vChessGame.GetCurrentPlayerColor(); lStr := Format('%s executed the move %s-%s', [lStr, vChessGame.BoardPosToChessCoords(AFrom), vChessGame.BoardPosToChessCoords(ATo)]); formChess.MemoDebug.Lines.Add(lStr); end; procedure TformChess.UpdateCaptions; var lStr, lStr2: string; begin if vChessGame.IsWhitePlayerTurn then lStr := 'White playing' else lStr := 'Black playing'; lStr2 := vChessGame.BoardPosToChessCoords(vChessGame.MouseMovePos); lStr := lStr + Format(' X: %d Y: %d = %s', [vChessGame.MouseMovePos.X, vChessGame.MouseMovePos.Y, lStr2]); formChess.labelPos.Caption := lStr; lStr := Format('White time: %s Black time: %s', [FormatTime(vChessGame.WhitePlayerTime), FormatTime(vChessGame.BlackPlayerTime)]); formChess.labelTime.Caption := lStr; lStr := GetChessModule(gSelectedModuleIndex).PlayingDescription; formChess.labelMode.Caption := lStr; end; procedure TformChess.InitializeGameModel; begin vChessGame.StartNewGame(comboStartColor.ItemIndex, checkTimer.Checked, spinPlayerTime.Value); end; procedure TformChess.FormCreate(Sender: TObject); begin // Creation of internal components vChessDrawer := TChessDrawer.Create(Self); vChessDrawer.Parent := pageGame; vChessDrawer.Top := 50; vChessDrawer.Left := 20; vChessDrawer.Height := INT_CHESSBOARD_SIZE; vChessDrawer.Width := INT_CHESSBOARD_SIZE; vChessDrawer.SetDelegate(vFormDrawerDelegate); // Loading of resources vChessDrawer.LoadImages(); // Prepare the modules view InitializeGameModel(); editLocalIP.Text := ChessGetLocalIP(); PopulateChessModulesList(comboGameMode.Items); if GetChessModuleCount() >= 1 then begin comboGameMode.ItemIndex := 0; UpdateChessModulesUI(0); gSelectedModuleIndex := 0; end; gChessModulesDebugOutputDestiny := memoDebug; // Prepare the callbacks vChessGame.OnBeforeMove := @HandleOnMove; vChessGame.OnPawnPromotion := @HandlePawnPromotion; end; procedure TformChess.btnQuitClick(Sender: TObject); begin Close; end; procedure TformChess.btnGameNewGameClick(Sender: TObject); begin notebookMain.PageIndex := INT_PAGE_START; timerChessTimer.Enabled := False; end; procedure TformChess.btnQuitGameClick(Sender: TObject); begin Close; end; procedure TformChess.btnStartGameClick(Sender: TObject); var lModule: TChessModule; begin InitializeGameModel(); vChessGame.Enabled := False; notebookMain.PageIndex := INT_PAGE_GAME; gSelectedModuleIndex := comboGameMode.ItemIndex; lModule := GetChessModule(gSelectedModuleIndex); vChessGame.PlayerName := editPlayerName.Text; lModule.PrepareForGame(); // Make sure this is done after lModule.PrepareForGame() vChessGame.Enabled := True; timerChessTimer.Enabled := True; end; procedure TformChess.comboGameModeSelect(Sender: TObject); begin UpdateChessModulesUI(comboGameMode.ItemIndex); gSelectedModuleIndex := comboGameMode.ItemIndex; end; { TFormDrawerDelegate } procedure TFormDrawerDelegate.HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin vChessGame.MouseMovePos := vChessGame.ClientToBoardCoords(Point(X, Y)); formChess.UpdateCaptions; end; 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)); if not vChessGame.MovePiece(vChessGame.DragStart, lCoords) then Exit; vChessDrawer.Invalidate; formChess.UpdateCaptions; end; 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; vChessGame.Dragging := True; vChessGame.DragStart := lCoords; vChessDrawer.Invalidate; formChess.UpdateCaptions; end; initialization vFormDrawerDelegate := TFormDrawerDelegate.Create; finalization vFormDrawerDelegate.Free; end.