Vulkan/projects/utils/uvkuInstanceEx.pas

unit uvkuInstanceEx;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  Vulkan, uvkuInstance;

type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TvkuApplicationInfo = packed record
    AppName:        String;
    AppVersion:     VkVersion;
    EngineName:     String;
    EngineVersion:  VkVersion;
    ApiVersion:     VkVersion;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TvkuAllocationHandler = class(TObject)
  protected
    function  AllocateMemory(const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid; virtual;
    function  ReallocateMemory(const aOriginal: PVkVoid; const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid; virtual;
    procedure FreeMemory(const aMemory: PVkVoid); virtual;

    procedure InternalAllocationNotification(const aSize: VkSize; const aType: TVkInternalAllocationType; const aScope: TVkSystemAllocationScope);
    procedure InternalFreeNotification(const aSize: VkSize; const aType: TVkInternalAllocationType; const aScope: TVkSystemAllocationScope);
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TvkuInstanceEx = class(TvkuInstance)
  private
    fFlags:             VkInstanceCreateFlags;
    fOwnsAllocHandler:  Boolean;
    fAllocationHandler: TvkuAllocationHandler;
    fApplicationInfo:   TvkuApplicationInfo;

    fLayers:     TStringList;
    fExtensions: TStringList;

    function GetLayers: TStrings;
    function GetExtensions: TStrings;

    procedure Initialize;
    procedure MakeStringsFromArray(const aArray: array of String; const aStrings: TStrings);
    procedure CreateHandle;
  public
    property Flags:             VkInstanceCreateFlags read fFlags;
    property OwnsAllocHandler:  Boolean               read fOwnsAllocHandler;
    property AllocationHandler: TvkuAllocationHandler read fAllocationHandler;
    property ApplicationInfo:   TvkuApplicationInfo   read fApplicationInfo;
    property Layers:            TStrings              read GetLayers;
    property Extensions:        TStrings              read GetExtensions;

    constructor Create;

    constructor Create(
      const aFlags: VkInstanceCreateFlags;
      const aLayers: array of String;
      const aExtensions: array of String);

    constructor Create(
      const aFlags: VkInstanceCreateFlags;
      const aLayers: array of String;
      const aExtensions: array of String;
      const aAppInfo: TvkuApplicationInfo);

    constructor Create(
      const aFlags: VkInstanceCreateFlags;
      const aLayers: array of String;
      const aExtensions: array of String;
      const aAppInfo: TvkuApplicationInfo;
      const aAllocHandler: TvkuAllocationHandler;
      const aOwnsAllocHandler: Boolean);

    destructor Destroy; override;
  public
    class function DefaultApplicationInfo: TvkuApplicationInfo;
    class function MakeApplicationInfo(
      aAppName:        String;
      aAppVersion:     VkVersion;
      aEngineName:     String;
      aEngineVersion:  VkVersion;
      aApiVersion:     VkVersion = VK_API_VERSION): TvkuApplicationInfo;
  end;

implementation


/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TvkuAllocationHandler//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuAllocationHandler.AllocateMemory(const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid;
begin
  result := System.GetMemory(aSize);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuAllocationHandler.ReallocateMemory(const aOriginal: PVkVoid; const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid;
begin
  result := System.ReAllocMemory(aOriginal, aSize);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuAllocationHandler.FreeMemory(const aMemory: PVkVoid);
begin
  System.FreeMemory(aMemory);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuAllocationHandler.InternalAllocationNotification(const aSize: VkSize; const aType: TVkInternalAllocationType; const aScope: TVkSystemAllocationScope);
begin
  // DUMMY
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuAllocationHandler.InternalFreeNotification(const aSize: VkSize; const aType: TVkInternalAllocationType; const aScope: TVkSystemAllocationScope);
begin
  // DUMMY
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function AllocateMemoryCallback(aUserData: PVkVoid; aSize: VkSize; aAlignment: VkSize; aScope: TVkSystemAllocationScope): PVkVoid; stdcall;
begin
  result := TvkuAllocationHandler(aUserData).AllocateMemory(aSize, aAlignment, aScope);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ReallocateMemoryCallback(aUserData: PVkVoid; aOriginal: PVkVoid; aSize: VkSize;
  aAlignment: VkSize; aScope: TVkSystemAllocationScope): PVkVoid; stdcall;
begin
  result := TvkuAllocationHandler(aUserData).ReallocateMemory(aOriginal, aSize, aAlignment, aScope);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure FreeMemoryCallback(aUserData: PVkVoid; aMemory: PVkVoid); stdcall;
begin
  TvkuAllocationHandler(aUserData).FreeMemory(aMemory);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure InternalAllocationCallback(aUserData: PVkVoid; aSize: VkSize; aType: TVkInternalAllocationType; aScope: TVkSystemAllocationScope); stdcall;
begin
  TvkuAllocationHandler(aUserData).InternalAllocationNotification(aSize, aType, aScope);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure InternalFreeCallback(aUserData: PVkVoid; aSize: VkSize; aType: TVkInternalAllocationType; aScope: TVkSystemAllocationScope); stdcall;
begin
  TvkuAllocationHandler(aUserData).InternalFreeNotification(aSize, aType, aScope);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TvkuInstanceEx///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuInstanceEx.GetLayers: TStrings;
begin
  result := fLayers;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuInstanceEx.GetExtensions: TStrings;
begin
  result := fExtensions;
end;

procedure TvkuInstanceEx.Initialize;
begin
  fLayers            := TStringList.Create;
  fExtensions        := TStringList.Create;
  fApplicationInfo   := DefaultApplicationInfo;
  fFlags             := 0;
  fAllocationHandler := nil;
  fOwnsAllocHandler  := false;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuInstanceEx.MakeStringsFromArray(const aArray: array of String; const aStrings: TStrings);
var i: Integer;
begin
  for i := Low(aArray) to High(aArray) do
    aStrings.Add(aArray[i]);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuInstanceEx.CreateHandle;
var
  CreateInfo:     TVkInstanceCreateInfo;
  AppInfo:        TVkApplicationInfo;
  AllocCallbacks: TVkAllocationCallbacks;
  i: Integer;
  lay: array of PVkChar;
  ext: array of PVkChar;
begin
  FillByte(AppInfo, SizeOf(AppInfo), 0);
  AppInfo.sType              := VK_STRUCTURE_TYPE_APPLICATION_INFO;
  AppInfo.pNext              := nil;
  AppInfo.pApplicationName   := PVkChar(fApplicationInfo.AppName);
  AppInfo.applicationVersion := fApplicationInfo.AppVersion;
  AppInfo.pEngineName        := PVkChar(fApplicationInfo.EngineName);
  AppInfo.engineVersion      := fApplicationInfo.EngineVersion;
  AppInfo.apiVersion         := fApplicationInfo.ApiVersion;

  SetLength(lay, fLayers.Count);
  for i := 0 to fLayers.Count-1 do
    lay[i] := PVkChar(fLayers[i]);

  SetLength(ext, fExtensions.Count);
  for i := 0 to fExtensions.Count-1 do
    ext[i] := PVkChar(fExtensions[i]);

  FillByte(CreateInfo, SizeOf(CreateInfo), 0);
  CreateInfo.sType                    := VK_STRUCTURE_TYPE_INSTANCE_CREATE_INFO;
  CreateInfo.pNext                    := nil;
  CreateInfo.flags                    := fFlags;
  CreateInfo.pApplicationInfo         := @AppInfo;
  CreateInfo.enabledLayerCount        := Length(lay);
  CreateInfo.ppEnabledLayerNames      := @lay[0];
  CreateInfo.enabledExtensionCount    := Length(ext);
  CreateInfo.ppEnabledExtensionNames  := @ext[0];

  if Assigned(fAllocationHandler) then begin
    FillByte(AllocCallbacks, SizeOf(AllocCallbacks), 0);
    AllocCallbacks.pUserData              := fAllocationHandler;
    AllocCallbacks.pfnAllocation          := @AllocateMemoryCallback;
    AllocCallbacks.pfnReallocation        := @ReallocateMemoryCallback;
    AllocCallbacks.pfnFree                := @FreeMemoryCallback;
    AllocCallbacks.pfnInternalAllocation  := @InternalAllocationCallback;
    AllocCallbacks.pfnInternalFree        := @InternalFreeCallback;
    inherited CreateHandle(@CreateInfo, @AllocCallbacks);
  end else
    inherited CreateHandle(@CreateInfo, nil);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TvkuInstanceEx.Create;
begin
  Initialize;
  CreateHandle;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TvkuInstanceEx.Create(const aFlags: VkInstanceCreateFlags;
  const aLayers: array of String; const aExtensions: array of String);
begin
  inherited Create;
  Initialize;
  fFlags := aFlags;
  MakeStringsFromArray(aLayers,     fLayers);
  MakeStringsFromArray(aExtensions, fExtensions);
  CreateHandle;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TvkuInstanceEx.Create(const aFlags: VkInstanceCreateFlags;const aLayers: array of String;
  const aExtensions: array of String; const aAppInfo: TvkuApplicationInfo);
begin
  inherited Create;
  Initialize;
  fFlags           := aFlags;
  fApplicationInfo := aAppInfo;
  MakeStringsFromArray(aLayers,     fLayers);
  MakeStringsFromArray(aExtensions, fExtensions);
  CreateHandle;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TvkuInstanceEx.Create(const aFlags: VkInstanceCreateFlags; const aLayers: array of String;const aExtensions: array of String;
  const aAppInfo: TvkuApplicationInfo; const aAllocHandler: TvkuAllocationHandler; const aOwnsAllocHandler: Boolean);
begin
  inherited Create;
  Initialize;
  fFlags             := aFlags;
  fApplicationInfo   := aAppInfo;
  fAllocationHandler := aAllocHandler;
  fOwnsAllocHandler  := aOwnsAllocHandler;
  MakeStringsFromArray(aLayers,     fLayers);
  MakeStringsFromArray(aExtensions, fExtensions);
  CreateHandle;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TvkuInstanceEx.Destroy;
begin
  inherited Destroy;
  if fOwnsAllocHandler then
    FreeAndNil(fAllocationHandler);
  FreeAndNil(fLayers);
  FreeAndNil(fExtensions);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TvkuInstanceEx.DefaultApplicationInfo: TvkuApplicationInfo;
begin
  result.AppName        := ExtractFileName(ParamStr(0));
  result.AppVersion     := 0;
  result.EngineName     := ExtractFileName(ParamStr(0));
  result.EngineVersion  := 0;
  result.ApiVersion     := VK_API_VERSION;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TvkuInstanceEx.MakeApplicationInfo(aAppName: String; aAppVersion: VkVersion; aEngineName: String; aEngineVersion: VkVersion; aApiVersion: VkVersion): TvkuApplicationInfo;
begin
  result := DefaultApplicationInfo;
  result.AppName       := aAppName;
  result.AppVersion    := aAppVersion;
  result.EngineName    := aEngineName;
  result.EngineVersion := aEngineVersion;
  result.ApiVersion    := aApiVersion;
end;

end.