ASSettings.pas

unit ASSettings;

interface

uses
  Windows, Messages, SysUtils, Types, UITypes, Classes, Controls, Forms,
  Graphics, Generics.Defaults, Generics.Collections, Registry, ASObjects;

type
  TSettingDataType = (sdtBoolean, sdtInteger, sdtColor, sdtDouble, sdtString, sdtDateTime);
  TSettingDataTypeHelper = record helper for TSettingDataType
    function ToLocalizedString: string;
  end;
  PSetting = ^TSetting;
  TSetting = record
    Name: string;
    &Type: TSettingDataType;
    DefaultValue: Variant;
    Description: string;
    Callback: TProc;
    function ValueAsText: string;
    function DefaultValueAsText: string;
    function ValueObject: TAlgosimObject;
    function DefaultValueObject: TAlgosimObject;
    procedure Restore;
  end;
  TASSettings = record
  strict private
    class var R: TRegistry;
    class function HasReg: Boolean; static;
    class var FKnownSettings: TDictionary<string, TSetting>;
    class function KS(const AName: string; AType: TSettingDataType;
      ADefVal: Variant; const ADescription: string; ACallback: TProc = nil): TSetting; static;
    class function AddToKnown(const AName: string; AType: TSettingDataType; ADefVal: Variant;
      const ADescription: string = ''; ACallback: TProc = nil): Variant; static;
    class var FCallbacks: TList<TProc>;
    class procedure Changed(const AName: string); static;
    class procedure LoadStandardSettings; static;
  public
    class function KnownSettings: TArray<TSetting>; static;
    class function KnownSettingNames: TArray<string>; static;
    class function TryGetSetting(const AName: string; out ASetting: TSetting): Boolean; static;
    class procedure SetSetting(const AName: string; AValue: Boolean); overload; static;
    class procedure SetSetting(const AName: string; AValue: Integer); overload; static;
    class procedure SetSetting(const AName: string; AValue: TColor); overload; static;
    class procedure SetSetting(const AName: string; AValue: Double); overload; static;
    class procedure SetSetting(const AName: string; const AValue: string); overload; static;
    class procedure SetSetting(const AName: string; const AValue: TDateTime); overload; static;
    class function GetSettingBool(const AName: string; ADefault: Boolean = False): Boolean; static;
    class function GetSettingInteger(const AName: string; ADefault: Integer = 0): Integer; static;
    class function GetSettingColor(const AName: string; ADefault: TColor = clBlack): TColor; static;
    class function GetSettingDouble(const AName: string; const ADefault: Double = 0.0): Double; static;
    class function GetSettingString(const AName: string; const ADefault: string = ''): string; static;
    class function GetSettingDateTime(const AName: string; const ADefault: TDateTime = 0.0): TDateTime; static;
    class procedure RegisterKnownSetting(const AName: string; AType: TSettingDataType; ADefVal: Variant); static;
    class procedure RegisterCallback(ACallback: TProc); static;
    class procedure RestoreKnownSetting(const AName: string); static;
    class constructor ClassCreate;
    class destructor ClassDestroy;
  end;

type
  TNumericSettingsCache = record
    class var Numerics_ContourSamplesPerAxis: Integer;
    class constructor ClassCreate;
  end;

implementation

uses
  Math, ASStructs, ascolors, ASKernelDefs, ClientDefs, UxPanel, Rux;

const
  Default_ContourSamplesPerAxis = 500;

procedure UpdateNumericSettings;
begin
  TNumericSettingsCache.Numerics_ContourSamplesPerAxis :=
    EnsureRange(
      TASSettings.GetSettingInteger('Numerics_ContourSamplesPerAxis', Default_ContourSamplesPerAxis),
      5,
      5000
    );
end;

{ TASSettings }

class function TASSettings.AddToKnown(const AName: string;
  AType: TSettingDataType; ADefVal: Variant; const ADescription: string;
  ACallback: TProc): Variant;
begin
  Result := ADefVal;
  if Assigned(FKnownSettings) then
  begin
    var LOldSetting := Default(TSetting);
    if ADescription.IsEmpty and FKnownSettings.TryGetValue(AName, LOldSetting) then
      Result := LOldSetting.DefaultValue;
    if ADescription.IsEmpty then
      FKnownSettings.TryAdd(AName, KS(AName, AType, ADefVal, ADescription, ACallback))
    else
      FKnownSettings.AddOrSetValue(AName, KS(AName, AType, ADefVal, ADescription, ACallback))
  end;
end;

class procedure TASSettings.Changed(const AName: string);
begin
  try
    var LSetting := Default(TSetting);
    if Assigned(FKnownSettings) and FKnownSettings.TryGetValue(AName, LSetting) then
      if Assigned(LSetting.Callback) then
        LSetting.Callback();
  finally
    if Assigned(FCallbacks) then
      for var LProc in FCallbacks do
        LProc();
  end;
end;

class constructor TASSettings.ClassCreate;
begin
  HasReg;
  LoadStandardSettings;
end;

class destructor TASSettings.ClassDestroy;
begin
  FreeAndNil(FCallbacks);
  FreeAndNil(R);
  FreeAndNil(FKnownSettings);
end;

class function TASSettings.GetSettingBool(const AName: string;
  ADefault: Boolean = False): Boolean;
begin
  Result := AddToKnown(AName, sdtBoolean, ADefault);
  if HasReg and R.ValueExists(AName) then
    Result := R.ReadBool(AName);
end;

class function TASSettings.GetSettingColor(const AName: string;
  ADefault: TColor = clBlack): TColor;
begin
  Result := AddToKnown(AName, sdtColor, ADefault);
  if HasReg and R.ValueExists(AName) then
    Result := R.ReadInteger(AName);
end;

class function TASSettings.GetSettingDateTime(const AName: string;
  const ADefault: TDateTime = 0.0): TDateTime;
begin
  Result := AddToKnown(AName, sdtDateTime, ADefault);
  if HasReg and R.ValueExists(AName) then
    Result := R.ReadDateTime(AName);
end;

class function TASSettings.GetSettingDouble(const AName: string;
  const ADefault: Double = 0.0): Double;
begin
  Result := AddToKnown(AName, sdtDouble, ADefault);
  if HasReg and R.ValueExists(AName) then
    Result := R.ReadFloat(AName);
end;

class function TASSettings.GetSettingInteger(const AName: string;
  ADefault: Integer = 0): Integer;
begin
  Result := AddToKnown(AName, sdtInteger, ADefault);
  if HasReg and R.ValueExists(AName) then
    Result := R.ReadInteger(AName);
end;

class function TASSettings.GetSettingString(const AName: string;
  const ADefault: string = ''): string;
begin
  Result := AddToKnown(AName, sdtString, ADefault);
  if HasReg and R.ValueExists(AName) then
    Result := R.ReadString(AName);
end;

class function TASSettings.HasReg: Boolean;
begin
  if FKnownSettings = nil then
    FKnownSettings := TDictionary<string, TSetting>.Create;
  if R = nil then
  begin
    R := TRegistry.Create;
    R.RootKey := HKEY_CURRENT_USER;
    Result := R.OpenKey('Software\Rejbrand\Algosim\Settings', True);
    if not Result then
      FreeAndNil(R);
  end
  else
    Result := True;
end;

class function TASSettings.KnownSettingNames: TArray<string>;
begin
  if Assigned(FKnownSettings) then
    Result := FKnownSettings.Keys.ToArray
  else
    Result := nil;
end;

class function TASSettings.KnownSettings: TArray<TSetting>;
begin
  if Assigned(FKnownSettings) then
    Result := FKnownSettings.Values.ToArray
  else
    Result := nil;
end;

class function TASSettings.KS(const AName: string;
  AType: TSettingDataType; ADefVal: Variant; const ADescription: string;
  ACallback: TProc): TSetting;
begin
  Result := Default(TSetting);
  Result.Name := AName;
  Result.&Type := AType;
  Result.DefaultValue := ADefVal;
  Result.Description := ADescription;
  Result.Callback := ACallback;
end;

class procedure TASSettings.LoadStandardSettings;
begin

  AddToKnown('Editor_FontName', sdtString, '', 'If non-empty, specifies the default monospaced typeface used for new editor and console windows.');
  AddToKnown('Editor_ZoomLevel', sdtInteger, 100, 'Specifies the zoom level (in percent) used by default in new editor and console windows.');

  AddToKnown('Console_ShowRuler', sdtBoolean, False, 'Determines if the ruler should be visible by default in new console windows.');
  AddToKnown('Console_CaretBeyondEOL', sdtBoolean, False, 'Determines if the “allow caret beyond EOL” option should be on by default in new console windows.');
  AddToKnown('Console_MathInputMode', sdtBoolean, True, 'Determines if mathematical input mode should be on by default in new console windows.');
  AddToKnown('Console_ShowHiddenCharacters', sdtBoolean, False, 'Determines if hidden characters should be visualised by default in new console windows.');
  AddToKnown('Console_LineHighlight', sdtBoolean, False, 'Determines if the current line should be highlighted by default in new console windows.');
  AddToKnown('Console_QuerySave', sdtBoolean, True, 'Determines if unsaved changes should trigger a warning (and option to save) when a console window is to be closed.');

  AddToKnown('ProgEd_ShowRuler', sdtBoolean, True, 'Determines if the ruler should be visible by default in new program editor windows.');
  AddToKnown('ProgEd_CaretBeyondEOL', sdtBoolean, True, 'Determines if the “allow caret beyond EOL” option should be on by default in new program editor windows.');
  AddToKnown('ProgEd_MathInputMode', sdtBoolean, True, 'Determines if mathematical input mode should be on by default in new program editor windows.');
  AddToKnown('ProgEd_ShowHiddenCharacters', sdtBoolean, False, 'Determines if hidden characters should be visualised by default in new program editor windows.');
  AddToKnown('ProgEd_LineHighlight', sdtBoolean, True, 'Determines if the current line should be highlighted by default in new program editor windows.');
  AddToKnown('ProgEd_ShowTree', sdtBoolean, True, 'Determines if the parsed syntax tree should be visible by default in new program editor windows.');

  AddToKnown('StartMaximized', sdtBoolean, False, 'If true, new Algosim instances will have their main IDE form maximized.');
  AddToKnown('DefaultLayout', sdtString, 'Console (only)', 'The name of the Algosim IDE layout preset to use on application startup.');
  AddToKnown('QuickLayouts', sdtString, 'Console (only); Standard IDE; Full IDE', 'A semicolon-separated list of layout presets that are cyclically applied by F4.',
    procedure
    begin
      UxPanel.QuickLayouts := TASSettings.GetSettingString('QuickLayouts').Split([';']);
      UxPanel.TidyQuickLayouts;
    end
  );
  AddToKnown('ThemedBorders', sdtBoolean, True, 'If true, Algosim title bars and window borders are painted in the Algosim theme colour instead of the system default colour (requires restart).');
  AddToKnown('ThemeColor', sdtColor, UxPanel.GDefaultColor, 'The theme colour used by the Algosim front end.',
      procedure
      begin
        if not RUx.ColorChanging then
        begin
          Rux.ColorSettingChanging := True;
          try
            TUx.ThemeUpdate(TUxTheme.Create(TASSettings.GetSettingColor('ThemeColor')))
          finally
            Rux.ColorSettingChanging := False;
          end;
        end;
      end
    );
  AddToKnown('NoQuickStartGuide', sdtBoolean, False, 'If true, Algosim won’t ask if you want to open the quick start guide at application startup.');

  AddToKnown('ImageViewer_HighQualityScaling', sdtBoolean, True, 'Determines if high-quality scaling should be used by default in new image viewers.');

  AddToKnown('Numerics_ContourSamplesPerAxis', sdtInteger, Default_ContourSamplesPerAxis,
    'The default number of samples per axis used when sampling scalar fields to produce contour plots or implicit graphs. More precisely, the square of this value is used as the default number of total samples.',
    UpdateNumericSettings
  );

end;

class procedure TASSettings.RegisterCallback(ACallback: TProc);
begin
  if FCallbacks = nil then
    FCallbacks := TList<TProc>.Create;
  FCallbacks.Add(ACallback);
end;

class procedure TASSettings.RegisterKnownSetting(const AName: string;
  AType: TSettingDataType; ADefVal: Variant);
begin
  AddToKnown(AName, AType, ADefVal);
end;

class procedure TASSettings.RestoreKnownSetting(const AName: string);
begin
  var LSetting := Default(TSetting);
  if Assigned(FKnownSettings) and FKnownSettings.TryGetValue(AName, LSetting) then
    LSetting.Restore;
end;

class procedure TASSettings.SetSetting(const AName: string; AValue: Boolean);
begin
  AddToKnown(AName, sdtBoolean, AValue);
  if HasReg then
    R.WriteBool(AName, AValue);
  Changed(AName);
end;

class procedure TASSettings.SetSetting(const AName: string; AValue: Integer);
begin
  AddToKnown(AName, sdtInteger, AValue);
  if HasReg then
    R.WriteInteger(AName, AValue);
  Changed(AName);
end;

class procedure TASSettings.SetSetting(const AName, AValue: string);
begin
  AddToKnown(AName, sdtString, AValue);
  if HasReg then
    R.WriteString(AName, AValue);
  Changed(AName);
end;

class procedure TASSettings.SetSetting(const AName: string; AValue: Double);
begin
  AddToKnown(AName, sdtDouble, AValue);
  if HasReg then
    R.WriteFloat(AName, AValue);
  Changed(AName);
end;

class procedure TASSettings.SetSetting(const AName: string; AValue: TColor);
begin
  AddToKnown(AName, sdtColor, AValue);
  if HasReg then
    R.WriteInteger(AName, AValue);
  Changed(AName);
end;

class procedure TASSettings.SetSetting(const AName: string; const AValue: TDateTime);
begin
  AddToKnown(AName, sdtDateTime, AValue);
  if HasReg then
    R.WriteDateTime(AName, AValue);
  Changed(AName);
end;

class function TASSettings.TryGetSetting(const AName: string;
  out ASetting: TSetting): Boolean;
begin
  Result := Assigned(FKnownSettings) and FKnownSettings.TryGetValue(AName, ASetting);
end;

{ TSettingDataTypeHelper }

function TSettingDataTypeHelper.ToLocalizedString: string;
begin
  case Self of
    sdtBoolean:
      Result := 'Boolean';
    sdtInteger:
      Result := 'Integer';
    sdtColor:
      Result := 'Colour';
    sdtDouble:
      Result := 'Double';
    sdtString:
      Result := 'String';
    sdtDateTime:
      Result := 'Datetime';
  else
    Result := 'Unknown';
  end;
end;

{ TSetting }

function TSetting.DefaultValueAsText: string;
begin
  case &Type of
    sdtBoolean:
      Result := Boolean(DefaultValue).ToString(TUseBoolStrs.True);
    sdtInteger:
      Result := IntToPrettyStr(Integer(DefaultValue));
    sdtColor:
      Result := ColorToHex(TColor(DefaultValue));
    sdtDouble:
      Result := Double(DefaultValue).ToString;
    sdtString:
      Result := string(DefaultValue);
    sdtDateTime:
      Result := DateTimeToStdStr(TDateTime(DefaultValue));
  else
    Result := '';
  end;
end;

function TSetting.DefaultValueObject: TAlgosimObject;
begin
  case &Type of
    sdtBoolean:
      Result := ASO(Boolean(DefaultValue));
    sdtInteger:
      Result := ASOInt(Integer(DefaultValue));
    sdtColor:
      Result := ASOColor(TColor(DefaultValue));
    sdtDouble:
      Result := ASO(Double(DefaultValue));
    sdtString:
      Result := ASO(string(DefaultValue));
    sdtDateTime:
      Result := ASODateTime(TDateTime(DefaultValue));
  else
    Result := ASO(null);
  end;
end;

procedure TSetting.Restore;
begin

  case &Type of
    sdtBoolean:
      TASSettings.SetSetting(Name, Boolean(DefaultValue));
    sdtInteger:
      TASSettings.SetSetting(Name, Integer(DefaultValue));
    sdtColor:
      TASSettings.SetSetting(Name, TColor(DefaultValue));
    sdtDouble:
      TASSettings.SetSetting(Name, Double(DefaultValue));
    sdtString:
      TASSettings.SetSetting(Name, string(DefaultValue));
    sdtDateTime:
      TASSettings.SetSetting(Name, TDateTime(DefaultValue));
  end;

end;

function TSetting.ValueAsText: string;
begin
  case &Type of
    sdtBoolean:
      Result := TASSettings.GetSettingBool(Name, DefaultValue).ToString(TUseBoolStrs.True);
    sdtInteger:
      Result := IntToPrettyStr(TASSettings.GetSettingInteger(Name, DefaultValue));
    sdtColor:
      Result := ColorToHex(TASSettings.GetSettingColor(Name, DefaultValue));
    sdtDouble:
      Result := TASSettings.GetSettingDouble(Name, DefaultValue).ToString;
    sdtString:
      Result := TASSettings.GetSettingString(Name, DefaultValue);
    sdtDateTime:
      Result := DateTimeToStdStr(TASSettings.GetSettingDateTime(Name, DefaultValue));
  else
    Result := '';
  end;
end;

function TSetting.ValueObject: TAlgosimObject;
begin
  case &Type of
    sdtBoolean:
      Result := ASO(TASSettings.GetSettingBool(Name, DefaultValue));
    sdtInteger:
      Result := ASOInt(TASSettings.GetSettingInteger(Name, DefaultValue));
    sdtColor:
      Result := ASOColor(TASSettings.GetSettingColor(Name, DefaultValue));
    sdtDouble:
      Result := ASO(TASSettings.GetSettingDouble(Name, DefaultValue));
    sdtString:
      Result := ASO(TASSettings.GetSettingString(Name, DefaultValue));
    sdtDateTime:
      Result := ASODateTime(TASSettings.GetSettingDateTime(Name, DefaultValue));
  else
    Result := ASO(null);
  end;
end;

{ TNumericSettingsCache }

class constructor TNumericSettingsCache.ClassCreate;
begin
  UpdateNumericSettings;
end;

end.