module Render.ImGui
  ( allocate

  , allocateWithFonts
  , allocateWith

  , renderWith

  , allocateLoop
  , beforeLoop
  , afterLoop

  , capturingKeyboard
  , capturingMouse

  , mkDrawData
  , draw
  ) where

import RIO

import Control.Monad.Trans.Resource (ReleaseKey, ResourceT, register, release)
import DearImGui qualified as ImGui
import DearImGui.FontAtlas qualified as FontAtlas
import DearImGui.GLFW (glfwNewFrame, glfwShutdown)
import DearImGui.GLFW.Vulkan (glfwInitForVulkan)
import DearImGui.Vulkan (InitInfo(..))
import DearImGui.Vulkan qualified as ImGui
import Engine.Stage.Component qualified as Stage
import Engine.Types (GlobalHandles(..), StageRIO)
import Engine.Vulkan.Types (HasRenderPass(..), HasSwapchain(..), Queues(..), getDevice, getMultisample)
import Resource.CommandBuffer qualified as CommandBuffer
import Resource.DescriptorSet qualified as DescriptorSet
import RIO.App (appEnv)
import Vulkan.Core10 qualified as Vk
import Vulkan.Exception (VulkanException(..))
import Vulkan.NamedType (type (:::))
import Vulkan.Utils.QueueAssignment (QueueFamilyIndex(..))

allocate
  :: ( HasSwapchain swapchain
     , HasRenderPass renderpass
     )
  => swapchain
  -> renderpass
  -> Word32
  -> ResourceT (StageRIO st) ReleaseKey
allocate :: forall swapchain renderpass st.
(HasSwapchain swapchain, HasRenderPass renderpass) =>
swapchain
-> renderpass -> Word32 -> ResourceT (StageRIO st) ReleaseKey
allocate swapchain
swapchain renderpass
renderpass Word32
subpassIx =
  ((ReleaseKey, ()) -> ReleaseKey)
-> ResourceT (StageRIO st) (ReleaseKey, ())
-> ResourceT (StageRIO st) ReleaseKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReleaseKey, ()) -> ReleaseKey
forall a b. (a, b) -> a
fst (ResourceT (StageRIO st) (ReleaseKey, ())
 -> ResourceT (StageRIO st) ReleaseKey)
-> ResourceT (StageRIO st) (ReleaseKey, ())
-> ResourceT (StageRIO st) ReleaseKey
forall a b. (a -> b) -> a -> b
$
    swapchain
-> renderpass
-> Word32
-> ResourceT (StageRIO st) ()
-> ResourceT (StageRIO st) (ReleaseKey, ())
forall swapchain renderpass st a.
(HasSwapchain swapchain, HasRenderPass renderpass) =>
swapchain
-> renderpass
-> Word32
-> ResourceT (StageRIO st) a
-> ResourceT (StageRIO st) (ReleaseKey, a)
allocateWith swapchain
swapchain renderpass
renderpass Word32
subpassIx (ResourceT (StageRIO st) ()
 -> ResourceT (StageRIO st) (ReleaseKey, ()))
-> ResourceT (StageRIO st) ()
-> ResourceT (StageRIO st) (ReleaseKey, ())
forall a b. (a -> b) -> a -> b
$
      () -> ResourceT (StageRIO st) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

allocateWithFonts
  :: ( HasSwapchain swapchain
     , HasRenderPass renderpass
     , Traversable t
     )
  => swapchain
  -> renderpass
  -> Word32
  -> t FontAtlas.FontSource
  -> ResourceT (StageRIO st) (ReleaseKey, t ImGui.Font)
allocateWithFonts :: forall swapchain renderpass (t :: * -> *) st.
(HasSwapchain swapchain, HasRenderPass renderpass,
 Traversable t) =>
swapchain
-> renderpass
-> Word32
-> t FontSource
-> ResourceT (StageRIO st) (ReleaseKey, t Font)
allocateWithFonts swapchain
swapchain renderpass
renderpass Word32
subpassIx t FontSource
fonts =
  swapchain
-> renderpass
-> Word32
-> ResourceT (StageRIO st) (t Font)
-> ResourceT (StageRIO st) (ReleaseKey, t Font)
forall swapchain renderpass st a.
(HasSwapchain swapchain, HasRenderPass renderpass) =>
swapchain
-> renderpass
-> Word32
-> ResourceT (StageRIO st) a
-> ResourceT (StageRIO st) (ReleaseKey, a)
allocateWith swapchain
swapchain renderpass
renderpass Word32
subpassIx do
    t Font
loaded <- t FontSource -> ResourceT (StageRIO st) (t Font)
forall (m :: * -> *) (t :: * -> *).
(MonadIO m, Traversable t) =>
t FontSource -> m (t Font)
FontAtlas.rebuild t FontSource
fonts
    ReleaseKey
_atlasKey <- IO () -> ResourceT (StageRIO st) ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
register IO ()
forall (m :: * -> *). MonadIO m => m ()
FontAtlas.clear
    pure t Font
loaded

allocateWith
  :: ( HasSwapchain swapchain
     , HasRenderPass renderpass
     )
  => swapchain
  -> renderpass
  -> Word32
  -> ResourceT (StageRIO st) a
  -> ResourceT (StageRIO st) (ReleaseKey, a)
allocateWith :: forall swapchain renderpass st a.
(HasSwapchain swapchain, HasRenderPass renderpass) =>
swapchain
-> renderpass
-> Word32
-> ResourceT (StageRIO st) a
-> ResourceT (StageRIO st) (ReleaseKey, a)
allocateWith swapchain
swapchain renderpass
renderpass Word32
subpassIx ResourceT (StageRIO st) a
action = do
  Utf8Builder -> ResourceT (StageRIO st) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Initializing DearImGui"
  IO ()
debugReleaseFinished <- ResourceT (StageRIO st) () -> ResourceT (StageRIO st) (IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (IO a)
toIO (Utf8Builder -> ResourceT (StageRIO st) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Released DearImGui")
  ResourceT (StageRIO st) ReleaseKey -> ResourceT (StageRIO st) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ResourceT (StageRIO st) ReleaseKey -> ResourceT (StageRIO st) ())
-> ResourceT (StageRIO st) ReleaseKey -> ResourceT (StageRIO st) ()
forall a b. (a -> b) -> a -> b
$! IO () -> ResourceT (StageRIO st) ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
register IO ()
debugReleaseFinished

  Context
ctx <- ResourceT (StageRIO st) Context
forall (m :: * -> *). MonadIO m => m Context
ImGui.createContext
  ReleaseKey
_ctxKey <- IO () -> ResourceT (StageRIO st) ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
register (IO () -> ResourceT (StageRIO st) ReleaseKey)
-> IO () -> ResourceT (StageRIO st) ReleaseKey
forall a b. (a -> b) -> a -> b
$ Context -> IO ()
forall (m :: * -> *). MonadIO m => Context -> m ()
ImGui.destroyContext Context
ctx

  context :: GlobalHandles
context@GlobalHandles{Window
Allocator
Var Extent2D
StageSwitchVar
SurfaceKHR
Device
Instance
PhysicalDevice
Queues (QueueFamilyIndex, Queue)
Options
PhysicalDeviceInfo
$sel:ghWindow:GlobalHandles :: GlobalHandles -> Window
$sel:ghSurface:GlobalHandles :: GlobalHandles -> SurfaceKHR
$sel:ghStageSwitch:GlobalHandles :: GlobalHandles -> StageSwitchVar
$sel:ghScreenVar:GlobalHandles :: GlobalHandles -> Var Extent2D
$sel:ghQueues:GlobalHandles :: GlobalHandles -> Queues (QueueFamilyIndex, Queue)
$sel:ghPhysicalDeviceInfo:GlobalHandles :: GlobalHandles -> PhysicalDeviceInfo
$sel:ghPhysicalDevice:GlobalHandles :: GlobalHandles -> PhysicalDevice
$sel:ghOptions:GlobalHandles :: GlobalHandles -> Options
$sel:ghInstance:GlobalHandles :: GlobalHandles -> Instance
$sel:ghDevice:GlobalHandles :: GlobalHandles -> Device
$sel:ghAllocator:GlobalHandles :: GlobalHandles -> Allocator
ghStageSwitch :: StageSwitchVar
ghScreenVar :: Var Extent2D
ghQueues :: Queues (QueueFamilyIndex, Queue)
ghAllocator :: Allocator
ghDevice :: Device
ghPhysicalDeviceInfo :: PhysicalDeviceInfo
ghPhysicalDevice :: PhysicalDevice
ghInstance :: Instance
ghSurface :: SurfaceKHR
ghWindow :: Window
ghOptions :: Options
..} <- (App GlobalHandles st -> GlobalHandles)
-> ResourceT (StageRIO st) GlobalHandles
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks App GlobalHandles st -> GlobalHandles
forall env st. App env st -> env
appEnv

  let (QueueFamilyIndex Word32
queueFamily, Queue
queue) = Queues (QueueFamilyIndex, Queue) -> (QueueFamilyIndex, Queue)
forall q. Queues q -> q
qGraphics Queues (QueueFamilyIndex, Queue)
ghQueues

  (ReleaseKey
_poolKey, DescriptorPool
pool) <- Word32
-> TypeMap Word32
-> ResourceT (StageRIO st) (ReleaseKey, DescriptorPool)
forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasVulkan env) =>
Word32 -> TypeMap Word32 -> m (ReleaseKey, DescriptorPool)
DescriptorSet.allocatePool Word32
1 TypeMap Word32
dsSizes

  let
    initInfo :: InitInfo
initInfo = InitInfo :: Instance
-> PhysicalDevice
-> Device
-> Word32
-> Queue
-> PipelineCache
-> DescriptorPool
-> Word32
-> Word32
-> Word32
-> SampleCountFlagBits
-> Maybe AllocationCallbacks
-> (Result -> IO ())
-> InitInfo
InitInfo
      { instance' :: Instance
instance'      = Instance
ghInstance
      , physicalDevice :: PhysicalDevice
physicalDevice = PhysicalDevice
ghPhysicalDevice
      , device :: Device
device         = Device
ghDevice
      , queueFamily :: Word32
queueFamily    = Word32
queueFamily
      , queue :: Queue
queue          = Queue
queue

      , minImageCount :: Word32
minImageCount  = swapchain -> Word32
forall a. HasSwapchain a => a -> Word32
getMinImageCount swapchain
swapchain
      , imageCount :: Word32
imageCount     = swapchain -> Word32
forall a. HasSwapchain a => a -> Word32
getImageCount swapchain
swapchain
      , msaaSamples :: SampleCountFlagBits
msaaSamples    = swapchain -> SampleCountFlagBits
forall a. HasSwapchain a => a -> SampleCountFlagBits
getMultisample swapchain
swapchain

      , subpass :: Word32
subpass        = Word32
subpassIx
      , pipelineCache :: PipelineCache
pipelineCache  = PipelineCache
forall a. IsHandle a => a
Vk.NULL_HANDLE

      , descriptorPool :: DescriptorPool
descriptorPool = DescriptorPool
pool

      , mbAllocator :: Maybe AllocationCallbacks
mbAllocator    = Maybe AllocationCallbacks
forall a. Maybe a
Nothing
      , checkResult :: Result -> IO ()
checkResult    = \case { Result
Vk.SUCCESS -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (); Result
e -> VulkanException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (VulkanException -> IO ()) -> VulkanException -> IO ()
forall a b. (a -> b) -> a -> b
$ Result -> VulkanException
VulkanException Result
e }
      }

  res :: (FunPtr (Result -> IO ()), Bool)
res@(FunPtr (Result -> IO ())
_cb, Bool
initOk) <- InitInfo
-> RenderPass
-> ResourceT (StageRIO st) (FunPtr (Result -> IO ()), Bool)
forall (m :: * -> *).
MonadIO m =>
InitInfo -> RenderPass -> m (FunPtr (Result -> IO ()), Bool)
ImGui.vulkanInit InitInfo
initInfo (renderpass -> RenderPass
forall a. HasRenderPass a => a -> RenderPass
getRenderPass renderpass
renderpass)
  Bool -> ResourceT (StageRIO st) () -> ResourceT (StageRIO st) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
initOk do
    Utf8Builder -> ResourceT (StageRIO st) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
"DearImGui vulkan initialization failed"
    ResourceT (StageRIO st) ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
  ReleaseKey
key <- IO () -> ResourceT (StageRIO st) ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
register (IO () -> ResourceT (StageRIO st) ReleaseKey)
-> IO () -> ResourceT (StageRIO st) ReleaseKey
forall a b. (a -> b) -> a -> b
$ (FunPtr (Result -> IO ()), Bool) -> IO ()
forall (m :: * -> *) a b. MonadIO m => (FunPtr a, b) -> m ()
ImGui.vulkanShutdown (FunPtr (Result -> IO ()), Bool)
res

  a
actionRes <- ResourceT (StageRIO st) a
action

  -- TODO: oneshots
  (ReleaseKey
oneshotPoolKey, Queues CommandPool
oneshotPool) <- GlobalHandles
-> ResourceT (StageRIO st) (ReleaseKey, Queues CommandPool)
forall context (m :: * -> *).
(HasVulkan context, MonadResource m) =>
context -> m (ReleaseKey, Queues CommandPool)
CommandBuffer.allocatePools GlobalHandles
context
  GlobalHandles
-> Queues CommandPool
-> (forall q. Queues q -> q)
-> (CommandBuffer -> ResourceT (StageRIO st) ())
-> ResourceT (StageRIO st) ()
forall context (m :: * -> *).
(HasVulkan context, MonadUnliftIO m) =>
context
-> Queues CommandPool
-> (forall q. Queues q -> q)
-> (CommandBuffer -> m ())
-> m ()
CommandBuffer.oneshot_ GlobalHandles
context Queues CommandPool
oneshotPool forall q. Queues q -> q
qGraphics \CommandBuffer
cb -> do
    Bool
fontsOk <- CommandBuffer -> ResourceT (StageRIO st) Bool
forall (m :: * -> *). MonadIO m => CommandBuffer -> m Bool
ImGui.vulkanCreateFontsTexture CommandBuffer
cb
    Bool -> ResourceT (StageRIO st) () -> ResourceT (StageRIO st) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
fontsOk do
      Utf8Builder -> ResourceT (StageRIO st) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
"ImGui.vulkanCreateFontsTexture failed"
      ResourceT (StageRIO st) ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
  ReleaseKey -> ResourceT (StageRIO st) ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
release ReleaseKey
oneshotPoolKey
  ResourceT (StageRIO st) ()
forall (m :: * -> *). MonadIO m => m ()
ImGui.vulkanDestroyFontUploadObjects

  IO ()
debugReleaseStart <- ResourceT (StageRIO st) () -> ResourceT (StageRIO st) (IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (IO a)
toIO (Utf8Builder -> ResourceT (StageRIO st) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"Releasing DearImGui")
  ResourceT (StageRIO st) ReleaseKey -> ResourceT (StageRIO st) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ResourceT (StageRIO st) ReleaseKey -> ResourceT (StageRIO st) ())
-> ResourceT (StageRIO st) ReleaseKey -> ResourceT (StageRIO st) ()
forall a b. (a -> b) -> a -> b
$! IO () -> ResourceT (StageRIO st) ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
register IO ()
debugReleaseStart

  pure (ReleaseKey
key, a
actionRes)

dsSizes :: DescriptorSet.TypeMap Word32
dsSizes :: TypeMap Word32
dsSizes = (DescriptorType -> (DescriptorType, Word32))
-> [DescriptorType] -> TypeMap Word32
forall a b. (a -> b) -> [a] -> [b]
map (, Word32
100)
  [ DescriptorType
Vk.DESCRIPTOR_TYPE_SAMPLER
  , DescriptorType
Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER
  , DescriptorType
Vk.DESCRIPTOR_TYPE_SAMPLED_IMAGE
  , DescriptorType
Vk.DESCRIPTOR_TYPE_STORAGE_IMAGE
  , DescriptorType
Vk.DESCRIPTOR_TYPE_UNIFORM_TEXEL_BUFFER
  , DescriptorType
Vk.DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER
  , DescriptorType
Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER
  , DescriptorType
Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER
  , DescriptorType
Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC
  , DescriptorType
Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC
  , DescriptorType
Vk.DESCRIPTOR_TYPE_INPUT_ATTACHMENT
  ]

allocateLoop :: Bool -> ResourceT (StageRIO st) ()
allocateLoop :: forall st. Bool -> ResourceT (StageRIO st) ()
allocateLoop Bool
installCallbacks = do
  RIO (App GlobalHandles st) () -> ResourceT (StageRIO st) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RIO (App GlobalHandles st) () -> ResourceT (StageRIO st) ())
-> RIO (App GlobalHandles st) () -> ResourceT (StageRIO st) ()
forall a b. (a -> b) -> a -> b
$ Bool -> RIO (App GlobalHandles st) ()
forall st. Bool -> StageRIO st ()
beforeLoop Bool
installCallbacks
  IO ()
shutdownImGui <- RIO (App GlobalHandles st) (IO ())
-> ResourceT (StageRIO st) (IO ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (RIO (App GlobalHandles st) (IO ())
 -> ResourceT (StageRIO st) (IO ()))
-> RIO (App GlobalHandles st) (IO ())
-> ResourceT (StageRIO st) (IO ())
forall a b. (a -> b) -> a -> b
$ RIO (App GlobalHandles st) () -> RIO (App GlobalHandles st) (IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (IO a)
toIO RIO (App GlobalHandles st) ()
forall st. StageRIO st ()
afterLoop
  ResourceT (StageRIO st) ReleaseKey -> ResourceT (StageRIO st) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ResourceT (StageRIO st) ReleaseKey -> ResourceT (StageRIO st) ())
-> ResourceT (StageRIO st) ReleaseKey -> ResourceT (StageRIO st) ()
forall a b. (a -> b) -> a -> b
$! IO () -> ResourceT (StageRIO st) ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
register IO ()
shutdownImGui

{- | Initialize context to serve the draws in the current render loop.

You will need to trigger callbacks from DearImGui.GLFW if you're opting out of them here.

DearImgui will run your previously installed GLFW callbacks.
-}
beforeLoop :: Bool -> StageRIO st ()
beforeLoop :: forall st. Bool -> StageRIO st ()
beforeLoop Bool
installCallbacks = do
  Utf8Builder -> StageRIO st ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"glfwInitForVulkan"
  Window
window <- (App GlobalHandles st -> Window)
-> RIO (App GlobalHandles st) Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((App GlobalHandles st -> Window)
 -> RIO (App GlobalHandles st) Window)
-> (App GlobalHandles st -> Window)
-> RIO (App GlobalHandles st) Window
forall a b. (a -> b) -> a -> b
$ GlobalHandles -> Window
ghWindow (GlobalHandles -> Window)
-> (App GlobalHandles st -> GlobalHandles)
-> App GlobalHandles st
-> Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App GlobalHandles st -> GlobalHandles
forall env st. App env st -> env
appEnv
  Bool
success <- Window -> Bool -> RIO (App GlobalHandles st) Bool
forall (m :: * -> *). MonadIO m => Window -> Bool -> m Bool
glfwInitForVulkan Window
window Bool
installCallbacks
  Bool -> StageRIO st () -> StageRIO st ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
success do
    Utf8Builder -> StageRIO st ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"glfwInitForVulkan failed"

afterLoop :: StageRIO st ()
afterLoop :: forall st. StageRIO st ()
afterLoop = do
  Utf8Builder -> StageRIO st ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"glfwShutdown"
  (App GlobalHandles st -> Device)
-> RIO (App GlobalHandles st) Device
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks App GlobalHandles st -> Device
forall a. HasVulkan a => a -> Device
getDevice RIO (App GlobalHandles st) Device
-> (Device -> StageRIO st ()) -> StageRIO st ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Device -> StageRIO st ()
forall (io :: * -> *). MonadIO io => Device -> io ()
Vk.deviceWaitIdle
  Utf8Builder -> StageRIO st ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"glfwShutdown: Device idle"
  StageRIO st ()
forall (m :: * -> *). MonadIO m => m ()
glfwShutdown
  Utf8Builder -> StageRIO st ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug Utf8Builder
"glfwShutdown finished"

mkDrawData :: MonadIO m => m a -> m (a, ImGui.DrawData)
mkDrawData :: forall (m :: * -> *) a. MonadIO m => m a -> m (a, DrawData)
mkDrawData m a
action = do
  m ()
forall (m :: * -> *). MonadIO m => m ()
ImGui.vulkanNewFrame
  m ()
forall (m :: * -> *). MonadIO m => m ()
glfwNewFrame
  m ()
forall (m :: * -> *). MonadIO m => m ()
ImGui.newFrame
  a
result <- m a
action
  m ()
forall (m :: * -> *). MonadIO m => m ()
ImGui.render
  DrawData
drawData <- m DrawData
forall (m :: * -> *). MonadIO m => m DrawData
ImGui.getDrawData
  pure (a
result, DrawData
drawData)

draw :: MonadIO m => ImGui.DrawData -> Vk.CommandBuffer -> m ()
draw :: forall (m :: * -> *).
MonadIO m =>
DrawData -> CommandBuffer -> m ()
draw DrawData
drawData CommandBuffer
commandBuffer = do
  DrawData -> CommandBuffer -> Maybe Pipeline -> m ()
forall (m :: * -> *).
MonadIO m =>
DrawData -> CommandBuffer -> Maybe Pipeline -> m ()
ImGui.vulkanRenderDrawData DrawData
drawData CommandBuffer
commandBuffer Maybe Pipeline
forall a. Maybe a
Nothing

capturingKeyboard :: MonadIO m => m () -> m ()
capturingKeyboard :: forall (m :: * -> *). MonadIO m => m () -> m ()
capturingKeyboard m ()
action =
  m Bool
forall (m :: * -> *). MonadIO m => m Bool
ImGui.wantCaptureKeyboard m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`unless` m ()
action)

capturingMouse :: MonadIO m => m () -> m ()
capturingMouse :: forall (m :: * -> *). MonadIO m => m () -> m ()
capturingMouse m ()
action =
  m Bool
forall (m :: * -> *). MonadIO m => m Bool
ImGui.wantCaptureMouse m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`unless` m ()
action)

renderWith
  :: HasRenderPass renderpass
  => (t -> renderpass)
  -> "subpass index" ::: Word32
  -> Stage.Rendering t p st
  -> Stage.Rendering t p st
renderWith :: forall renderpass t p st.
HasRenderPass renderpass =>
(t -> renderpass) -> Word32 -> Rendering t p st -> Rendering t p st
renderWith t -> renderpass
getRP Word32
subpassIx Stage.Rendering{SwapchainResources -> ResourceT (StageRIO st) t
SwapchainResources -> t -> ResourceT (StageRIO st) p
$sel:rAllocateRP:Rendering :: forall rp p st.
Rendering rp p st
-> SwapchainResources -> ResourceT (StageRIO st) rp
$sel:rAllocateP:Rendering :: forall rp p st.
Rendering rp p st
-> SwapchainResources -> rp -> ResourceT (StageRIO st) p
rAllocateP :: SwapchainResources -> t -> ResourceT (StageRIO st) p
rAllocateRP :: SwapchainResources -> ResourceT (StageRIO st) t
..} = Rendering :: forall rp p st.
(SwapchainResources -> ResourceT (StageRIO st) rp)
-> (SwapchainResources -> rp -> ResourceT (StageRIO st) p)
-> Rendering rp p st
Stage.Rendering
  { SwapchainResources -> ResourceT (StageRIO st) t
$sel:rAllocateRP:Rendering :: SwapchainResources -> ResourceT (StageRIO st) t
rAllocateRP :: SwapchainResources -> ResourceT (StageRIO st) t
rAllocateRP
  , $sel:rAllocateP:Rendering :: SwapchainResources -> t -> ResourceT (StageRIO st) p
rAllocateP = \SwapchainResources
swapchain t
rps -> do
      ResourceT (StageRIO st) ReleaseKey -> ResourceT (StageRIO st) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ResourceT (StageRIO st) ReleaseKey -> ResourceT (StageRIO st) ())
-> ResourceT (StageRIO st) ReleaseKey -> ResourceT (StageRIO st) ()
forall a b. (a -> b) -> a -> b
$! SwapchainResources
-> renderpass -> Word32 -> ResourceT (StageRIO st) ReleaseKey
forall swapchain renderpass st.
(HasSwapchain swapchain, HasRenderPass renderpass) =>
swapchain
-> renderpass -> Word32 -> ResourceT (StageRIO st) ReleaseKey
allocate SwapchainResources
swapchain (t -> renderpass
getRP t
rps) Word32
subpassIx
      SwapchainResources -> t -> ResourceT (StageRIO st) p
rAllocateP SwapchainResources
swapchain t
rps
  }