source: trunk/Core.pas

unit Core;

interface

uses
  Classes, SysUtils, Theme, PersistentForm, ApplicationInfo, Translator,
  RegistryEx, ScaleDPI, Game, ActnList, Forms, Controls, Dialogs, Score;

type

  { TCore }

  TCore = class(TDataModule)
    AAbout: TAction;
    AComputer: TAction;
    AScore: TAction;
    ARestart: TAction;
    AHistory: TAction;
    AHelp: TAction;
    AUndo: TAction;
    ASettings: TAction;
    ActionList1: TActionList;
    AExit: TAction;
    ANew: TAction;
    ApplicationInfo1: TApplicationInfo;
    PersistentForm1: TPersistentForm;
    ScaleDPI1: TScaleDPI;
    ThemeManager1: TThemeManager;
    Translator1: TTranslator;
    procedure AAboutExecute(Sender: TObject);
    procedure AComputerExecute(Sender: TObject);
    procedure AExitExecute(Sender: TObject);
    procedure AHelpExecute(Sender: TObject);
    procedure AHistoryExecute(Sender: TObject);
    procedure ANewExecute(Sender: TObject);
    procedure ARestartExecute(Sender: TObject);
    procedure AScoreExecute(Sender: TObject);
    procedure ASettingsExecute(Sender: TObject);
    procedure AUndoExecute(Sender: TObject);
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure Translator1Translate(Sender: TObject);
  private
    procedure GameChange(Sender: TObject);
    procedure GamePaint(Sender: TObject);
    procedure GameWin(Sender: TObject);
    procedure GameWinSync;
    procedure GameOver(Sender: TObject);
    procedure GameOverSync;
    procedure UpdateScores;
  public
    Game: TGame;
    Scores: TScores;
    procedure UpdateInterface;
    procedure LoadConfig;
    procedure SaveConfig;
  end;

var
  Core: TCore;


implementation

{$R *.lfm}

uses
  FormMain, FormSettings, FormNew, FormHelp, FormComputer, FormAbout, FormEx,
  FormHistory, FormScore;

resourcestring
  SGameOverCaption = 'Lost';
  SGameOverMessage = 'Game over!';
  SWinCaption = 'Win';
  SWinMessage = 'You reached %s and won! You can continue to play to get higher score.';

procedure Translate;
begin
  Game.Translate;
end;

{ TCore }

procedure TCore.DataModuleCreate(Sender: TObject);
const
  LinuxLanguagesDir = '/usr/share/Game2048/languages';
begin
  {$IFDEF Linux}
  // If installed in Linux system then use installation directory for po files
  if not DirectoryExists(Translator1.POFilesFolder) and DirectoryExists(LinuxLanguagesDir) then
    Translator1.POFilesFolder := LinuxLanguagesDir;
  {$ENDIF}

  Randomize;
  Scores := TScores.Create;

  Game := TGame.Create;
  Game.Board.Size := Point(4, 4);
  Game.OnChange := GameChange;
  Game.OnPaint := GamePaint;
  Game.OnWin := GameWin;
  Game.OnGameOver := GameOver;
  LoadConfig;

  TFormEx.ScaleDPI := ScaleDPI1;
  TFormEx.Translator := Translator1;
  TFormEx.ThemeManager := ThemeManager1;
  TFormEx.PersistentForm := PersistentForm1;
end;

procedure TCore.ASettingsExecute(Sender: TObject);
var
  FormSettings: TFormSettings;
begin
  FormSettings := TFormSettings.Create(nil);
  try
    if FormSettings.ShowModal = mrOk then begin
      FormMain.FormMain.Redraw;
      FormMain.FormMain.UpdateInterface;
      ThemeManager1.UseTheme(FormMain.FormMain);
      UpdateInterface;
    end;
  finally
    FreeAndNil(FormSettings);
  end;
end;

procedure TCore.AUndoExecute(Sender: TObject);
begin
  Game.Undo;
end;

procedure TCore.AAboutExecute(Sender: TObject);
var
  FormAbout: TFormAbout;
begin
  FormAbout := TFormAbout.Create(nil);
  try
    FormAbout.ApplicationInfo := ApplicationInfo1;
    FormAbout.ShowModal;
  finally
    FormAbout.Free;
  end;
end;

procedure TCore.AComputerExecute(Sender: TObject);
var
  FormComputer: TFormComputer;
begin
  FormComputer := TFormComputer.Create(nil);
  try
    FormComputer.ShowModal;
  finally
    FreeAndNil(FormComputer);
  end;
end;

procedure TCore.AExitExecute(Sender: TObject);
begin
  FormMain.FormMain.Close;
end;

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

procedure TCore.AHistoryExecute(Sender: TObject);
var
  FormHistory: TFormHistory;
begin
  FormHistory := TFormHistory.Create(nil);
  try
    FormHistory.ShowModal;
  finally
    FreeAndNil(FormHistory);
  end;
end;

procedure TCore.ANewExecute(Sender: TObject);
var
  FormNew: TFormNew;
begin
  UpdateScores;
  FormNew := TFormNew.Create(nil);
  try
    FormNew.Load(Core.Game);
    if FormNew.ShowModal = mrOk then begin
      FormNew.Save(Core.Game);
      Game.New;
      UpdateInterface;
      FormMain.FormMain.UpdateInterface;
    end;
  finally
    FreeAndNil(FormNew);
  end;
end;

procedure TCore.ARestartExecute(Sender: TObject);
begin
  UpdateScores;
  Game.Restart;
  UpdateInterface;
  FormMain.FormMain.UpdateInterface;
end;

procedure TCore.AScoreExecute(Sender: TObject);
var
  FormScore: TFormScore;
begin
  UpdateScores;
  FormScore := TFormScore.Create(nil);
  try
    FormScore.Scores := Scores;
    if FormScore.ShowModal = mrOk then begin
    end;
  finally
    FreeAndNil(FormScore);
  end;
end;

procedure TCore.DataModuleDestroy(Sender: TObject);
begin
  UpdateScores;
  SaveConfig;
  FreeAndNil(Game);
  FreeAndNil(Scores);
end;

procedure TCore.Translator1Translate(Sender: TObject);
begin
  Translate;
end;

procedure TCore.GameChange(Sender: TObject);
begin
  UpdateInterface;
end;

procedure TCore.GamePaint(Sender: TObject);
begin
  if Assigned(FormMain.FormMain) then FormMain.FormMain.Redraw;
end;

procedure TCore.GameWin(Sender: TObject);
begin
  TThread.Synchronize(FormMain.FormMain.MoveThread, GameWinSync);
end;

procedure TCore.GameWinSync;
begin
  MessageDlg(SWinCaption, Format(SWinMessage, [Game.GetTileSkinValue(Game.WinTileValue)]), mtInformation, [mbOk], 0);
  UpdateScores;
end;

procedure TCore.GameOver(Sender: TObject);
begin
  TThread.Synchronize(FormMain.FormMain.MoveThread, GameOverSync);
end;

procedure TCore.GameOverSync;
begin
  MessageDlg(SGameOverCaption, SGameOverMessage, mtInformation, [mbOK], 0);
  UpdateScores;
end;

procedure TCore.UpdateScores;
var
  Score: TScore;
begin
  if Game.Score = 0 then Exit;  // Do not record zero score

  Score := Scores.SearchByTime(Game.StartTime);
  if not Assigned(Score) then Score := Scores.AddNew;
  Score.StartTime := Game.StartTime;
  Score.Score := Game.Score;
  Score.Moves := Game.Moves;
  Score.UsedUndos := Game.UsedUndos;
  Score.BoardSize := IntToStr(Game.Board.Size.X) + 'x' + IntToStr(Game.Board.Size.Y);
  Score.DisabledTiles := Game.DisabledTilesCount;
  Score.UnmergeableTiles := Game.UnmergeableTilesCount;
  Score.Duration := Now - Game.StartTime;
  Score.BiggestTile := Game.Board.GetBiggestTile;
end;

procedure TCore.UpdateInterface;
begin
  AUndo.Enabled := Game.CanUndo;
  AHistory.Enabled := Game.RecordHistory;
  {$IFDEF DEBUG}
  AComputer.Enabled := True;
  AComputer.Visible := True;
  {$ELSE}
  AComputer.Enabled := False;
  AComputer.Visible := False;
  {$ENDIF}
end;

procedure TCore.LoadConfig;
var
  Reg: TRegistryEx;
  RegContext: TRegistryContext;
begin
  Reg := TRegistryEx.Create;
  with Reg do
  try
    CurrentContext := ApplicationInfo1.GetRegistryContext;

    if ValueExists('LanguageCode') then
      Translator1.Language := Translator1.Languages.SearchByCode(ReadStringWithDefault('LanguageCode', ''))
      else Translator1.Language := Translator1.Languages.SearchByCode('');
    ThemeManager1.Theme := ThemeManager1.Themes.FindByName(ReadStringWithDefault('Theme', 'System'));

    RegContext := ApplicationInfo1.GetRegistryContext;
    Game.LoadFromRegistry(Reg, RegContext);
    Scores.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Scores'));
  finally
    Reg.Free;
  end;
end;

procedure TCore.SaveConfig;
var
  Reg: TRegistryEx;
  RegContext: TRegistryContext;
begin
  Reg := TRegistryEx.Create;
  with Reg do
  try
    CurrentContext := ApplicationInfo1.GetRegistryContext;

    if Assigned(Translator1.Language) and (Translator1.Language.Code <> '') then
      WriteString('LanguageCode', Translator1.Language.Code)
      else DeleteValue('LanguageCode');
    WriteString('Theme', ThemeManager1.Theme.Name);

    RegContext := ApplicationInfo1.GetRegistryContext;
    Game.SaveToRegistry(Reg, RegContext);
    Scores.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Scores'));
  finally
    Reg.Free;
  end;
end;

end.