Bump to 1.91.9b

ChangeLog.md

@@ -1,5 +1,13 @@
 # Changelog for dear-imgui
 
+## [2.4.0]
+
+- `imgui` updated to [1.91.9b].
+    * Breaking: `ImTextureID` switched to a Word64 as a base type (was: pointer).
+      + Remove your *ToPtr casts and just use ImTextureID type (a Word64 alias).
+    * Breaking: `setGlyphExtraSpacing` renamed to `setGlyphExtraAdvanceX`.
+    * Breaking: Some flags got updated, consult the [changelog](https://github.com/ocornut/imgui/blob/v1.91.9b/docs/CHANGELOG.txt) for migration hints.
+
 ## [2.3.1]
 
 - Extended DragDrop API.
@@ -147,7 +155,9 @@ Initial Hackage release based on [1.83].
 [2.2.1]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.2.1
 [2.3.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.3.0
 [2.3.1]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.3.1
+[2.4.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v2.4.0
 
+[1.91.9b]: https://github.com/ocornut/imgui/releases/tag/v1.91.9b
 [1.90.9]: https://github.com/ocornut/imgui/releases/tag/v1.90.9
 [1.89.9]: https://github.com/ocornut/imgui/releases/tag/v1.89.9
 [1.87]: https://github.com/ocornut/imgui/releases/tag/v1.87

dear-imgui.cabal

@@ -1,7 +1,7 @@
 cabal-version: 3.0
 
 name: dear-imgui
-version: 2.3.1
+version: 2.4.0
 author: Oliver Charles
 maintainer: [email protected], [email protected]
 license: BSD-3-Clause

examples/sdl/Image.hs

@@ -139,7 +139,7 @@ mainLoop window textures flag = unlessQuit do
   let texture = if flag then fst textures else snd textures
   -- Drawing images require some backend-specific code.
   -- Meanwhile, we have to deal with raw bindings.
-  let openGLtextureID = intPtrToPtr $ fromIntegral $ textureID texture
+  let openGLtextureID = fromIntegral $ textureID texture
 
   -- Build the GUI
   clicked <- withWindow "Image example" \open ->

examples/vulkan/Main.hs

@@ -81,7 +81,7 @@ import qualified DearImGui.Vulkan     as ImGui.Vulkan
 import qualified DearImGui.SDL        as ImGui.SDL
 import qualified DearImGui.SDL.Vulkan as ImGui.SDL.Vulkan
 import Util (vmaVulkanFunctions)
-import Foreign (Ptr, castPtr, copyBytes, with, withForeignPtr, wordPtrToPtr, nullPtr)
+import Foreign (castPtr, copyBytes, with, withForeignPtr)
 import Foreign.C.String (withCString)
 import qualified DearImGui.Raw as ImGui.Raw
 import UnliftIO (MonadUnliftIO)
@@ -95,7 +95,7 @@ type Handler    = LogMessage -> ResourceT IO ()
 deriving via ( ReaderT Handler (ResourceT IO) )
   instance MonadResource ( LoggingT LogMessage (ResourceT IO) )
 
-gui :: MonadUnliftIO m => (ImGui.Raw.ImVec2, Ptr ()) ->  m ImGui.DrawData
+gui :: MonadUnliftIO m => (ImGui.Raw.ImVec2, ImGui.Raw.ImTextureID) ->  m ImGui.DrawData
 gui texture = do
   -- Prepare frame
   ImGui.Vulkan.vulkanNewFrame
@@ -505,7 +505,7 @@ app = do
     logDebug "Adding imgui texture"
     Vulkan.DescriptorSet ds <- ImGui.Vulkan.vulkanAddTexture sampler imageView Vulkan.IMAGE_LAYOUT_SHADER_READ_ONLY_OPTIMAL
     let textureSize = ImGui.Raw.ImVec2 (fromIntegral textureWidth) (fromIntegral textureHeight)
-    let texture = (textureSize, wordPtrToPtr $ fromIntegral ds)
+    let texture = (textureSize, fromIntegral ds)
 
     let
       mainLoop :: AppState m -> m ()

generator/DearImGui/Generator/Parser.hs

@@ -120,9 +120,11 @@ headers :: MonadParsec CustomParseError [Tok] m => m ( Headers () )
 headers = do
   _ <- skipManyTill anySingle ( namedSection "Header mess" )
 
-  _ <- skipManyTill anySingle ( namedSection "Forward declarations" )
+  _ <- skipManyTill anySingle ( namedSection "Forward declarations and basic types" )
   ( _structNames, enumNamesAndTypes ) <- forwardDeclarations
 
+  _ <- skipManyTill anySingle ( namedSection "Texture identifier (ImTextureID)" )
+
   _ <- skipManyTill anySingle ( namedSection "Dear ImGui end-user API functions" )
 
   _ <- skipManyTill anySingle ( namedSection "Flags & Enumerations" )
@@ -191,7 +193,16 @@ forwardDeclarations = do
     doc <- comment
     pure (typeName, (signed, width, doc))
   _ <- many comment
-  structs <- many do
+  structs1 <- many do
+    -- // Forward declarations: ImDrawList, ImFontAtlas layer
+    keyword "struct"
+    structName <- identifier
+    reservedSymbol ';'
+    doc <- comment
+    pure ( structName, doc )
+  _ <- many comment
+  structs2 <- many do
+    -- // Forward declarations: ImGui layer
     keyword "struct"
     structName <- identifier
     reservedSymbol ';'
@@ -219,14 +230,15 @@ forwardDeclarations = do
     _ <- many comment
     pure ( enumName, ( ty, CommentText <$> Text.drop 2 . snd $ Text.breakOn "//" doc ) )
   -- Stopping after simple structs and enums for now.
-  pure ( HashMap.fromList structs, HashMap.fromList (enums <> typedefs) )
+  pure ( HashMap.fromList (structs1 <> structs2), HashMap.fromList (enums <> typedefs) )
 
 cTypeName :: MonadParsec e [Tok] m => m TH.Name
 cTypeName =
   choice
     [ try $ (keyword "char") $> ''CChar
     , try $ (keyword "signed" >> keyword "int") $> ''CInt
     , try $ (keyword "unsigned" >> keyword "int") $> ''CUInt
+    , try $ (keyword "unsigned" >> keyword "short") $> ''CUShort
     , try $ (keyword "unsigned" >> keyword "char") $> ''CUChar
     , try $ (identifier' "ImS8") $> ''CChar
     , try $ (identifier' "ImU8") $> ''CUChar
@@ -236,6 +248,7 @@ cTypeName =
     , try $ (identifier' "ImU32") $> ''CUInt
     , try $ (identifier' "ImS64") $> ''CLLong
     , try $ (identifier' "ImU64") $> ''CULLong
+    , try $ (identifier' "ImTextureID") $> ''CULLong
     , keyword "int" $> ''CInt
     ]
   <?> "cTypeName"

src/DearImGui/FontAtlas.hs

@@ -52,9 +52,9 @@ module DearImGui.FontAtlas
   , oversampleH
   , oversampleV
   , pixelSnapH
-  , glyphExtraSpacing
   , glyphOffset
   , glyphRanges
+  , glyphExtraAdvanceX
   , glyphMinAdvanceX
   , glyphMaxAdvanceX
   , mergeMode
@@ -413,16 +413,6 @@ pixelSnapH value =
   ConfigSetup \fc ->
     FontConfig.setPixelSnapH fc (bool 0 1 value)
 
--- | Extra spacing (in pixels) between glyphs.
---
--- Only X axis is supported for now.
---
--- By default, it is @0, 0@
-glyphExtraSpacing :: (Float, Float) -> ConfigSetup
-glyphExtraSpacing (x, y) =
-  ConfigSetup \fc ->
-    Foreign.with (ImVec2 x y) (FontConfig.setGlyphExtraSpacing fc)
-
 -- | Offset all glyphs from this font input.
 --
 -- By default, it is @0, 0@
@@ -443,6 +433,14 @@ glyphRanges value =
   ConfigSetup \fc ->
     FontConfig.setGlyphRanges fc value
 
+-- | Extra spacing (in pixels) between glyphs.
+--
+-- By default, it is @0@
+glyphExtraAdvanceX :: Float -> ConfigSetup
+glyphExtraAdvanceX x =
+  ConfigSetup \fc ->
+    FontConfig.setGlyphExtraAdvanceX fc (CFloat x)
+
 -- | Minimum AdvanceX for glyphs.
 --
 -- Set Min to align font icons, set both Min/Max to enforce mono-space font.

src/DearImGui/Raw.hs

@@ -803,12 +803,12 @@ arrowButton strIdPtr dir = liftIO do
 -- See @examples/sdl/Image.hs@ for the whole process.
 --
 -- Wraps @ImGui::Image()@.
-image :: (MonadIO m) => Ptr () -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec4 -> Ptr ImVec4 -> m ()
-image userTextureIDPtr sizePtr uv0Ptr uv1Ptr tintColPtr borderColPtr = liftIO do
+image :: (MonadIO m) => ImTextureID -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec4 -> Ptr ImVec4 -> m ()
+image userTextureID sizePtr uv0Ptr uv1Ptr tintColPtr borderColPtr = liftIO do
   [C.exp|
     void {
       Image(
-        $(void* userTextureIDPtr),
+        $(ImTextureID userTextureID),
         *$(ImVec2* sizePtr),
         *$(ImVec2* uv0Ptr),
         *$(ImVec2* uv1Ptr),
@@ -823,13 +823,13 @@ image userTextureIDPtr sizePtr uv0Ptr uv1Ptr tintColPtr borderColPtr = liftIO do
 -- Negative @frame_padding@ uses default frame padding settings. Set to 0 for no padding.
 --
 -- Wraps @ImGui::ImageButton()@.
-imageButton :: (MonadIO m) => CString -> Ptr () -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec4 -> Ptr ImVec4 -> m Bool
-imageButton labelPtr userTextureIDPtr sizePtr uv0Ptr uv1Ptr bgColPtr tintColPtr = liftIO do
+imageButton :: (MonadIO m) => CString -> ImTextureID -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec4 -> Ptr ImVec4 -> m Bool
+imageButton labelPtr userTextureID sizePtr uv0Ptr uv1Ptr bgColPtr tintColPtr = liftIO do
   (0 /=) <$> [C.exp|
     bool {
       ImageButton(
         $(char* labelPtr),
-        $(void* userTextureIDPtr),
+        $(ImTextureID userTextureID),
         *$(ImVec2* sizePtr),
         *$(ImVec2* uv0Ptr),
         *$(ImVec2* uv1Ptr),

src/DearImGui/Raw/Context.hs

@@ -30,20 +30,22 @@ imguiContext :: Context
 imguiContext = mempty
   { ctxTypesTable = enumerationsTypesTable <>
     Map.fromList
-      [ ( TypeName "ImVec2", [t| ImVec2 |] )
-      , ( TypeName "ImVec3", [t| ImVec3 |] )
-      , ( TypeName "ImVec4", [t| ImVec4 |] )
-      , ( TypeName "ImU32", [t| ImU32 |] )
-      , ( TypeName "ImGuiID", [t| ImGuiID |] )
-      , ( TypeName "ImWchar", [t| ImWchar |] )
-      , ( TypeName "ImDrawList", [t| ImDrawList |] )
-      , ( TypeName "ImGuiContext", [t| ImGuiContext |] )
+      [ ( TypeName "ImDrawList", [t| ImDrawList |] )
       , ( TypeName "ImFont", [t| ImFont |] )
       , ( TypeName "ImFontConfig", [t| ImFontConfig |] )
       , ( TypeName "ImFontGlyphRangesBuilder", [t| ImFontGlyphRangesBuilder |] )
+      , ( TypeName "ImGuiContext", [t| ImGuiContext |] )
+      , ( TypeName "ImGuiID", [t| ImGuiID |] )
+      , ( TypeName "ImGuiKeyChord", [t| Int |] )
       , ( TypeName "ImGuiListClipper", [t| ImGuiListClipper |] )
-      , ( TypeName "ImGuiTableSortSpecs", [t| ImGuiTableSortSpecs |] )
       , ( TypeName "ImGuiPayload", [t| ImGuiPayload |] )
-      , ( TypeName "ImGuiKeyChord", [t| Int |] )
+      , ( TypeName "ImGuiTableSortSpecs", [t| ImGuiTableSortSpecs |] )
+      , ( TypeName "ImTextureID", [t| ImTextureID |] )
+      , ( TypeName "ImU32", [t| ImU32 |] )
+      , ( TypeName "ImU64", [t| ImU64 |] )
+      , ( TypeName "ImVec2", [t| ImVec2 |] )
+      , ( TypeName "ImVec3", [t| ImVec3 |] )
+      , ( TypeName "ImVec4", [t| ImVec4 |] )
+      , ( TypeName "ImWchar", [t| ImWchar |] )
       ]
   }

src/DearImGui/Raw/DrawList.hs

@@ -199,12 +199,12 @@ getClipRectMax (DrawList drawList) = liftIO do
     |]
 
 
-pushTextureID :: MonadIO m => DrawList -> Ptr () -> m ()
-pushTextureID (DrawList drawList) userTextureIDPtr = liftIO do
+pushTextureID :: MonadIO m => DrawList -> ImTextureID -> m ()
+pushTextureID (DrawList drawList) userTextureID = liftIO do
   [C.block|
     void {
       $(ImDrawList* drawList)->PushTextureID(
-        $(void* userTextureIDPtr)
+        $(ImTextureID userTextureID)
       );
     }
   |]
@@ -513,16 +513,16 @@ addBezierQuadratic (DrawList drawList) p1 p2 p3 col thickness numSegments = lift
 addImage
   :: MonadIO m
   => DrawList
-  -> Ptr ()
+  -> ImTextureID
   -> Ptr ImVec2 -> Ptr ImVec2 -- Positions
   -> Ptr ImVec2 -> Ptr ImVec2 -- UVs
   -> ImU32
   -> m ()
-addImage (DrawList drawList) userTextureIDPtr p_min p_max uv_min uv_max col = liftIO do
+addImage (DrawList drawList) userTextureID p_min p_max uv_min uv_max col = liftIO do
   [C.block|
     void {
       $(ImDrawList* drawList)->AddImage(
-        $(void* userTextureIDPtr),
+        $(ImTextureID userTextureID),
         *$(ImVec2* p_min),
         *$(ImVec2* p_max),
         *$(ImVec2* uv_min),
@@ -535,16 +535,16 @@ addImage (DrawList drawList) userTextureIDPtr p_min p_max uv_min uv_max col = li
 addImageQuad
   :: MonadIO m
   => DrawList
-  -> Ptr ()
+  -> ImTextureID
   -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -- Positions
   -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -- UVs
   -> ImU32
   -> m ()
-addImageQuad (DrawList drawList) userTextureIDPtr p1 p2 p3 p4 uv1 uv2 uv3 uv4 col = liftIO do
+addImageQuad (DrawList drawList) userTextureID p1 p2 p3 p4 uv1 uv2 uv3 uv4 col = liftIO do
   [C.block|
     void {
       $(ImDrawList* drawList)->AddImageQuad(
-        $(void* userTextureIDPtr),
+        $(ImTextureID userTextureID),
         *$(ImVec2* p1),
         *$(ImVec2* p2),
         *$(ImVec2* p3),
@@ -561,18 +561,18 @@ addImageQuad (DrawList drawList) userTextureIDPtr p1 p2 p3 p4 uv1 uv2 uv3 uv4 co
 addImageRounded
   :: MonadIO m
   => DrawList
-  -> Ptr ()
+  -> ImTextureID
   -> Ptr ImVec2 -> Ptr ImVec2 -- Positions
   -> Ptr ImVec2 -> Ptr ImVec2 -- UVs
   -> ImU32
   -> CFloat
   -> ImDrawFlags
   -> m ()
-addImageRounded (DrawList drawList) userTextureIDPtr p_min p_max uv_min uv_max col rounding flags = liftIO do
+addImageRounded (DrawList drawList) userTextureID p_min p_max uv_min uv_max col rounding flags = liftIO do
   [C.block|
     void {
       $(ImDrawList* drawList)->AddImageRounded(
-        $(void* userTextureIDPtr),
+        $(ImTextureID userTextureID),
         *$(ImVec2* p_min),
         *$(ImVec2* p_max),
         *$(ImVec2* uv_min),

src/DearImGui/Raw/Font/Config.hs

@@ -27,7 +27,7 @@ module DearImGui.Raw.Font.Config
   , setOversampleH
   , setOversampleV
   , setPixelSnapH
-  , setGlyphExtraSpacing
+  , setGlyphExtraAdvanceX
   , setGlyphOffset
   , setGlyphRanges
   , setGlyphMinAdvanceX
@@ -154,14 +154,14 @@ setPixelSnapH (FontConfig fc) value = liftIO do
     }
   |]
 
--- | Extra spacing (in pixels) between glyphs. Only X axis is supported for now.
+-- | Extra spacing (in pixels) between glyphs.
 --
--- By default, it is @0, 0@
-setGlyphExtraSpacing :: MonadIO m => FontConfig -> Ptr ImVec2 -> m ()
-setGlyphExtraSpacing (FontConfig fc) value = liftIO do
+-- By default, it is @0@
+setGlyphExtraAdvanceX :: MonadIO m => FontConfig -> CFloat -> m ()
+setGlyphExtraAdvanceX (FontConfig fc) value = liftIO do
   [C.block|
     void {
-      $(ImFontConfig* fc)->GlyphExtraSpacing = *$(ImVec2* value);
+      $(ImFontConfig* fc)->GlyphExtraAdvanceX = $(float value);
     }
   |]
 

src/DearImGui/Structs.hs

@@ -8,6 +8,7 @@ module DearImGui.Structs where
 -- base
 import Data.Word
   ( Word32
+  , Word64
 #ifndef IMGUI_USE_WCHAR32
   , Word16
 #endif
@@ -114,6 +115,10 @@ type ImGuiID = ImU32
 -- | 32-bit unsigned integer (often used to store packed colors).
 type ImU32 = Word32
 
+type ImU64 = Word64
+
+type ImTextureID = ImU64
+
 type ImS16 = Int16
 
 -- | Single wide character (used mostly in glyph management)