diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for keid-dearimgui + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +# Keid Engine - DearImGui diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/keid-ui-dearimgui.cabal b/keid-ui-dearimgui.cabal new file mode 100644 --- /dev/null +++ b/keid-ui-dearimgui.cabal @@ -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 diff --git a/src/Render/ImGui.hs b/src/Render/ImGui.hs new file mode 100644 --- /dev/null +++ b/src/Render/ImGui.hs @@ -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)