Vulkan/projects/utils/uvkuDeviceFactory.pas

unit uvkuDeviceFactory;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  Vulkan, uvkuInstance, uvkuDevice, uvkuAllocationHandler;

type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TvkuQueuePriorityArr = array of VkFloat;
  TvkuQueueCreateInfo = packed record
    Flags:        VkDeviceQueueCreateFlags;
    FamilyIndex:  VkUint32;
    Priorities:   TvkuQueuePriorityArr;
  end;
  TvkuQueueCreateInfoArr = array of TvkuQueueCreateInfo;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TvkuDeviceEx = class(TvkuDevice)
  private
    fAllocHandler: TvkuAllocationHandler;
    fOwnsHandler: Boolean;
  public
    destructor Destroy; override;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TvkuDeviceFactory = class(TObject)
  private
    fInstance:          TvkuInstance;
    fFeatures:          TVkPhysicalDeviceFeatures;
    fFlags:             VkDeviceCreateFlags;
    fLayers:            TStringList;
    fExtensions:        TStringList;
    fQueueCreateInfos:  TvkuQueueCreateInfoArr;

    function GetLayers: TStrings;
    function GetExtensions: TStrings;

    function GetQueueCreateInfoCount: Integer;
    function GetQueueCreateInfo(const aIndex: Integer): TvkuQueueCreateInfo;
    function GetQueueCreateInfos: TvkuQueueCreateInfoArr;

    procedure SetQueueCreateInfoCount(aValue: Integer);
    procedure SetQueueCreateInfo(const aIndex: Integer; aValue: TvkuQueueCreateInfo);
    procedure SetQueueCreateInfos(aValue: TvkuQueueCreateInfoArr);
  public
    property Flags:             VkDeviceCreateFlags       read fFlags write fFlags;
    property EnabledLayers:     TStrings                  read GetLayers;
    property EnabledExtensions: TStrings                  read GetExtensions;
    property EnabledFeatures:   TVkPhysicalDeviceFeatures read fFeatures;

    property QueueCreateInfos: TvkuQueueCreateInfoArr read GetQueueCreateInfos write SetQueueCreateInfos;
    property QueueCreateInfoCount: Integer read GetQueueCreateInfoCount write SetQueueCreateInfoCount;
    property QueueCreateInfo[const aIndex: Integer]: TvkuQueueCreateInfo read GetQueueCreateInfo write SetQueueCreateInfo;

    function CreateDevice(
      const aPhysicalDevice: VkPhysicalDevice): TvkuDevice;
    function CreateDevice(
      const aPhysicalDevice: VkPhysicalDevice;
      const aAllocHandler: TvkuAllocationHandler;
      const aOwnsHandler: Boolean): TvkuDevice;

    constructor Create(const aInstance: TvkuInstance);
    destructor Destroy; override;
  end;

implementation

uses
  uvkuUtils;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TvkuDeviceEx///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TvkuDeviceEx.Destroy;
begin
  inherited Destroy;
  if fOwnsHandler then
    FreeAndNil(fAllocHandler);
end;

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

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

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuDeviceFactory.GetQueueCreateInfoCount: Integer;
begin
  result := Length(fQueueCreateInfos);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuDeviceFactory.GetQueueCreateInfo(const aIndex: Integer): TvkuQueueCreateInfo;
begin
  if (aIndex < low(fQueueCreateInfos)) or (aIndex > high(fQueueCreateInfos)) then
    raise TvkuException.CreateFmt('index (%d) out of range (%d : %d)', [aIndex, Low(fQueueCreateInfos), High(fQueueCreateInfos)]);
  result := fQueueCreateInfos[aIndex];
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuDeviceFactory.GetQueueCreateInfos: TvkuQueueCreateInfoArr;
begin
  result := fQueueCreateInfos;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuDeviceFactory.SetQueueCreateInfoCount(aValue: Integer);
begin
  if (aValue < 0) then
    aValue := 0;
  SetLength(fQueueCreateInfos, aValue);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuDeviceFactory.SetQueueCreateInfo(const aIndex: Integer; aValue: TvkuQueueCreateInfo);
begin
  if (aIndex < low(fQueueCreateInfos)) or (aIndex > high(fQueueCreateInfos)) then
    raise TvkuException.CreateFmt('index (%d) out of range (%d : %d)', [aIndex, Low(fQueueCreateInfos), High(fQueueCreateInfos)]);
  fQueueCreateInfos[aIndex] := aValue;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuDeviceFactory.SetQueueCreateInfos(aValue: TvkuQueueCreateInfoArr);
begin
  fQueueCreateInfos := aValue;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuDeviceFactory.CreateDevice(const aPhysicalDevice: VkPhysicalDevice): TvkuDevice;
begin
  result := CreateDevice(aPhysicalDevice, nil, false);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuDeviceFactory.CreateDevice(const aPhysicalDevice: VkPhysicalDevice;
  const aAllocHandler: TvkuAllocationHandler; const aOwnsHandler: Boolean): TvkuDevice;
var
  CreateInfo: TVkDeviceCreateInfo;
  QueueInfos: array of TVkDeviceQueueCreateInfo;
  lay: array of PVkChar;
  ext: array of PVkChar;
  i: Integer;
  prio: VkFloat;
  err: TVkResult;
begin
  if (Length(fQueueCreateInfos) <= 0) then
    raise TvkuException.Create('no queue create infos assigned');

  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]);

  SetLength(QueueInfos, Length(fQueueCreateInfos));
  for i := 0 to high(fQueueCreateInfos) do begin
    FillByte(QueueInfos[i], SizeOf(QueueInfos[0]), 0);
    QueueInfos[i].sType            := VK_STRUCTURE_TYPE_DEVICE_QUEUE_CREATE_INFO;
    QueueInfos[i].pNext            := nil;
    QueueInfos[i].flags            := fQueueCreateInfos[i].Flags;
    QueueInfos[i].queueFamilyIndex := fQueueCreateInfos[i].FamilyIndex;
    QueueInfos[i].queueCount       := Length(fQueueCreateInfos[i].Priorities);
    if (QueueInfos[i].queueCount > 0)
      then QueueInfos[i].pQueuePriorities := @fQueueCreateInfos[i].Priorities[0]
      else QueueInfos[i].pQueuePriorities := nil;
  end;

  FillByte(CreateInfo, SizeOf(CreateInfo), 0);
  CreateInfo.sType                   := VK_STRUCTURE_TYPE_DEVICE_CREATE_INFO;
  CreateInfo.pNext                   := nil;
  CreateInfo.flags                   := fFlags;
  CreateInfo.queueCreateInfoCount    := Length(QueueInfos);
  CreateInfo.pQueueCreateInfos       := @QueueInfos[0];
  CreateInfo.enabledLayerCount       := Length(lay);
  CreateInfo.ppEnabledLayerNames     := @lay[0];
  CreateInfo.enabledExtensionCount   := Length(ext);
  CreateInfo.ppEnabledExtensionNames := @ext[0];
  CreateInfo.pEnabledFeatures        := @fFeatures;

  if Assigned(aAllocHandler)
    then result := TvkuDeviceEx.Create(aPhysicalDevice, CreateInfo, fInstance.InstanceCommands, aAllocHandler.GetAllocationCallbacks)
    else result := TvkuDeviceEx.Create(aPhysicalDevice, CreateInfo, fInstance.InstanceCommands);
  try
    TvkuDeviceEx(result).fAllocHandler := aAllocHandler;
    TvkuDeviceEx(result).fOwnsHandler  := aOwnsHandler;
  except
    FreeAndNil(result);
    raise;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TvkuDeviceFactory.Create(const aInstance: TvkuInstance);
begin
  inherited Create;
  FillByte(fFeatures, SizeOf(fFeatures), 0);
  fInstance   := aInstance;
  fLayers     := TStringList.Create;
  fExtensions := TStringList.Create;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TvkuDeviceFactory.Destroy;
begin
  FreeAndNil(fLayers);
  FreeAndNil(fExtensions);
  inherited Destroy;
end;

end.