source: tags/1.0.0/UCore.pas

unit UCore;

{$mode delphi}

interface

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

type

  { TCore }

  TCore = class(TDataModule)
    AAbout: 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;
    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 CoolTranslator1Translate(Sender: TObject);
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
  private
    FInitialized: Boolean;
    StoredDimension: TControlDimension;
    RegistryContext: TRegistryContext;
    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;
    procedure LoadConfig;
    procedure SaveConfig;
    procedure CommandLineParams;
    procedure ScaleDPI;
  public
    Game: TGame;
    Player: TPlayer;
    UseSingleView: Boolean;
    DevelMode: Boolean;
    LastMapFileName: string;
    AnimationSpeed: Integer;
    AutoSaveEnabled: Boolean;
    procedure UpdateActions;
    procedure Init;
    property Initialized: Boolean read FInitialized;
  end;

var
  Core: TCore;


implementation

{$R *.lfm}

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

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;

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

  LastMapFileName := XMLConfig1.GetValue('LastMapFileName', '');
  DevelMode := XMLConfig1.GetValue('DevelMode', false);
  AnimationSpeed := XMLConfig1.GetValue('AnimationSpeed', 50);
  AutoSaveEnabled := XMLConfig1.GetValue('AutoSave', True);
  CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode(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', CoolTranslator1.Language.Code);
  XMLConfig1.SetValue('LastMapFileName', LastMapFileName);
  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 begin
      Game.LoadFromFile(FileName);
      Player := Game.Players.GetFirstHuman;
      LastMapFileName := OpenDialog1.FileName;
      with Core.Game.CurrentPlayer do
        View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height);
      FormMain.AZoomAll.Execute;
      FormMain.Redraw;
    end;
  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 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.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.AGameEndTurnExecute(Sender: TObject);
var
  Computer: TComputer;
begin
  Game.NextTurn;
  FormMain.Redraw;
  while Game.Running and (Game.CurrentPlayer.Mode <> pmHuman) do begin
    if Game.CurrentPlayer.Mode = pmComputer then begin
      Computer := TComputer.Create;
      Computer.Game := Game;
      Computer.Process;
      Computer.Free;
      FormMain.Redraw;
      Delay(Trunc((100 - AnimationSpeed) / 100 * 2000));
    end;
    Game.NextTurn;
    FormMain.Redraw;
    Application.ProcessMessages;
    Sleep(1);
  end;
  UpdateActions;
end;

procedure TCore.AGameLoadExecute(Sender: TObject);
begin
  if Game.FileName = '' then
    OpenDialog1.FileName := LastMapFileName
    else OpenDialog1.FileName := Game.FileName;
  if OpenDialog1.Execute then begin
    Game.LoadFromFile(OpenDialog1.FileName);
    Player := Game.Players.GetFirstHuman;
    LastMapFileName := OpenDialog1.FileName;
    with Core.Game.CurrentPlayer do
      View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height);
    FormMain.AZoomAll.Execute;
    FormMain.Redraw;
  end;
end;

procedure TCore.AGameNewExecute(Sender: TObject);
begin
  FormNew.Load(Game);
  if FormNew.ShowModal = mrOk then begin
    FormNew.Save(Game);
    Game.New;
    Player := Game.Players.GetFirstHuman;
    Game.Running := True;
    FormMain.AZoomAll.Execute;
    UpdateActions;
  end;
end;

procedure TCore.AGameRestartExecute(Sender: TObject);
begin
  if MessageDlg(SRestartGame, SRestartGameQuestion, mtConfirmation, mbYesNo, 0) = mrYes then begin
    Game.New;
    Game.Running := True;
    FormMain.AZoomAll.Execute;
    FormMain.Redraw;
    UpdateActions;
  end;
end;

procedure TCore.AGameSaveExecute(Sender: TObject);
begin
  if Game.FileName = '' then
    SaveDialog1.FileName := ExtractFileDir(LastMapFileName)
    else SaveDialog1.FileName := Game.FileName;
  if SaveDialog1.Execute then begin
    Game.SaveToFile(SaveDialog1.FileName);
    LastMapFileName := 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.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;
  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.Init;
var
  I: Integer;
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;
  for I := 0 to Game.Players.Count - 1 do
    TPlayer(Game.Players[I]).View.DestRect := Rect(0, 0, FormMain.PaintBox1.Width,
      FormMain.PaintBox1.Height);
  Game.LoadConfig(XMLConfig1, 'Game');

  CommandLineParams;
  ScaleDPI;

  if Game.FileName = '' then begin
    Game.New;
    Player := Game.Players.GetFirstHuman;
    Game.Running := True;
    FormMain.AZoomAll.Execute;
  end;
end;

end.