|
- unit uMainForm;
-
- {$mode objfpc}{$H+}
-
- interface
-
- uses
- Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
- Vulkan, uvkuInstance, uvkuInstanceFactory, uvkuPhysicalDevice, uvkuUtils, uvkuAllocationHandler, 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)
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- private
- fAllocHandler: TCustomAllocHandler;
- fInstance: TvkuInstance;
- fDevice: TvkuDevice;
- public
- { public declarations }
- end;
-
- var
- MainForm: TMainForm;
-
- implementation
-
- {$R *.lfm}
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //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;
- QueueFamProps: TVkQueueFamilyPropertiesArr;
- iFactory: TvkuInstanceFactory;
- dFactory: TvkuDeviceFactory;
- qci: TvkuQueueCreateInfo;
- begin
- fAllocHandler := TCustomAllocHandler.Create;
-
- WriteLn('create vulkan instance');
- iFactory := TvkuInstanceFactory.Create;
- try
- 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 device');
- dFactory := TvkuDeviceFactory.Create;
- 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(fInstance);
- FreeAndNil(fAllocHandler);
- end;
-
- end.
|