source: tags/1.2.0/UCore.pas

unit UCore;

{$mode delphi}

interface

uses
  Classes, SysUtils, FileUtil, UApplicationInfo, ULastOpenedList, UProject,
  UTranslator, UTarget, URegistry, Registry, Graphics, Controls, UScaleDPI,
  UPersistentForm, UTheme, UAboutDialog, UBFTarget;

type

  { TCore }

  TCore = class(TDataModule)
    AboutDialog: TAboutDialog;
    ApplicationInfo: TApplicationInfo;
    Translator: TTranslator;
    ImageListMain: TImageList;
    LastOpenedList: TLastOpenedList;
    PersistentForm1: TPersistentForm;
    ScaleDPI1: TScaleDPI;
    ThemeManager: TThemeManager;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure TranslatorTranslate(Sender: TObject);
  private
    FCurrentTarget: TTarget;
    StoredDimension: TControlDimension;
    RecentFileRegistryContext: TRegistryContext;
    procedure InitTargets;
    procedure SetCurrentTarget(AValue: TTarget);
    procedure ScaleDPI;
    procedure TargetMessageExecute(Text: string);
  public
    DataDir: string;
    Project: TProject;
    Targets: TTargets;
    Messages: TMessages;
    OpenProjectOnStart: Boolean;
    OptimizationLevel: TCompilerOptimization;
    CellSize: Integer;
    MemorySize: Integer;
    DebugEnabled: Boolean;
    OptionsFormTabIndex: Integer;
    Optimizations: TOptimizations;
    procedure Init;
    procedure AddItemToLastOpenedList(FileName: string);
    procedure LoadFromRegistry(Context: TRegistryContext);
    procedure SaveToRegistry(Context: TRegistryContext);
    property CurrentTarget: TTarget read FCurrentTarget write SetCurrentTarget;
  end;

var
  Core: TCore;


implementation

{$R *.lfm}

uses
  UFormMain, Forms, LazFileUtils,
  // Targets
  UTargetInterpretter, UTargetFPC, UTargetJava, UTargetDelphi, UTargetJavascript,
  UTargetPHP, UTargetC, UTargetPython, UTargetCSharp;

const
  RecentFilesRegKey = 'RecentFiles';

{ TCore }

procedure TCore.AddItemToLastOpenedList(FileName: string);
begin
  with LastOpenedList do begin
    LoadFromRegistry(RecentFileRegistryContext);
    AddItem(FileName);
    SaveToRegistry(RecentFileRegistryContext);
  end;
end;

procedure TCore.DataModuleCreate(Sender: TObject);
{$IFDEF UNIX}
const
  LinuxDataDir = '/usr/share/LazFuck';
  LinuxLanguagesDir = LinuxDataDir + '/Languages';
{$ENDIF}
begin
  DataDir := '';
  {$IFDEF UNIX}
  // If installed in Linux system then use installation shared game directory for data files
  if DirectoryExists(LinuxDataDir) then
    DataDir := LinuxDataDir;
  // If installed in Linux system then use installation directory for po files
  if not DirectoryExists(Translator.POFilesFolder) and DirectoryExists(LinuxLanguagesDir) then
    Translator.POFilesFolder := LinuxLanguagesDir;
  {$ENDIF}

  Project := TProject.Create;
  Targets := TTargets.Create;
  Messages := TMessages.Create;

  StoredDimension := TControlDimension.Create;
  InitTargets;
  RecentFileRegistryContext := TRegistryContext.Create(ApplicationInfo.RegistryRoot,
    ApplicationInfo.RegistryKey + '\' + RecentFilesRegKey);
  LoadFromRegistry(Core.ApplicationInfo.GetRegistryContext);
end;

procedure TCore.DataModuleDestroy(Sender: TObject);
begin
  SaveToRegistry(Core.ApplicationInfo.GetRegistryContext);
  FreeAndNil(Messages);
  FreeAndNil(Targets);
  FreeAndNil(Project);
  FreeAndNil(StoredDimension);
end;

procedure TCore.TranslatorTranslate(Sender: TObject);
begin
  UTarget.UpdateTranslation;
end;

procedure TCore.InitTargets;
var
  I: Integer;
begin
  with Targets do begin
    Clear;
    Add(TTargetInterpretter.Create);
    Add(TTargetDelphi.Create);
    Add(TTargetFPC.Create);
    Add(TTargetPHP.Create);
    Add(TTargetC.Create);
    Add(TTargetJava.Create);
    Add(TTargetPython.Create);
    Add(TTargetCSharp.Create);
    Add(TTargetJavascript.Create);
    for I := 0 to Count - 1 do
      Items[I].OnMessage := TargetMessageExecute;
  end;
end;

procedure TCore.LoadFromRegistry(Context: TRegistryContext);
begin
  with TRegistryEx.Create do
  try
    CurrentContext := Context;
    OpenProjectOnStart := ReadBoolWithDefault('OpenProjectOnStart', True);
    if ValueExists('LanguageCode') then
      Translator.Language := Translator.Languages.SearchByCode(ReadStringWithDefault('LanguageCode', ''))
      else Translator.Language := Translator.Languages.SearchByCode('');
    ScaleDPI1.DPI := Point(ReadIntegerWithDefault('DPIX', 96),
      ReadIntegerWithDefault('DPIY', 96));
    ScaleDPI1.AutoDetect := ReadBoolWithDefault('DPIAuto', True);
    OptimizationLevel := TCompilerOptimization(ReadIntegerWithDefault('OptimizationLevel', Integer(coNormal)));
    MemorySize := ReadIntegerWithDefault('MemorySize', 30000);
    CellSize := ReadIntegerWithDefault('CellSize', 256);
    DebugEnabled := ReadBoolWithDefault('DebugEnabled', True);
    OptionsFormTabIndex := ReadIntegerWithDefault('OptionsFormTabIndex', 0);
    ThemeManager.Theme := ThemeManager.Themes.FindByName(ReadStringWithDefault('Theme', 'System'));
  finally
    Free;
  end;
  Targets.LoadFromRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Compiler'));
  LastOpenedList.LoadFromRegistry(RecentFileRegistryContext);
  PersistentForm1.RegistryContext := Context;
end;

procedure TCore.SaveToRegistry(Context: TRegistryContext);
begin
  Targets.SaveToRegistry(TRegistryContext.Create(Context.RootKey, Context.Key + '\Compiler'));
  with TRegistryEx.Create do
  try
    CurrentContext := Context;
    WriteBool('OpenProjectOnStart', OpenProjectOnStart);
    WriteBool('DPIAuto', ScaleDPI1.AutoDetect);
    WriteInteger('DPIX', ScaleDPI1.DPI.X);
    WriteInteger('DPIY', ScaleDPI1.DPI.Y);
    WriteInteger('OptimizationLevel', Integer(OptimizationLevel));
    WriteInteger('MemorySize', MemorySize);
    WriteInteger('CellSize', CellSize);
    WriteBool('DebugEnabled', DebugEnabled);
    WriteInteger('OptionsFormTabIndex', OptionsFormTabIndex);
    if Assigned(Translator.Language) and (Translator.Language.Code <> '') then
      WriteString('LanguageCode', Translator.Language.Code)
      else DeleteValue('LanguageCode');
    WriteString('Theme', ThemeManager.Theme.Name);
  finally
    Free;
  end;
end;

procedure TCore.SetCurrentTarget(AValue: TTarget);
var
  I: Integer;
begin
  if FCurrentTarget = AValue then Exit;
  FCurrentTarget := AValue;
  for I := 0 to Targets.Count - 1 do
    Targets[I].OnChangeState := nil;
  if Assigned(FCurrentTarget) then begin
    FCurrentTarget.OnChangeState := FormMain.TargetStateChanged;
    FCurrentTarget.OnLog := FormMain.TargetLogExecute;
    FCurrentTarget.OptimizationLevel := OptimizationLevel;
    if FCurrentTarget is TBFTarget then begin
      TBFTarget(FCurrentTarget).MemorySize := MemorySize;
      TBFTarget(FCurrentTarget).CellSize := CellSize;
    end;
  end;
  FormMain.UpdateTargetList;
  FormMain.UpdateInterface;
end;

procedure TCore.ScaleDPI;
var
  I: Integer;
begin
  with 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(ImageListMain, DesignDPI);
    end;
  end;
end;

procedure TCore.TargetMessageExecute(Text: string);
begin
  Messages.AddMessage(Text);
end;

procedure TCore.Init;
begin
  ScaleDPI;
  Translator.Translate;
end;

end.