Vulkan/projects/triangle/uMainForm.pas

unit uMainForm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  Vulkan, uvkuAllocationHandler,
  uvkuInstance, uvkuInstanceFactory,
  uvkuSurface, uvkuSurfaceFactory,
  uvkuDevice, uvkuDeviceFactory;

type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TCustomAllocHandler = class(TvkuAllocationHandler)
  protected
    function AllocateMemory(const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid; override;
    function ReallocateMemory(const aOriginal: PVkVoid; const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid; override;
    procedure FreeMemory(const aMemory: PVkVoid); override;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TMainForm = class(TForm)
    RenderPanel: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    fAllocHandler: TCustomAllocHandler;
    fInstance: TvkuInstance;
    fDevice: TvkuDevice;
    fSurface: TvkuSurface;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}
{$I Vulkan.inc}

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TCustomAllocHandler////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TCustomAllocHandler.AllocateMemory(const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid;
begin
  result := inherited AllocateMemory(aSize, aAlignment, aScope);
  WriteLn(Format('%d bytes of memory allocated at %p', [ aSize, result ]));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TCustomAllocHandler.ReallocateMemory(const aOriginal: PVkVoid; const aSize: VkSize; const aAlignment: VkSize; const aScope: TVkSystemAllocationScope): PVkVoid;
var p: PVkVoid;
begin
  p := aOriginal;
  result := inherited ReallocateMemory(aOriginal, aSize, aAlignment, aScope);
  WriteLn(Format('%d bytes of memory (from %p) reallocated at %p', [ aSize, p, result ]));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TCustomAllocHandler.FreeMemory(const aMemory: PVkVoid);
begin
  WriteLn(Format('free memory at %p', [ aMemory ]));
  inherited FreeMemory(aMemory);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TMainForm//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormCreate(Sender: TObject);
var
  PhyDevices: TvkuPhysicalDeviceArr;
  iFactory: TvkuInstanceFactory;
  dFactory: TvkuDeviceFactory;
  sFactory: TvkuSurfaceFactory;
  qci: TvkuQueueCreateInfo;
begin
  fAllocHandler := TCustomAllocHandler.Create;

  WriteLn('create vulkan instance');
  iFactory := TvkuInstanceFactory.Create;
  try
    iFactory.Extensions.Add(VK_KHR_SURFACE_EXTENSION_NAME);
    iFactory.Extensions.Add(TvkuInstanceFactory.GetPlatformSurfaceExtensionName);
    fInstance := iFactory.CreateInstance(fAllocHandler, false);
  finally
    FreeAndNil(iFactory);
  end;

  PhyDevices := fInstance.GetPhysicalDevices;
  if (Length(PhyDevices) <= 0) then
    raise Exception.Create('unable to get physical device');

  WriteLn('create vulkan surface');
  sFactory := TvkuSurfaceFactory.Create(fInstance);
  try
    sFactory.WinControl := RenderPanel;
    fSurface := sFactory.CreateSurface(fAllocHandler, false);
  finally
    FreeAndNil(sFactory);
  end;

  WriteLn('create vulkan device');
  dFactory := TvkuDeviceFactory.Create(fInstance);
  try
    SetLength(qci.Priorities, 1);
    qci.Priorities[0] := 1.0;
    qci.FamilyIndex   := 0;
    qci.Flags         := 0;

    dFactory.QueueCreateInfoCount := 1;
    dFactory.QueueCreateInfo[0]   := qci;

    fDevice := dFactory.CreateDevice(PhyDevices[0], fAllocHandler, false);
  finally
    FreeAndNil(dFactory);
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(fDevice);
  FreeAndNil(fSurface);
  FreeAndNil(fInstance);
  FreeAndNil(fAllocHandler);
end;

end.