Vulkan/projects/utils/uvkuShaderModuleFactory.pas

unit uvkuShaderModuleFactory;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  Vulkan, uvkuFactoryBase, uvkuShaderModule;

type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TvkuShaderModuleFactory = class(TvkuDeviceObjFactory)
  private
    fFlags: VkShaderModuleCreateFlags;
    fShaderCode: PVkVoid;
    fShaderCodeSize: VkSize;

    procedure ReallocShaderCode(const aSize: VkSize);
    procedure SetGlslCode(const aCode: PVkVoid; const aSize: VkSize; const aStage: VkShaderStageFlags);
  public
    property Flags: VkShaderModuleCreateFlags read fFlags write fFlags;

    procedure SetShaderCode(const aCode: PVkVoid; const aSize: VkSize);

    procedure LoadSpvCode(const aStream: TStream; aSize: VkSize = 0);
    procedure LoadSpvCode(const aFilename: String);

    procedure SetGlslCode(const aCode: String; const aStage: VkShaderStageFlags);
    procedure LoadGlslCode(const aStream: TStream; const aStage: VkShaderStageFlags; aSize: VkSize = 0);
    procedure LoadGlslCode(const aFilename: String; const aStage: VkShaderStageFlags);

    function GetStructure: TVkShaderModuleCreateInfo;
    procedure SetStructure(const aData: TVkShaderModuleCreateInfo);

    function CreateShaderModule: TvkuShaderModule;

    procedure BeforeDestruction; override;
  end;

implementation

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TvkuShaderModuleFactory////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuShaderModuleFactory.ReallocShaderCode(const aSize: VkSize);
begin
  if Assigned(fShaderCode) then
    Freememory(fShaderCode);
  fShaderCodeSize := aSize;
  if (fShaderCodeSize > 0) then
    fShaderCode := GetMemory(fShaderCodeSize);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuShaderModuleFactory.SetGlslCode(const aCode: PVkVoid; const aSize: VkSize; const aStage: VkShaderStageFlags);
var p: PVkUint32;
begin
  ReallocShaderCode(3 * SizeOf(VkUint32) + aSize + 1);
  p := fShaderCode;
  (p + 0)^ := $07230203;
  (p + 1)^ := 0;
  (p + 2)^ := VkUint32(aStage);
  Move(aCode^, (p + 3)^, aSize);
  PByte(fShaderCode + 3 * SizeOf(VkUint32) + aSize)^ := 0;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuShaderModuleFactory.SetShaderCode(const aCode: PVkVoid; const aSize: VkSize);
begin
  ReallocShaderCode(aSize);
  Move(aCode^, fShaderCode^, fShaderCodeSize);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuShaderModuleFactory.LoadSpvCode(const aStream: TStream; aSize: VkSize);
begin
  if (aSize = 0) then
    aSize := aStream.Size - aStream.Position;
  ReallocShaderCode(aSize);
  aStream.Read(fShaderCode^, aSize);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuShaderModuleFactory.LoadSpvCode(const aFilename: String);
var fs: TFileStream;
begin
  fs := TFileStream.Create(aFilename, fmOpenRead);
  try
    LoadSpvCode(fs);
  finally
    FreeAndNil(fs);
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuShaderModuleFactory.SetGlslCode(const aCode: String; const aStage: VkShaderStageFlags);
begin
  SetGlslCode(PVkVoid(PAnsiChar(aCode)), Length(aCode), aStage);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuShaderModuleFactory.LoadGlslCode(const aStream: TStream; const aStage: VkShaderStageFlags; aSize: VkSize);
var mem: PVkVoid;
begin
  if (aSize = 0) then
    aSize := aStream.Size - aStream.Position;
  mem := GetMemory(aSize);
  try
    aStream.Read(mem^, aSize);
    SetGlslCode(mem, aSize, aStage);
  finally
    FreeMemory(mem);
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuShaderModuleFactory.LoadGlslCode(const aFilename: String; const aStage: VkShaderStageFlags);
var fs: TFileStream;
begin
  fs := TFileStream.Create(aFilename, fmOpenRead);
  try
    LoadGlslCode(fs, aStage);
  finally
    FreeAndNil(fs);
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuShaderModuleFactory.GetStructure: TVkShaderModuleCreateInfo;
begin
  FillByte(result, SizeOf(result), 0);
  result.sType    := VK_STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO;
  result.pNext    := nil;
  result.flags    := fFlags;
  result.codeSize := fShaderCodeSize;
  result.pCode    := fShaderCode;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuShaderModuleFactory.SetStructure(const aData: TVkShaderModuleCreateInfo);
begin
  fFlags := aData.flags;
  SetShaderCode(aData.pCode, aData.codeSize);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TvkuShaderModuleFactory.CreateShaderModule: TvkuShaderModule;
var
  CreateInfo: TVkShaderModuleCreateInfo;
begin
  FillByte(CreateInfo, SizeOf(CreateInfo), 0);
  CreateInfo.sType    := VK_STRUCTURE_TYPE_SHADER_MODULE_CREATE_INFO;
  CreateInfo.pNext    := nil;
  CreateInfo.flags    := fFlags;
  CreateInfo.codeSize := fShaderCodeSize;
  CreateInfo.pCode    := fShaderCode;
  result := TvkuShaderModule.Create(CreateInfo, DeviceCommands, AllocCallbacks);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TvkuShaderModuleFactory.BeforeDestruction;
begin
  inherited BeforeDestruction;
  ReallocShaderCode(0);
end;

end.