source: trunk/Forms/FormMain.pas

unit FormMain;

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, LCLType, FormEx,
  Dialogs, ExtCtrls, ComCtrls, Menus, ActnList, Engine, Platform, Math,
  DateUtils, GraphType, PersistentForm, ApplicationInfo, Translator,
  RegistryEx, FormAbout, FormNewGame, FormMap;

type

  { TFormMain }

  TFormMain = class(TFormEx)
    AAbout: TAction;
    AShowRawImageDesc: TAction;
    AShowMap: TAction;
    ANewGame: TAction;
    AExit: TAction;
    AFullScreen: TAction;
    ActionList1: TActionList;
    Image1: TImage;
    MainMenu1: TMainMenu;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    MenuItem5: TMenuItem;
    MenuItem6: TMenuItem;
    MenuItem7: TMenuItem;
    MenuItem8: TMenuItem;
    MenuItem9: TMenuItem;
    StatusBar1: TStatusBar;
    TimerDraw: TTimer;
    TimerEngineTick: TTimer;
    procedure AAboutExecute(Sender: TObject);
    procedure AExitExecute(Sender: TObject);
    procedure AFullScreenExecute(Sender: TObject);
    procedure ANewGameExecute(Sender: TObject);
    procedure AShowMapExecute(Sender: TObject);
    procedure AShowRawImageDescExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure Image1Resize(Sender: TObject);
    procedure TimerDrawTimer(Sender: TObject);
  private
    StartTime: TDateTime;
    Drawing: Boolean;
    procedure LoadConfig;
    procedure SaveConfig;
    procedure UpdateInterface;
  public
    Engine: TEngine;
    FormNewGame: TFormNewGame;
    FormMap: TFormMap;
    procedure EraseBackground(DC: HDC); override;
  end;

var
  FormMain: TFormMain;


implementation

{$R *.lfm}

uses
  Core;

resourcestring
  SRound = '%0:s';

{ TFormMain }

procedure TFormMain.TimerDrawTimer(Sender: TObject);
begin
  if not Drawing then
  try
    Drawing := True;
    StartTime := NowPrecise;
    //Engine.Draw;
    if Assigned(Engine) then begin
      Engine.Lock.Acquire;
      try
        //StatusBar1.Panels[1].Text := IntToStr(TPlayer(Engine.Players[0]).Position.X) + ', ' +
        //  IntToStr(TPlayer(Engine.Players[0]).Position.Y) + ' ' +
        //  IntToStr(TPlayer(Engine.Players[0]).Direction);
        StatusBar1.Panels[2].Text := FloatToStr(RoundTo(Engine.DrawDuration / OneMillisecond, -2));
        StatusBar1.Panels[3].Text := Format(SRound, [IntToStr(Engine.CurrentRound)]);
      finally
        Engine.Lock.Release;
      end;
    end;
  finally
    Drawing := False;
  end;
  if Engine.ThreadErrorMessage <> '' then begin
    ShowMessage(Engine.ThreadErrorMessage);
    Engine.ThreadErrorMessage := '';
  end;
end;

procedure TFormMain.LoadConfig;
var
  LangCode: string;
begin
  with TRegistryEx.Create do
  try
    CurrentContext := Core.Core.ApplicationInfo.GetRegistryContext;

    if ValueExists('LanguageCode') then begin
      LangCode := ReadStringWithDefault('LanguageCode', '');
      Core.Core.Translator1.Language := Core.Core.Translator1.Languages.SearchByCode(LangCode);
    end else Core.Core.Translator1.Language := Core.Core.Translator1.Languages.SearchByCode('');
    Engine.LoadFromRegistry(CurrentContext);
  finally
    Free;
  end;
end;

procedure TFormMain.SaveConfig;
begin
  with TRegistryEx.Create do
  try
    CurrentContext := Core.Core.ApplicationInfo.GetRegistryContext;

    if Assigned(Core.Core.Translator1.Language) and (Core.Core.Translator1.Language.Code <> '') then
      WriteString('LanguageCode', Core.Core.Translator1.Language.Code)
      else DeleteValue('LanguageCode');
    Engine.SaveToRegistry(CurrentContext);
  finally
    Free;
  end;
end;

procedure TFormMain.UpdateInterface;
begin
  {$IFDEF LCLQT5}
  MenuItem1.Visible := not FullScreen;
  MenuItem4.Visible := not FullScreen;
  MenuItem7.Visible := not FullScreen;
  {$ELSE}
  if FullScreen then Menu := nil
    else Menu := MainMenu1;
  {$ENDIF}
  {$IFDEF DEBUG}
  StatusBar1.Visible := not FullScreen;
  AShowMap.Visible := True;
  ANewGame.Visible := True;
  AShowRawImageDesc.Visible := True;
  {$ENDIF}
end;

procedure TFormMain.EraseBackground(DC: HDC);
begin
  // Do nothing
end;

procedure TFormMain.FormCreate(Sender: TObject);
{$IFDEF UNIX}
const
  LanguagesDirName = 'Languages';
  UnixLanguagesDir = '../share/Tunneler/' + LanguagesDirName;
var
  BaseDir: string;
  NewDir: string;
{$ENDIF}
begin
  BaseDir := ExcludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
  Core.Core.Translator1.POFilesFolder := BaseDir + DirectorySeparator + LanguagesDirName;

  {$IFDEF UNIX}
  // If installed in UNIX system then use installation directory for po files
  NewDir := ExpandFileName(BaseDir + DirectorySeparator + UnixLanguagesDir);
  if not DirectoryExists(Core.Core.Translator1.POFilesFolder) and DirectoryExists(NewDir) then
    Core.Core.Translator1.POFilesFolder := NewDir;
  {$ENDIF}

  Image1.ControlStyle := Image1.ControlStyle + [csOpaque];
  FullScreen := True;

  Application.OnDeactivate := FormDeactivate;
  Randomize;
  DoubleBuffered := False;
  Engine := TEngine.Create(nil);
  Engine.OnClose := AExitExecute;
  Engine.InitPlayerPool;
  Engine.HomePage := Core.Core.ApplicationInfo.HomePage;
  LoadConfig;
  Engine.Translate;
  Engine.Bitmap := Image1.Picture.Bitmap;
  Engine.NewGame;
  Image1Resize(Self);
  Engine.Active := True;
end;

procedure TFormMain.FormDeactivate(Sender: TObject);
begin
  if Assigned(Engine) then Engine.KeyBoard.ClearAll;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  SaveConfig;
  TimerDraw.Enabled := False;
  FreeAndNil(PersistentForm);
  FreeAndNil(Engine);
end;

procedure TFormMain.AFullScreenExecute(Sender: TObject);
begin
  FullScreen := not FullScreen;
  TFormEx.PersistentForm.Load(Self);
  TFormEx.PersistentForm.SetFullScreen(FullScreen);
  UpdateInterface;
end;

procedure TFormMain.ANewGameExecute(Sender: TObject);
begin
  FormNewGame := TFormNewGame.Create(nil);
  try
    FormNewGame.LoadData(Engine);
    if FormNewGame.ShowModal = mrOk then begin
      FormNewGame.SaveData(Engine);
      Engine.NewGame;
    end;
  finally
    FreeAndNil(FormNewGame);
  end;
end;

procedure TFormMain.AShowMapExecute(Sender: TObject);
begin
  if not Assigned(FormMap) then FormMap := TFormMap.Create(Self);
  FormMap.Show;
end;

procedure TFormMain.AShowRawImageDescExecute(Sender: TObject);
begin
  ShowMessage(Image1.Picture.Bitmap.RawImage.Description.AsString);
end;

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

procedure TFormMain.AAboutExecute(Sender: TObject);
var
  FormAbout: TFormAbout;
begin
  try
    FormAbout := TFormAbout.Create(nil);
    FormAbout.ApplicationInfo := Core.Core.ApplicationInfo;
    FormAbout.ShowModal;
  finally
    FreeAndNil(FormAbout);
  end;
end;

procedure TFormMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Engine.KeyDown(Key);
  StatusBar1.Panels[0].Text := IntToStr(Key);
end;

procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
  );
begin
  Engine.KeyUp(Key);
end;

procedure TFormMain.FormShow(Sender: TObject);
begin
  UpdateInterface;
end;

procedure TFormMain.Image1Resize(Sender: TObject);
begin
  Engine.Lock.Acquire;
  try
    Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height);
    Engine.ResizePlayerFrames;
  finally
    Engine.Lock.Release;
  end;
end;

end.