ewsdr/PlatformUtils.pas

unit PlatformUtils;

{
  PlatformUtils.pas - small helpers for desktop/runtime platform checks.
}

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

{$IFNDEF HEADLESS}
uses
  Controls;
{$ENDIF}

function HasOpenGLSpectrumSwitch: Boolean;
function CurrentScreenDPI: Integer;
// Целочисленный масштаб канвы экрана: 2 на Retina, 1 везде остальном.
// Windows/Linux всегда получают 1 ⇒ умножение на него ничего не меняет.
function GetScreenScale: Integer;
// То же, но для канвы конкретного контрола: на macOS масштаб берётся у окна,
// которому контрол принадлежит, а не у главного экрана. Это то самое число, в
// котором Cocoa рисует эту канву, и оно меняется, когда окно перетаскивают на
// монитор с другим масштабом. Так и надо считать размер offscreen-битмапа.
{$IFNDEF HEADLESS}
function GetControlScale(AControl: TControl): Integer;
{$ENDIF}
// Монотонные микросекунды одного источника для всех потоков. Нужны там, где
// интервалы считает не человек, а код: пейсинг запросов TX-аудио по TCI ведёт
// абсолютные дедлайны, и часы, способные прыгнуть от NTP, там не годятся.
function MonotonicUs: Int64;

// Возвращает каталог для хранения конфигурации (с завершающим разделителем).
// macOS:   ~/Library/Application Support/ewsdr/
// Linux:   ~/.config/ewsdr/
// Windows: %APPDATA%\ewsdr\
function GetAppCfgDir: string;

implementation

uses
  SysUtils {$IFNDEF HEADLESS}, Forms{$ENDIF}
  {$IFDEF WINDOWS}, Windows{$ENDIF}
  {$IFDEF LINUX}, Linux, UnixType{$ENDIF}
  {$IF DEFINED(UNIX) AND NOT DEFINED(LINUX)}, BaseUnix{$ENDIF}
  {$IF DEFINED(DARWIN) AND NOT DEFINED(HEADLESS)}, MacScale{$ENDIF};

{$IFDEF WINDOWS}
var
  QPCFreq: Int64 = 0;
{$ENDIF}

function MonotonicUs: Int64;
{$IFDEF WINDOWS}
var
  V: Int64;
begin
  if QPCFreq <= 0 then
    if not QueryPerformanceFrequency(QPCFreq) then Exit(0);
  QueryPerformanceCounter(V);
  Result := (V * 1000000) div QPCFreq;
end;
{$ELSE}
  {$IFDEF LINUX}
var
  TS: TTimeSpec;
begin
  if clock_gettime(CLOCK_MONOTONIC, @TS) <> 0 then Exit(0);
  Result := Int64(TS.tv_sec) * 1000000 + TS.tv_nsec div 1000;
end;
  {$ELSE}
var
  TV: TTimeVal;
begin
  fpgettimeofday(@TV, nil);
  Result := Int64(TV.tv_sec) * 1000000 + TV.tv_usec;
end;
  {$ENDIF}
{$ENDIF}

function HasOpenGLSpectrumSwitch: Boolean;
var
  I: Integer;
  S: string;
begin
  Result := False;
  for I := 1 to ParamCount do
  begin
    S := LowerCase(ParamStr(I));
    if (S = '--opengl') or (S = '-opengl') or (S = '/opengl') then
      Exit(True);
  end;
  // Бандл под LaunchServices не может передать argv, поэтому тот же
  // переключатель читается из окружения (Info.plist -> LSEnvironment).
  S := LowerCase(Trim(GetEnvironmentVariable('EWSDR_OPENGL')));
  if (S = '1') or (S = 'true') or (S = 'yes') or (S = 'on') then
    Exit(True);
end;

function GetScreenScale: Integer;
begin
{$IF DEFINED(DARWIN) AND NOT DEFINED(HEADLESS)}
  // Cocoa рисует канву в физических пикселях, а TBitmap всегда 1x. Кто рисует
  // через offscreen-битмап, должен растить его в GetScreenScale раз.
  Result := MacBackingScale;
{$ELSE}
  Result := 1;
{$ENDIF}
end;

{$IFNDEF HEADLESS}
function GetControlScale(AControl: TControl): Integer;
{$IF DEFINED(DARWIN)}
var
  Host: TWinControl;
begin
  // У TPaintBox и прочих TGraphicControl своего NSView нет — рисуют они на
  // канве ближайшего родителя с хендлом, его окно и спрашиваем.
  if AControl is TWinControl then
    Host := TWinControl(AControl)
  else if AControl <> nil then
    Host := AControl.Parent
  else
    Host := nil;
  while (Host <> nil) and not Host.HandleAllocated do
    Host := Host.Parent;

  if Host <> nil then
    Result := MacBackingScaleForView(Pointer(Host.Handle))
  else
    Result := 0;

  // Контрола ещё нет на экране: до первой отрисовки сгодится главный экран.
  if Result < 1 then
    Result := GetScreenScale;
{$ELSE}
begin
  Result := 1;
{$ENDIF}
end;
{$ENDIF}

function CurrentScreenDPI: Integer;
begin
{$IFNDEF HEADLESS}
  Result := Screen.PixelsPerInch;
  if Result <= 0 then Result := 96;
{$ELSE}
  Result := 96;   // headless-демон без LCL: экрана нет, дефолт DPI
{$ENDIF}
end;

function GetAppCfgDir: string;
begin
{$IFDEF WINDOWS}
  Result := GetEnvironmentVariable('APPDATA');
  if Result = '' then
    Result := GetEnvironmentVariable('LOCALAPPDATA');
  if Result = '' then
    Result := ExtractFilePath(ParamStr(0));
  Result := IncludeTrailingPathDelimiter(Result) + 'ewsdr' + PathDelim;
{$ELSE}
  Result := IncludeTrailingPathDelimiter(GetAppConfigDir(False));
{$ENDIF}
  if not DirectoryExists(Result) then
    ForceDirectories(Result);
end;

end.