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.