source: trunk/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, UGeometry, Contnrs, UFormClient;

type

  { TCore }

  TCore = class(TDataModule)
    AAbout: TAction;
    APlayersStats: TAction;
    ANewSpectatorClient: TAction;
    AShowUnitMoves: 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 ANewSpectatorClientExecute(Sender: TObject);
    procedure APlayersStatsExecute(Sender: TObject);
    procedure ASettingsExecute(Sender: TObject);
    procedure AShowChartsExecute(Sender: TObject);
    procedure AShowUnitMovesExecute(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 DoMoveUpdated(UnitMove: TUnitMove);
    procedure DoOnWin(Player: TPlayer);
    procedure Delay(Time: Integer);
    procedure GameNewTurnExecute(Sender: TObject);
    procedure AutoSave;
    procedure LoadConfig;
    procedure SaveConfig;
    procedure CommandLineParams;
    procedure ScaleDPI;
    procedure SelectClient;
    procedure LoadGame(FileName: string);
    procedure RedrawClients;
    procedure UpdateOtherForms;
  public
    Game: TGame;
    Server: TServer;
    UseSingleView: Boolean;
    DevelMode: Boolean;
    AnimationSpeed: Integer;
    AutoSaveEnabled: Boolean;
    FormClients: TObjectList; // TFormClient
    //CurrentClient: TClient;
    LocalClients: TObjectList; // TClient
    procedure Spectate(Player: TPlayer);
    procedure UpdateActions;
    procedure Init;
    property Initialized: Boolean read FInitialized;
  end;

var
  Core: TCore;


implementation

{$R *.lfm}

uses
  UFormMove, UFormMain, UFormNew, UFormSettings, UFormAbout,
  UFormHelp, UFormCharts, UFormUnitMoves, UFormPlayersStats;

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?';
  SPlayersNotInitialized = 'Not all players were initialized with start cell. Needed %d, initialized %d. Change map parameters to have more terrain cells.';
  SFileDialogFilter = 'xTactics games (.xtg)|*.xtg|All files|*.*';


{ TCore }

procedure TCore.DoOnWin(Player: TPlayer);
begin
  RedrawClients;
  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';

  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);
      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 FormClient.Client := FirstHuman.Client
    else FormClient.Client := TClient(Server.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;
    RedrawClients;
    UpdateActions;
  end;
end;

procedure TCore.ProcessComputerTurns;
begin
  while Game.Running and (Game.CurrentPlayer.Mode <> pmHuman) do begin
    if Game.CurrentPlayer.Mode = pmComputer then begin
      Game.CurrentPlayer.Computer.Process;
      RedrawClients;
      Delay(Trunc((100 - AnimationSpeed) / 100 * 2000));
    end;
    Game.NextTurn;
    RedrawClients;
    Application.ProcessMessages;
    Sleep(1);
  end;
end;

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

procedure TCore.AGameLoadExecute(Sender: TObject);
begin
  OpenDialog1.Filter := SFileDialogFilter;
  OpenDialog1.InitialDir := ExtractFileDir(Game.FileName);
  OpenDialog1.FileName := ExtractFileName(Game.FileName);
  if OpenDialog1.Execute then begin
    LoadGame(OpenDialog1.FileName);
  end;
end;

procedure TCore.AGameNewExecute(Sender: TObject);
begin
  FormNew := TFormNew.Create(nil);
  try
    FormNew.Load(Server);
    if FormNew.ShowModal = mrOk then begin
      FormNew.Save(Server);
      StartNewGame;
    end;
  finally
    FormNew.Free;
  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
  SaveDialog1.Filter := SFileDialogFilter;
  SaveDialog1.InitialDir := ExtractFileDir(Game.FileName);
  SaveDialog1.FileName := ExtractFileName(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.ANewSpectatorClientExecute(Sender: TObject);
begin
  Spectate(nil);
end;

procedure TCore.APlayersStatsExecute(Sender: TObject);
begin
  if not Assigned(FormPlayersStats) then
    FormPlayersStats := TFormPlayersStats.Create(nil);
  FormPlayersStats.Show;
end;

procedure TCore.ASettingsExecute(Sender: TObject);
begin
  FormSettings := TFormSettings.Create(nil);
  try
    FormSettings.Load;
    if FormSettings.ShowModal = mrOk then begin
      FormSettings.Save;
      Game.SaveConfig(XMLConfig1, 'Game');
      Server.SaveConfig(XMLConfig1, 'Server');
    end;
  finally
    FreeAndNil(FormSettings);
  end;
end;

procedure TCore.AShowChartsExecute(Sender: TObject);
begin
  if not Assigned(FormCharts) then FormCharts := TFormCharts.Create(nil);
  FormCharts.Show;
end;

procedure TCore.AShowUnitMovesExecute(Sender: TObject);
begin
  if not Assigned(FormUnitMoves) then FormUnitMoves := TFormUnitMoves.Create(nil);
  FormUnitMoves.Show;
end;

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

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

procedure TCore.DataModuleDestroy(Sender: TObject);
begin
  if Assigned(FormPlayersStats) then FreeAndNil(FormPlayersStats);
  if Assigned(FormUnitMoves) then FreeAndNil(FormUnitMoves);
  if Assigned(FormCharts) then FreeAndNil(FormCharts);
  FreeAndNil(FormClients);
  FreeAndNil(StoredDimension);
  Game.SaveConfig(XMLConfig1, 'Game');
  Server.SaveConfig(XMLConfig1, 'Server');
  SaveConfig;
  FreeAndNil(Server);
  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);
  Server.InitClients;
  SelectClient;
  LastOpenedList1.AddItem(FileName);
  with FormClient.Client do
    View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0),
      TPoint.Create(FormClient.PaintBox1.Width, FormClient.PaintBox1.Height));
  FormClient.AZoomAll.Execute;
  RedrawClients;
  UpdateOtherForms;
end;

procedure TCore.RedrawClients;
var
  Form: TFormClient;
begin
  for Form in FormClients do
    Form.Redraw;
  FormClient.Redraw;
end;

procedure TCore.UpdateOtherForms;
begin
  if Assigned(FormCharts) and FormCharts.Visible then FormCharts.Redraw;
  if Assigned(FormUnitMoves) and FormUnitMoves.Visible then FormUnitMoves.ReloadList;
  if Assigned(FormPlayersStats) and FormPlayersStats.Visible then FormPlayersStats.ReloadList;
end;

procedure TCore.Spectate(Player: TPlayer);
var
  Form: TFormClient;
begin
  Form := TFormClient.Create(nil);
  Form.Client := Game.Server.Clients.New(SSpectator);
  //Form.Client.Form := Form;
  //Form.Client.ControlPlayer := Player;
  Form.AZoomAll.Execute;
  Form.Show;
  FormClients.Add(Form);
end;

procedure TCore.StartNewGame;
begin
  Game.New;
  Server.InitClients;
  Game.DevelMode := DevelMode;
  SelectClient;
  if Game.Players.GetAliveCount = Game.Players.Count then Game.Running := True
    else ShowMessage(Format(SPlayersNotInitialized, [Game.Players.Count, Game.Players.GetAliveCount]));
  RedrawClients;
  UpdateOtherForms;
  ProcessComputerTurns;
  UpdateActions;
end;

procedure TCore.DoPlayerChange(Sender: TObject);
begin
  if Assigned(Game.CurrentPlayer) and Assigned(Game.CurrentPlayer.Client) then begin
    FormClient.Client := Game.CurrentPlayer.Client;
  end;
  UpdateOtherForms;
end;

procedure TCore.DoMoveUpdated(UnitMove: TUnitMove);
begin
  if Assigned(FormUnitMoves) and FormUnitMoves.Visible then
    FormUnitMoves.ReloadList;
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;

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

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

    CommandLineParams;
    ScaleDPI;

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

end.