V2.2.0 (#189)

* Upgrade upstream and prepare 2.2.0
* Update vulkan example

ChangeLog.md

@@ -1,5 +1,13 @@
 # Changelog for dear-imgui
 
+## [2.2.0]
+
+- `imgui` updated to [1.89.9].
+- Update bounds for ghc-9.6.
+- Exposed `DearImGui.Raw.Context`.
+- Added `getCursorPos``.
+- Fix TabItem flags type.
+
 ## [2.1.3]
 
 - Fixed off-by-1 in internal Text wrapper.
@@ -107,7 +115,9 @@ Initial Hackage release based on [1.83].
 [2.1.1]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.1.1
 [2.1.2]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.1.2
 [2.1.3]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.1.3
+[2.2.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.2.0
 
+[1.89.9]: https://github.com/ocornut/imgui/releases/tag/v1.89.9
 [1.87]: https://github.com/ocornut/imgui/releases/tag/v1.87
 [1.86]: https://github.com/ocornut/imgui/releases/tag/v1.86
 [1.85]: https://github.com/ocornut/imgui/releases/tag/v1.85

dear-imgui.cabal

@@ -1,7 +1,7 @@
 cabal-version: 3.0
 
 name: dear-imgui
-version: 2.1.3
+version: 2.2.0
 author: Oliver Charles
 maintainer: ollie@ocharles.org.uk, aenor.realm@gmail.com
 license: BSD-3-Clause
@@ -370,25 +370,25 @@ executable vulkan
     build-depends:
         dear-imgui
       , bytestring
-          >= 0.10.10.0 && < 0.12
+          >= 0.10.10.0 && < 0.13
       , containers
-         ^>= 0.6.2.1
+          >= 0.6.2.1 && < 0.7
       , logging-effect
-         ^>= 1.3.12
+          >= 1.3.12 && < 1.5
       , resourcet
-         ^>= 1.2.4.2
+          >= 1.2.4.2 && < 1.3
       , sdl2
-         ^>= 2.5.3.0
+          >= 2.5.3.0 && < 2.6
-      , text-short
+      , text
-         ^>= 0.1.3
+          >= 1.2.4 && < 2.1
       , transformers
           >= 0.5.6 && < 0.7
       , unliftio
-          >= 0.2.13 && < 0.2.19
+          >= 0.2.13 && < 0.3
       , unliftio-core
-         ^>= 0.2.0.1
+          >= 0.2.0.1 && < 0.3
       , vector
-         ^>= 0.12.1.2
+         >= 0.12.1.2 && < 0.14
       , vulkan
          >= 3.12
       , vulkan-utils

examples/vulkan/Backend.hs

@@ -44,7 +44,7 @@ import Data.Traversable
 import Data.Word
   ( Word32 )
 import Foreign.C.String
-  ( CString )
+  ( peekCString )
 import Foreign.C.Types
   ( CInt )
 import Foreign.Ptr
@@ -53,8 +53,6 @@ import Foreign.Ptr
 -- bytestring
 import Data.ByteString
   ( ByteString )
-import qualified Data.ByteString.Short as ShortByteString
-  ( packCString )
 
 -- containers
 import qualified Data.Map.Strict as Map
@@ -77,11 +75,13 @@ import qualified SDL
 import qualified SDL.Raw
 import qualified SDL.Video.Vulkan
 
--- text-short
+-- text
-import Data.Text.Short
+import Data.Text
-  ( ShortText )
+  ( Text )
-import qualified Data.Text.Short as ShortText
+import qualified Data.Text as Text
-  ( intercalate, pack, fromShortByteString, toByteString, unpack )
+  ( intercalate, pack, unpack )
+import Data.Text.Encoding
+  ( encodeUtf8 )
 
 -- transformers
 import Control.Monad.IO.Class
@@ -118,7 +118,7 @@ import Attachments
 
 --------------------------------------------------------------------------------
 
-type LogMessage = WithSeverity ShortText
+type LogMessage = WithSeverity Text
 class    ( MonadUnliftIO m, MonadResource m, MonadLog LogMessage m ) => MonadVulkan m
 instance ( MonadUnliftIO m, MonadResource m, MonadLog LogMessage m ) => MonadVulkan m
 
@@ -127,9 +127,9 @@ instance ( MonadUnliftIO m, MonadResource m, MonadLog LogMessage m ) => MonadVul
 
 logHandler :: MonadIO m => LogMessage -> m ()
 logHandler ( WithSeverity sev mess )
-  = liftIO . putStrLn . ShortText.unpack $ showSeverity sev <> " " <> mess
+  = liftIO . putStrLn . Text.unpack $ showSeverity sev <> " " <> mess
 
-showSeverity :: Severity -> ShortText
+showSeverity :: Severity -> Text
 showSeverity Emergency     = "! PANIC !"
 showSeverity Alert         = "! ALERT !"
 showSeverity Critical      = "! CRIT !"
@@ -244,7 +244,7 @@ vulkanInstanceInfo appName = do
 
   case validationLayer of
     Nothing -> logInfo "Validation layer unavailable. Is the Vulkan SDK installed?"
-    Just _  -> logInfo ( "Enabled validation layers " <> ShortText.pack ( show enabledLayers ) )
+    Just _  -> logInfo ( "Enabled validation layers " <> Text.pack ( show enabledLayers ) )
 
   pure createInfo
 
@@ -305,26 +305,23 @@ initialiseWindow ( WindowInfo { height, width, windowName, mouseMode } ) = do
   void ( SDL.setMouseLocationMode mouseMode )
   window           <- logDebug "Creating SDL window"           *> createWindow width height windowName
   neededExtensions <- logDebug "Loading needed extensions"     *> SDL.Video.Vulkan.vkGetInstanceExtensions window
-  extensionNames   <- traverse ( liftIO . peekCString ) neededExtensions
+  extensionNames   <- traverse ( liftIO . fmap fromString . peekCString ) neededExtensions
-  logInfo $ "Needed instance extensions are: " <> ShortText.intercalate ", " extensionNames
+  logInfo $ "Needed instance extensions are: " <> Text.intercalate ", " extensionNames
-  pure ( window, map ShortText.toByteString extensionNames )
+  pure ( window, map encodeUtf8 extensionNames )
-
-peekCString :: CString -> IO ShortText
-peekCString = fmap ( fromMaybe "???" . ShortText.fromShortByteString ) . ShortByteString.packCString
 
 data WindowInfo
   = WindowInfo
   { width      :: CInt
   , height     :: CInt
-  , windowName :: ShortText
+  , windowName :: Text
   , mouseMode  :: SDL.LocationMode
   }
 
-createWindow :: MonadVulkan m => CInt -> CInt -> ShortText -> m SDL.Window
+createWindow :: MonadVulkan m => CInt -> CInt -> Text -> m SDL.Window
 createWindow x y title =
   snd <$> ResourceT.allocate
     ( SDL.createWindow
-              ( fromString ( ShortText.unpack title ) )
+              ( fromString ( Text.unpack title ) )
               SDL.defaultWindow
                 { SDL.windowGraphicsContext = SDL.VulkanContext
                 , SDL.windowInitialSize     = SDL.V2 x y
@@ -404,8 +401,6 @@ createSwapchain physicalDevice device surface surfaceFormat imageUsage imageCoun
 
   surfaceCapabilities <- Vulkan.getPhysicalDeviceSurfaceCapabilitiesKHR physicalDevice ( Vulkan.SurfaceKHR surface )
 
-  ( _, presentModes ) <- Vulkan.getPhysicalDeviceSurfacePresentModesKHR physicalDevice ( Vulkan.SurfaceKHR surface )
-
   let
     presentMode :: Vulkan.PresentModeKHR
     presentMode =