source: tags/1.1.0/UCore.pas

unit UCore;

{$mode delphi}

interface

uses
  Classes, SysUtils, XMLConf, FileUtil, ActnList, Controls, Dialogs, Forms,
  UGame, UApplicationInfo, UPersistentForm, UScaleDPI, UCoolTranslator,
  URegistry, ULastOpenedList, Registry, Menus;

type

  { TCore }

  TCore = class(TDataModule)
    AAbout: TAction;
    AShowCharts: TAction;
    AHelp: TAction;
    AGameSave: TAction;
    AGameLoad: TAction;
    ApplicationInfo: TApplicationInfo;
    ASettings: TAction;
    ActionList1: TActionList;
    AExit: TAction;
    AGameEnd: TAction;
    AGameEndTurn: TAction;
    AGameNew: TAction;
    AGameRestart: TAction;
    CoolTranslator1: TCoolTranslator;
    ImageListLarge: TImageList;
    ImageListSmall: TImageList;
    LastOpenedList1: TLastOpenedList;
    OpenDialog1: TOpenDialog;
    PersistentForm: TPersistentForm;
    SaveDialog1: TSaveDialog;
    ScaleDPI1: TScaleDPI;
    XMLConfig1: TXMLConfig;
    procedure AAboutExecute(Sender: TObject);
    procedure AExitExecute(Sender: TObject);
    procedure AGameEndExecute(Sender: TObject);
    procedure AGameEndTurnExecute(Sender: TObject);
    procedure AGameLoadExecute(Sender: TObject);
    procedure AGameNewExecute(Sender: TObject);
    procedure AGameRestartExecute(Sender: TObject);
    procedure AGameSaveExecute(Sender: TObject);
    procedure AHelpExecute(Sender: TObject);
    procedure ASettingsExecute(Sender: TObject);
    procedure AShowChartsExecute(Sender: TObject);
    procedure CoolTranslator1Translate(Sender: TObject);
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure LastOpenedList1Change(Sender: TObject);
  private
    FInitialized: Boolean;
    StoredDimension: TControlDimension;
    RegistryContext: TRegistryContext;
    procedure LoadRecentExecute(Sender: TObject);
    procedure ProcessComputerTurns;
    procedure StartNewGame;
    procedure DoPlayerChange(Sender: TObject);
    procedure DoOnMove(CellFrom, CellTo: TCell; var CountOnce,
      CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
    procedure DoOnWin(Player: TPlayer);
    procedure Delay(Time: Integer);
    procedure GameNewTurnExecute(Sender: TObject);
    procedure AutoSave;
    function GetPlayer: TPlayer;
    procedure LoadConfig;
    procedure SaveConfig;
    procedure CommandLineParams;
    procedure ScaleDPI;
    procedure SelectClient;
    procedure LoadGame(FileName: string);
  public
    Game: TGame;
    UseSingleView: Boolean;
    DevelMode: Boolean;
    AnimationSpeed: Integer;
    AutoSaveEnabled: Boolean;
    CurrentClient: TClient;
    procedure UpdateActions;
    procedure Init;
    property Initialized: Boolean read FInitialized;
  end;

var
  Core: TCore;


implementation

{$R *.lfm}

uses
  UFormMove, UFormMain, UFormNew, UFormSettings, UFormAbout, UFormPlayer,
  UFormHelp, UFormCharts;

const
  DefaultRegKey = '\Software\Chronosoft\xTactics';

resourcestring
  SPlayerWins = 'Player %s wins';
  SEndGame = 'End game?';
  SEndGameQuestion = 'Do you want to end current game?';
  SRestartGame = 'Restart game?';
  SRestartGameQuestion = 'Do you want to restart current game?';


{ TCore }

procedure TCore.DoOnMove(CellFrom, CellTo: TCell; var CountOnce,
  CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
var
  I: Integer;
begin
  if Update then FormMove.SpinEditOnce.MaxValue := CellFrom.GetAvialPower + CountOnce
    else FormMove.SpinEditOnce.MaxValue := CellFrom.GetAvialPower;
  FormMove.SpinEditOnce.Value := CountOnce;
  FormMove.TrackBarOnce.Max := FormMove.SpinEditOnce.MaxValue;
  FormMove.TrackBarOnce.Position := FormMove.SpinEditOnce.Value;
  FormMove.SpinEditRepeat.MaxValue := Game.Map.MaxPower;
  FormMove.SpinEditRepeat.Value := CountRepeat;
  FormMove.TrackBarRepeat.Max := FormMove.SpinEditRepeat.MaxValue;
  FormMove.TrackBarRepeat.Position := FormMove.SpinEditRepeat.Value;
  FormMove.DefendCount := CellTo.Power;
  // Attack count from other surrounding cells without current move if already exists
  FormMove.AttackCount := 0;
  for I := 0 to CellTo.MovesTo.Count - 1 do
  if TUnitMove(CellTo.MovesTo[I]).CellFrom <> CellFrom then
    FormMove.AttackCount := FormMove.AttackCount + TUnitMove(CellTo.MovesTo[I]).CountOnce;
  FormMove.ShowWinProbability := CellTo.Player <> CellFrom.Player;

  if FormMove.ShowModal = mrOk then begin
    CountOnce := FormMove.SpinEditOnce.Value;
    CountRepeat := FormMove.SpinEditRepeat.Value;
    Confirm := True;
  end else Confirm := False;
end;

procedure TCore.DoOnWin(Player: TPlayer);
begin
  FormMain.Redraw;
  ShowMessage(Format(SPlayerWins, [Player.Name]));
end;

procedure TCore.Delay(Time: Integer);
const
  Slice = 50; // ms
begin
  while Time > 0 do begin
    Application.ProcessMessages;
    if Time > Slice then Sleep(Slice) else Sleep(Time);
    Dec(Time, Slice);
  end;
end;

procedure TCore.GameNewTurnExecute(Sender: TObject);
begin
  if AutoSaveEnabled then AutoSave;
end;

procedure TCore.AutoSave;
var
  OldFileName: string;
begin
  OldFileName := Game.FileName;
  Game.SaveToFile(GetAppConfigDir(False) + 'AutoSave.xtg');
  Game.FileName := OldFileName;
end;

function TCore.GetPlayer: TPlayer;
begin
  Result := Game.CurrentPlayer;
end;

procedure TCore.LoadConfig;
begin
  RegistryContext := RegContext(HKEY_CURRENT_USER, DefaultRegKey);
  PersistentForm.RegistryContext := RegistryContext;
  XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';

  LastOpenedList1.LoadFromXMLConfig(XMLConfig1, 'RecentFiles');
  DevelMode := XMLConfig1.GetValue('DevelMode', false);
  AnimationSpeed := XMLConfig1.GetValue('AnimationSpeed', 50);
  AutoSaveEnabled := XMLConfig1.GetValue('AutoSave', True);
  CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode(String(XMLConfig1.GetValue('Language', '')));
  ScaleDPI1.DPI := Point(XMLConfig1.GetValue('DPIX', 96), XMLConfig1.GetValue('DPIY', 96));
  ScaleDPI1.AutoDetect := XMLConfig1.GetValue('DPIAuto', True);
end;

procedure TCore.SaveConfig;
begin
  XMLConfig1.SetValue('Language', WideString(CoolTranslator1.Language.Code));
  LastOpenedList1.SaveToXMLConfig(XMLConfig1, 'RecentFiles');
  XMLConfig1.SetValue('DevelMode', DevelMode);
  XMLConfig1.SetValue('AnimationSpeed', AnimationSpeed);
  XMLConfig1.SetValue('AutoSave', AutoSaveEnabled);
  XMLConfig1.SetValue('DPIX', ScaleDPI1.DPI.X);
  XMLConfig1.SetValue('DPIY', ScaleDPI1.DPI.Y);
  XMLConfig1.SetValue('DPIAuto', ScaleDPI1.AutoDetect);
end;

procedure TCore.CommandLineParams;
var
  FileName: string;
begin
  // Command line parameter handling
  if (ParamCount > 0) then begin
    FileName := UTF8Encode(ParamStr(1));
    if FileExists(FileName) then LoadGame(FileName);
  end;
end;

procedure TCore.ScaleDPI;
var
  I: Integer;
begin
  {$ifdef DEBUG}
  with Core.ScaleDPI1 do begin
    //DesignDPI := Point(144, 144);
    if (DesignDPI.X <> DPI.X) or (DesignDPI.Y <> DPI.Y) then begin
      //ApplyToAll(DesignDPI);
      FormNew.Show;
      FormNew.Hide;
      for I := 0 to Screen.FormCount - 1 do
      if (Screen.Forms[I].WindowState = wsNormal) or
        (Screen.Forms[I].WindowState = wsMinimized) then begin
        StoreDimensions(Screen.Forms[I], StoredDimension);
        ScaleDimensions(Screen.Forms[I], StoredDimension);
      end;
      ScaleImageList(Core.ImageListSmall, DesignDPI);
      ScaleImageList(Core.ImageListLarge, DesignDPI);
    end;
  end;
  {$endif}
end;

procedure TCore.SelectClient;
var
  FirstHuman: TPlayer;
begin
  FirstHuman := Game.Players.GetFirstHuman;
  if Assigned(FirstHuman) then CurrentClient := FirstHuman.Client
    else CurrentClient := TClient(Game.Clients.First);
end;

procedure TCore.UpdateActions;
begin
  Core.AGameEndTurn.Enabled := Core.Game.Running;
  Core.AGameEnd.Enabled := Core.Game.Running;
end;

procedure TCore.AExitExecute(Sender: TObject);
begin
  Game.Running := False;
  Application.Terminate;
end;

procedure TCore.AAboutExecute(Sender: TObject);
begin
  FormAbout := TFormAbout.Create(Self);
  try
    FormAbout.ShowModal;
  finally
    FreeAndNil(FormAbout);
  end;
end;

procedure TCore.AGameEndExecute(Sender: TObject);
begin
  if MessageDlg(SEndGame, SEndGameQuestion, mtConfirmation, mbYesNo, 0) = mrYes then begin
    Game.Running := False;
    FormMain.Redraw;
    UpdateActions;
  end;
end;

procedure TCore.ProcessComputerTurns;
var
  Computer: TComputer;
begin
  while Game.Running and (Game.CurrentPlayer.Mode <> pmHuman) do begin
    if Game.CurrentPlayer.Mode = pmComputer then begin
      Computer := TComputer.Create;
      try
        Computer.Game := Game;
        Computer.Process;
      finally
        Computer.Free;
      end;
      FormMain.Redraw;
      Delay(Trunc((100 - AnimationSpeed) / 100 * 2000));
    end;
    Game.NextTurn;
    FormMain.Redraw;
    Application.ProcessMessages;
    Sleep(1);
  end;
end;

procedure TCore.AGameEndTurnExecute(Sender: TObject);
begin
  Game.NextTurn;
  FormMain.Redraw;
  ProcessComputerTurns;
  UpdateActions;
end;

procedure TCore.AGameLoadExecute(Sender: TObject);
begin
  if (Game.FileName = '') and (LastOpenedList1.Items.Count > 0) then
    OpenDialog1.FileName := LastOpenedList1.Items[0]
    else OpenDialog1.FileName := Game.FileName;
  if OpenDialog1.Execute then begin
    LoadGame(OpenDialog1.FileName);
  end;
end;

procedure TCore.AGameNewExecute(Sender: TObject);
begin
  FormNew.Load(Game);
  if FormNew.ShowModal = mrOk then begin
    FormNew.Save(Game);
    StartNewGame;
  end;
end;

procedure TCore.AGameRestartExecute(Sender: TObject);
begin
  if MessageDlg(SRestartGame, SRestartGameQuestion, mtConfirmation, mbYesNo, 0) = mrYes then begin
    StartNewGame;
  end;
end;

procedure TCore.AGameSaveExecute(Sender: TObject);
begin
  if (Game.FileName = '') and (LastOpenedList1.Items.Count > 0) then
    SaveDialog1.FileName := ExtractFileDir(LastOpenedList1.Items[0])
    else SaveDialog1.FileName := Game.FileName;
  if SaveDialog1.Execute then begin
    Game.SaveToFile(SaveDialog1.FileName);
    LastOpenedList1.AddItem(SaveDialog1.FileName);
  end;
end;

procedure TCore.AHelpExecute(Sender: TObject);
begin
  FormHelp := TFormHelp.Create(Self);
  try
    FormHelp.ShowModal;
  finally
    FreeAndNil(FormHelp);
  end;
end;

procedure TCore.ASettingsExecute(Sender: TObject);
begin
  FormSettings.Load;
  if FormSettings.ShowModal = mrOk then begin
    FormSettings.Save;
    Game.SaveConfig(XMLConfig1, 'Game');
  end;
end;

procedure TCore.AShowChartsExecute(Sender: TObject);
begin
  FormCharts.Show;
end;

procedure TCore.CoolTranslator1Translate(Sender: TObject);
begin
  UGame.InitStrings;
  FormNew.Translate;
  FormPlayer.Translate;
end;

procedure TCore.DataModuleCreate(Sender: TObject);
begin
  Game := TGame.Create;
  Game.OnMove := DoOnMove;
  Game.OnWin := DoOnWin;
  Game.OnNewTurn := GameNewTurnExecute;
  Game.OnPlayerChange := DoPlayerChange;
  StoredDimension := TControlDimension.Create;
  XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
  ForceDirectories(GetAppConfigDir(False));
end;

procedure TCore.DataModuleDestroy(Sender: TObject);
begin
  StoredDimension.Free;;
  Game.SaveConfig(XMLConfig1, 'Game');
  SaveConfig;
  FreeAndNil(Game);
end;

procedure TCore.LastOpenedList1Change(Sender: TObject);
begin
  LastOpenedList1.LoadToMenuItem(FormMain.MenuItemLoadRecent, LoadRecentExecute);
end;

procedure TCore.LoadRecentExecute(Sender: TObject);
begin
  LoadGame((Sender as TMenuItem).Caption);
end;

procedure TCore.LoadGame(FileName: string);
begin
  Game.LoadFromFile(FileName);
  SelectClient;
  LastOpenedList1.AddItem(FileName);
  with Core.CurrentClient do
    View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height);
  FormMain.AZoomAll.Execute;
  FormMain.Redraw;
  if FormCharts.Visible then FormCharts.Redraw;
end;

procedure TCore.StartNewGame;
begin
  Game.New;
  SelectClient;
  Game.Running := True;
  FormMain.Redraw;
  if FormCharts.Visible then FormCharts.Redraw;
  ProcessComputerTurns;
  UpdateActions;
end;

procedure TCore.DoPlayerChange(Sender: TObject);
begin
  if Assigned(Game.CurrentPlayer) and Assigned(Game.CurrentPlayer.Client) then
    CurrentClient := Game.CurrentPlayer.Client;
  if FormCharts.Visible then FormCharts.Redraw;
end;

procedure TCore.Init;
begin
  if not Core.Initialized then begin
    {$IFDEF Linux}
    // If installed in Linux system then use installation directory for po files
    if Application.ExeName = '/usr/bin/xtactics' then
      CoolTranslator1.POFilesFolder := '/usr/share/xtactics/languages';
    {$ENDIF}
    FInitialized := True;

    LoadConfig;
    Game.LoadConfig(XMLConfig1, 'Game');

    // Update translated default player names
    TPlayer(Game.Players[0]).Name := SPlayer + ' 1';
    TPlayer(Game.Players[1]).Name := SPlayer + ' 2';

    CommandLineParams;
    ScaleDPI;

    if Game.FileName = '' then StartNewGame;
  end;
end;

end.