packages feed

keid-ui-dearimgui (empty) → 0.1.0.0

raw patch · 6 files changed

+329/−0 lines, 6 filesdep +GLFW-bdep +VulkanMemoryAllocatordep +basesetup-changed

Dependencies added: GLFW-b, VulkanMemoryAllocator, base, binary, bytestring, cryptohash-md5, dear-imgui, derive-storable, derive-storable-plugin, foldl, geomancy, keid-core, neat-interpolation, resourcet, rio, rio-app, tagged, unliftio, vector, vulkan, vulkan-utils, zstd

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for keid-dearimgui++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright IC Rainbow (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# Keid Engine - DearImGui
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ keid-ui-dearimgui.cabal view
@@ -0,0 +1,113 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           keid-ui-dearimgui+version:        0.1.0.0+synopsis:       DearImGui elements for Keid engine.+category:       Game Engine+author:         IC Rainbow+maintainer:     keid@aenor.ru+copyright:      2021 IC Rainbow+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://gitlab.com/keid/engine++library+  exposed-modules:+      Render.ImGui+  other-modules:+      Paths_keid_ui_dearimgui+  hs-source-dirs:+      src+  default-extensions:+      NoImplicitPrelude+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstrainedClassMethods+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveDataTypeable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DuplicateRecordFields+      EmptyCase+      EmptyDataDeriving+      ExistentialQuantification+      ExplicitForAll+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      HexFloatLiterals+      ImportQualifiedPost+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      NamedFieldPuns+      NamedWildCards+      NumDecimals+      NumericUnderscores+      OverloadedStrings+      PatternSynonyms+      PostfixOperators+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      ScopedTypeVariables+      StandaloneDeriving+      StandaloneKindSignatures+      StrictData+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeOperators+      TypeSynonymInstances+      UnicodeSyntax+      ViewPatterns+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints+  build-depends:+      GLFW-b+    , VulkanMemoryAllocator+    , base >=4.7 && <5+    , binary+    , bytestring+    , cryptohash-md5+    , dear-imgui+    , derive-storable+    , derive-storable-plugin+    , foldl+    , geomancy+    , keid-core+    , neat-interpolation+    , resourcet+    , rio >=0.1.12.0+    , rio-app+    , tagged+    , unliftio+    , vector+    , vulkan+    , vulkan-utils+    , zstd+  default-language: Haskell2010
+ src/Render/ImGui.hs view
@@ -0,0 +1,180 @@+module Render.ImGui+  ( allocate+  -- , allocateWithFonts+  , allocateWith++  , beforeLoop+  , afterLoop++  , capturingKeyboard+  , capturingMouse++  , mkDrawData+  , draw+  ) where++import RIO++import Control.Monad.Trans.Resource (ReleaseKey, ResourceT, register, release)+import DearImGui.Vulkan (InitInfo(..))+import DearImGui.Vulkan qualified as ImGui+import DearImGui qualified as ImGui+import DearImGui.GLFW (glfwNewFrame, glfwShutdown)+import DearImGui.GLFW.Vulkan (glfwInitForVulkan)+import RIO.App (appEnv)+import Vulkan.Core10 qualified as Vk+import Vulkan.Exception (VulkanException(..))+import Vulkan.Utils.QueueAssignment (QueueFamilyIndex(..))++import Engine.Types (GlobalHandles(..), StageRIO)+import Engine.Vulkan.Types (HasRenderPass(..), HasSwapchain(..), Queues(..), getMultisample)+import Resource.CommandBuffer qualified as CommandBuffer+import Resource.DescriptorSet qualified as DescriptorSet++allocate+  :: ( HasSwapchain swapchain+     , HasRenderPass renderpass+     )+  => swapchain+  -> renderpass+  -> Word32+  -> ResourceT (StageRIO st) ReleaseKey+allocate swapchain renderpass subpassIx =+  fmap fst $+    allocateWith swapchain renderpass subpassIx $+      pure ()++-- allocateWithFonts+--   :: ( HasSwapchain swapchain+--      , HasRenderPass renderpass+--      , Traversable t+--      )+--   => swapchain+--   -> renderpass+--   -> Word32+--   -> t (FilePath, Float)+--   -> ResourceT (StageRIO st) (ReleaseKey, t (Maybe ImGui.Font))+-- allocateWithFonts swapchain renderpass subpassIx fonts =+--   allocateWith swapchain renderpass subpassIx do+--     loaded <- for fonts \(path, size) ->+--       ImGui.addFontFromFileTTF path size+--     ImGui.buildFontAtlas+--     _atlasKey <- register ImGui.clearFontAtlas+--     pure loaded++allocateWith+  :: ( HasSwapchain swapchain+     , HasRenderPass renderpass+     )+  => swapchain+  -> renderpass+  -> Word32+  -> ResourceT (StageRIO st) a+  -> ResourceT (StageRIO st) (ReleaseKey, a)+allocateWith swapchain renderpass subpassIx action = do+  logDebug "Initializing DearImGui"+  debugReleaseFinished <- toIO (logDebug "Released DearImGui")+  void $! register debugReleaseFinished++  ctx <- ImGui.createContext+  _ctxKey <- register $ ImGui.destroyContext ctx++  context@GlobalHandles{..} <- asks appEnv++  let (QueueFamilyIndex queueFamily, queue) = qGraphics ghQueues++  (_poolKey, pool) <- DescriptorSet.allocatePool 1 dsSizes++  let+    initInfo = InitInfo+      { instance'      = ghInstance+      , physicalDevice = ghPhysicalDevice+      , device         = ghDevice+      , queueFamily    = queueFamily+      , queue          = queue++      , minImageCount  = getMinImageCount swapchain+      , imageCount     = getImageCount swapchain+      , msaaSamples    = getMultisample swapchain++      , subpass        = subpassIx+      , pipelineCache  = Vk.NULL_HANDLE++      , descriptorPool = pool++      , mbAllocator    = Nothing+      , checkResult    = \case { Vk.SUCCESS -> pure (); e -> throwM $ VulkanException e }+      }++  res@(_cb, initOk) <- ImGui.vulkanInit initInfo (getRenderPass renderpass)+  unless initOk do+    logError "DearImGui vulkan initialization failed"+    exitFailure+  key <- register $ ImGui.vulkanShutdown res++  actionRes <- action++  -- TODO: oneshots+  (oneshotPoolKey, oneshotPool) <- CommandBuffer.allocatePools context+  CommandBuffer.oneshot_ context oneshotPool qGraphics \cb -> do+    fontsOk <- ImGui.vulkanCreateFontsTexture cb+    unless fontsOk do+      logError "ImGui.vulkanCreateFontsTexture failed"+      exitFailure+  release oneshotPoolKey+  ImGui.vulkanDestroyFontUploadObjects++  debugReleaseStart <- toIO (logDebug "Releasing DearImGui")+  void $! register debugReleaseStart++  pure (key, actionRes)++dsSizes :: DescriptorSet.TypeMap Word32+dsSizes = map (, 100)+  [ Vk.DESCRIPTOR_TYPE_SAMPLER+  , Vk.DESCRIPTOR_TYPE_COMBINED_IMAGE_SAMPLER+  , Vk.DESCRIPTOR_TYPE_SAMPLED_IMAGE+  , Vk.DESCRIPTOR_TYPE_STORAGE_IMAGE+  , Vk.DESCRIPTOR_TYPE_UNIFORM_TEXEL_BUFFER+  , Vk.DESCRIPTOR_TYPE_STORAGE_TEXEL_BUFFER+  , Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER+  , Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER+  , Vk.DESCRIPTOR_TYPE_UNIFORM_BUFFER_DYNAMIC+  , Vk.DESCRIPTOR_TYPE_STORAGE_BUFFER_DYNAMIC+  , Vk.DESCRIPTOR_TYPE_INPUT_ATTACHMENT+  ]++beforeLoop :: Bool -> StageRIO st ()+beforeLoop installCallbacks = do+  logDebug "Setting up ImGui"+  window <- asks $ ghWindow . appEnv+  success <- glfwInitForVulkan window installCallbacks+  unless success do+    logWarn "glfwInitForVulkan failed"++afterLoop :: StageRIO st ()+afterLoop = do+  logDebug "Shutting down ImGui"+  glfwShutdown++mkDrawData :: MonadIO m => m a -> m (a, ImGui.DrawData)+mkDrawData action = do+  ImGui.vulkanNewFrame+  glfwNewFrame+  ImGui.newFrame+  result <- action+  ImGui.render+  drawData <- ImGui.getDrawData+  pure (result, drawData)++draw :: MonadIO m => ImGui.DrawData -> Vk.CommandBuffer -> m ()+draw drawData commandBuffer = do+  ImGui.vulkanRenderDrawData drawData commandBuffer Nothing++capturingKeyboard :: MonadIO m => m () -> m ()+capturingKeyboard action =+  ImGui.wantCaptureKeyboard >>= (`unless` action)++capturingMouse :: MonadIO m => m () -> m ()+capturingMouse action =+  ImGui.wantCaptureMouse >>= (`unless` action)