Drezil/dear-imgui.hs
1
0
Fork 0
mirror of https://github.com/Drezil/dear-imgui.hs.git synced 2024-11-26 10:37:00 +00:00
Code Issues Packages Projects Releases Wiki Activity

Recover init and shutdown from withVulkan (#40)

Browse Source
This commit is contained in:
Alexander Bondarenko 2021-03-11 12:00:30 +03:00 committed by GitHub
parent 007b3cccb8
commit 2eddbdfa04
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 42 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
src/DearImGui/Vulkan.hs
View File

@ -12,6 +12,8 @@ Vulkan backend for Dear ImGui.
module DearImGui.Vulkan module DearImGui.Vulkan
( InitInfo(..) ( InitInfo(..)
, withVulkan , withVulkan
, vulkanInit
, vulkanShutdown
, vulkanNewFrame , vulkanNewFrame
, vulkanRenderDrawData , vulkanRenderDrawData
, vulkanCreateFontsTexture , vulkanCreateFontsTexture
@ -28,7 +30,7 @@ import Data.Word
import Foreign.Marshal.Alloc import Foreign.Marshal.Alloc
( alloca ) ( alloca )
import Foreign.Ptr import Foreign.Ptr
( Ptr, freeHaskellFunPtr, nullPtr ) ( FunPtr, Ptr, freeHaskellFunPtr, nullPtr )
import Foreign.Storable import Foreign.Storable
( Storable(poke) ) ( Storable(poke) )
@ -83,7 +85,15 @@ data InitInfo =
-- | Wraps @ImGui_ImplVulkan_Init@ and @ImGui_ImplVulkan_Shutdown@. -- | Wraps @ImGui_ImplVulkan_Init@ and @ImGui_ImplVulkan_Shutdown@.
withVulkan :: MonadUnliftIO m => InitInfo -> Vulkan.RenderPass -> ( Bool -> m a ) -> m a withVulkan :: MonadUnliftIO m => InitInfo -> Vulkan.RenderPass -> ( Bool -> m a ) -> m a
withVulkan ( InitInfo {..} ) renderPass action = do withVulkan initInfo renderPass action =
bracket
( vulkanInit initInfo renderPass )
vulkanShutdown
( \ ( _, initResult ) -> action initResult )
-- | Wraps @ImGui_ImplVulkan_Init@
vulkanInit :: MonadUnliftIO m => InitInfo -> Vulkan.RenderPass -> m (FunPtr (Vulkan.Result -> IO ()), Bool)
vulkanInit ( InitInfo {..} ) renderPass = do
let let
instancePtr :: Ptr Vulkan.Instance_T instancePtr :: Ptr Vulkan.Instance_T
instancePtr = Vulkan.instanceHandle instance' instancePtr = Vulkan.instanceHandle instance'
@ -97,38 +107,36 @@ withVulkan ( InitInfo {..} ) renderPass action = do
withCallbacks f = case mbAllocator of withCallbacks f = case mbAllocator of
Nothing -> f nullPtr Nothing -> f nullPtr
Just callbacks -> alloca ( \ ptr -> poke ptr callbacks *> f ptr ) Just callbacks -> alloca ( \ ptr -> poke ptr callbacks *> f ptr )
bracket liftIO do
( liftIO do checkResultFunPtr <- $( C.mkFunPtr [t| Vulkan.Result -> IO () |] ) checkResult
checkResultFunPtr <- $( C.mkFunPtr [t| Vulkan.Result -> IO () |] ) checkResult initResult <- withCallbacks \ callbacksPtr ->
initResult <- withCallbacks \ callbacksPtr -> [C.block| bool {
[C.block| bool { ImGui_ImplVulkan_InitInfo initInfo;
ImGui_ImplVulkan_InitInfo initInfo; VkInstance instance = { $( VkInstance_T* instancePtr ) };
VkInstance instance = { $( VkInstance_T* instancePtr ) }; initInfo.Instance = instance;
initInfo.Instance = instance; VkPhysicalDevice physicalDevice = { $( VkPhysicalDevice_T* physicalDevicePtr ) };
VkPhysicalDevice physicalDevice = { $( VkPhysicalDevice_T* physicalDevicePtr ) }; initInfo.PhysicalDevice = physicalDevice;
initInfo.PhysicalDevice = physicalDevice; VkDevice device = { $( VkDevice_T* devicePtr ) };
VkDevice device = { $( VkDevice_T* devicePtr ) }; initInfo.Device = device;
initInfo.Device = device; initInfo.QueueFamily = $(uint32_t queueFamily);
initInfo.QueueFamily = $(uint32_t queueFamily); VkQueue queue = { $( VkQueue_T* queuePtr ) };
VkQueue queue = { $( VkQueue_T* queuePtr ) }; initInfo.Queue = queue;
initInfo.Queue = queue; initInfo.PipelineCache = $(VkPipelineCache pipelineCache);
initInfo.PipelineCache = $(VkPipelineCache pipelineCache); initInfo.DescriptorPool = $(VkDescriptorPool descriptorPool);
initInfo.DescriptorPool = $(VkDescriptorPool descriptorPool); initInfo.Subpass = $(uint32_t subpass);
initInfo.Subpass = $(uint32_t subpass); initInfo.MinImageCount = $(uint32_t minImageCount);
initInfo.MinImageCount = $(uint32_t minImageCount); initInfo.ImageCount = $(uint32_t imageCount);
initInfo.ImageCount = $(uint32_t imageCount); initInfo.MSAASamples = $(VkSampleCountFlagBits msaaSamples);
initInfo.MSAASamples = $(VkSampleCountFlagBits msaaSamples); initInfo.Allocator = $(VkAllocationCallbacks* callbacksPtr);
initInfo.Allocator = $(VkAllocationCallbacks* callbacksPtr); initInfo.CheckVkResultFn = $( void (*checkResultFunPtr)(VkResult) );
initInfo.CheckVkResultFn = $( void (*checkResultFunPtr)(VkResult) ); return ImGui_ImplVulkan_Init(&initInfo, $(VkRenderPass renderPass) );
return ImGui_ImplVulkan_Init(&initInfo, $(VkRenderPass renderPass) ); }|]
}|] pure ( checkResultFunPtr, initResult /= 0 )
pure ( checkResultFunPtr, initResult /= 0 )
) vulkanShutdown :: MonadIO m => (FunPtr a, b) -> m ()
( \ ( checkResultFunPtr, _ ) -> liftIO do vulkanShutdown ( checkResultFunPtr, _ ) = liftIO do
[C.exp| void { ImGui_ImplVulkan_Shutdown(); } |] [C.exp| void { ImGui_ImplVulkan_Shutdown(); } |]
freeHaskellFunPtr checkResultFunPtr freeHaskellFunPtr checkResultFunPtr
)
( \ ( _, initResult ) -> action initResult )
-- | Wraps @ImGui_ImplVulkan_NewFrame@. -- | Wraps @ImGui_ImplVulkan_NewFrame@.
vulkanNewFrame :: MonadIO m => m () vulkanNewFrame :: MonadIO m => m ()