packages feed

dear-imgui 1.1.0 → 1.2.0

raw patch · 10 files changed

+684/−57 lines, 10 filesdep ~parser-combinatorsdep ~sdl2dep ~vectornew-component:exe:imagePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: parser-combinators, sdl2, vector

API changes (from Hackage documentation)

+ DearImGui: addFontDefault :: MonadIO m => m Font
+ DearImGui: addFontFromFileTTF :: MonadIO m => FilePath -> Float -> m (Maybe Font)
+ DearImGui: buildFontAtlas :: MonadIO m => m ()
+ DearImGui: clearFontAtlas :: MonadIO m => m ()
+ DearImGui: data Font
+ DearImGui: data ImFont
+ DearImGui: data ImGuiContext
+ DearImGui: getCurrentContext :: MonadIO m => m Context
+ DearImGui: getWindowHeight :: MonadIO m => m CFloat
+ DearImGui: getWindowPos :: MonadIO m => m ImVec2
+ DearImGui: getWindowSize :: MonadIO m => m ImVec2
+ DearImGui: getWindowWidth :: MonadIO m => m CFloat
+ DearImGui: image :: MonadIO m => Ptr () -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec4 -> Ptr ImVec4 -> m ()
+ DearImGui: inputTextMultiline :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> ref -> Int -> ImVec2 -> m Bool
+ DearImGui: inputTextWithHint :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> String -> ref -> Int -> m Bool
+ DearImGui: invisibleButton :: MonadIO m => String -> ImVec2 -> ImGuiButtonFlags -> m Bool
+ DearImGui: setCurrentContext :: MonadIO m => Context -> m ()
+ DearImGui: withChildContext :: MonadUnliftIO m => String -> (Bool -> m a) -> m a
+ DearImGui.Raw: Font :: Ptr ImFont -> Font
+ DearImGui.Raw: addFontDefault :: MonadIO m => m Font
+ DearImGui.Raw: addFontFromFileTTF :: MonadIO m => CString -> CFloat -> m Font
+ DearImGui.Raw: addFontFromMemoryTTF :: MonadIO m => CStringLen -> CFloat -> m Font
+ DearImGui.Raw: beginChildContext :: MonadIO m => CString -> m Bool
+ DearImGui.Raw: buildFontAtlas :: MonadIO m => m ()
+ DearImGui.Raw: clearFontAtlas :: MonadIO m => m ()
+ DearImGui.Raw: data ImFont
+ DearImGui.Raw: data ImGuiContext
+ DearImGui.Raw: getCurrentContext :: MonadIO m => m Context
+ DearImGui.Raw: getWindowHeight :: MonadIO m => m CFloat
+ DearImGui.Raw: getWindowPos :: MonadIO m => m ImVec2
+ DearImGui.Raw: getWindowSize :: MonadIO m => m ImVec2
+ DearImGui.Raw: getWindowWidth :: MonadIO m => m CFloat
+ DearImGui.Raw: image :: MonadIO m => Ptr () -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec4 -> Ptr ImVec4 -> m ()
+ DearImGui.Raw: imageButton :: MonadIO m => Ptr () -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> CInt -> Ptr ImVec4 -> Ptr ImVec4 -> m Bool
+ DearImGui.Raw: inputTextMultiline :: MonadIO m => CString -> CStringLen -> Ptr ImVec2 -> ImGuiInputTextFlags -> m Bool
+ DearImGui.Raw: inputTextWithHint :: MonadIO m => CString -> CString -> CStringLen -> ImGuiInputTextFlags -> m Bool
+ DearImGui.Raw: invisibleButton :: MonadIO m => CString -> Ptr ImVec2 -> ImGuiButtonFlags -> m Bool
+ DearImGui.Raw: newtype Font
+ DearImGui.Raw: setCurrentContext :: MonadIO m => Context -> m ()
- DearImGui: Context :: Ptr () -> Context
+ DearImGui: Context :: Ptr ImGuiContext -> Context
- DearImGui: beginChild :: MonadIO m => String -> m Bool
+ DearImGui: beginChild :: MonadIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> m Bool
- DearImGui: withChild :: MonadUnliftIO m => String -> (Bool -> m a) -> m a
+ DearImGui: withChild :: MonadUnliftIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> (Bool -> m a) -> m a
- DearImGui: withChildOpen :: MonadUnliftIO m => String -> m () -> m ()
+ DearImGui: withChildOpen :: MonadUnliftIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> m () -> m ()
- DearImGui.Raw: Context :: Ptr () -> Context
+ DearImGui.Raw: Context :: Ptr ImGuiContext -> Context
- DearImGui.Raw: begin :: MonadIO m => CString -> Ptr CBool -> ImGuiWindowFlags -> m Bool
+ DearImGui.Raw: begin :: MonadIO m => CString -> Maybe (Ptr CBool) -> Maybe ImGuiWindowFlags -> m Bool
- DearImGui.Raw: beginChild :: MonadIO m => CString -> m Bool
+ DearImGui.Raw: beginChild :: MonadIO m => CString -> Ptr ImVec2 -> CBool -> ImGuiWindowFlags -> m Bool
- DearImGui.Raw: inputText :: MonadIO m => CString -> CString -> CInt -> m Bool
+ DearImGui.Raw: inputText :: MonadIO m => CString -> CStringLen -> ImGuiInputTextFlags -> m Bool
- DearImGui.Raw: setNextWindowPos :: MonadIO m => Ptr ImVec2 -> ImGuiCond -> Ptr ImVec2 -> m ()
+ DearImGui.Raw: setNextWindowPos :: MonadIO m => Ptr ImVec2 -> ImGuiCond -> Maybe (Ptr ImVec2) -> m ()
- DearImGui.Raw: textUnformatted :: MonadIO m => CString -> CString -> m ()
+ DearImGui.Raw: textUnformatted :: MonadIO m => CString -> Maybe CString -> m ()

Files

ChangeLog.md view
@@ -1,5 +1,17 @@ # Changelog for dear-imgui +## [1.2.0]++- Fixed `nullPtr` in place of default arguments.+- Added functions for getting window position and size.+- Added `invisibleButton`.+- Added `inputTextMultiline` and `inputTextWithHint`.+- Changed `beginChild` and related `withChild*` to use full arguments.+- Added `withChildContext` to run actions inside other child window.+- Added `getCurrentContext`, `setCurrentContext`.+- Added `image` and `imageButton`.+- Added font atlas utilities.+ ## [1.1.0]  - `imgui` updated to 1.84.2.@@ -22,3 +34,5 @@ [1.0.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.0.0 [1.0.1]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.0.1 [1.0.2]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.0.2+[1.1.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.1.0+[1.2.0]: https://github.com/haskell-game/dear-imgui.hs/tree/v1.2.0
Main.hs view
@@ -38,9 +38,7 @@       tab2 <- newIORef True       loop w checked color slider r pos size' selected tab1 tab2 -      openGL3Shutdown - loop   :: Window   -> IORef Bool@@ -122,7 +120,7 @@    progressBar 0.314 (Just "Pi") -  beginChild "Child"+  beginChild "Child" (ImVec2 0 0) True ImGuiWindowFlags_None    beginCombo "Label" "Preview" >>= whenTrue do     selectable "Testing 1"
dear-imgui.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0  name: dear-imgui-version: 1.1.0+version: 1.2.0 author: Oliver Charles maintainer: ollie@ocharles.org.uk, aenor.realm@gmail.com license: BSD-3-Clause@@ -220,7 +220,7 @@     , megaparsec         >= 9.0 && < 9.1     , parser-combinators-        >= 1.2.0 && < 1.3+        >= 1.2.0 && < 1.4     , scientific         >= 0.3.6.2 && < 0.3.8     , text@@ -257,6 +257,14 @@   main-is: Readme.hs   hs-source-dirs: examples   build-depends: sdl2, gl, dear-imgui, managed+  if (!flag(examples) || !flag(sdl) || !flag(opengl2))+    buildable: False++executable image+  import: common+  main-is: Image.hs+  hs-source-dirs: examples/sdl+  build-depends: sdl2, gl, dear-imgui, managed, vector   if (!flag(examples) || !flag(sdl) || !flag(opengl2))     buildable: False 
+ examples/sdl/Image.hs view
@@ -0,0 +1,181 @@+{-# language BlockArguments #-}+{-# language LambdaCase #-}+{-# language OverloadedStrings #-}++{- | Drawing an DearImGui image using OpenGL textures.++https://github.com/ocornut/imgui/wiki/Image-Loading-and-Displaying-Examples+-}++module Main ( main ) where++import Control.Exception+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Managed (managed, managed_, runManaged)+import DearImGui+import qualified DearImGui.Raw as Raw+import DearImGui.OpenGL3+import DearImGui.SDL+import DearImGui.SDL.OpenGL+import Graphics.GL+import qualified SDL as SDL++--  For the texture creation+import Foreign+import qualified Data.Vector.Storable as VS++data Texture = Texture+  { textureID     :: GLuint+  , textureWidth  :: GLsizei+  , textureHeight :: GLsizei+  }+  deriving (Show)++textureSize :: Texture -> ImVec2+textureSize texture =+  ImVec2+    (fromIntegral $ textureWidth texture)+    (fromIntegral $ textureHeight texture)++-- | Create a texture pointer in GL memory.+create2DTexture :: Int -> Int -> IO Texture+create2DTexture width height =+  alloca \ptr -> do+    glGenTextures 1 ptr+    tID <- peek ptr+    return Texture+      { textureID     = tID+      , textureWidth  = fromIntegral width+      , textureHeight = fromIntegral height+      }++bindTexture :: Texture -> Ptr GLubyte -> IO ()+bindTexture texture dataPtr = do+  glEnable GL_TEXTURE_2D+  glBindTexture GL_TEXTURE_2D (textureID texture)++  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_REPEAT+  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_REPEAT++  glTexImage2D+    GL_TEXTURE_2D+    0+    GL_RGB+    (textureWidth texture)+    (textureHeight texture)+    0+    GL_RGB+    GL_UNSIGNED_BYTE+    (castPtr dataPtr)++fill :: Texture -> (GLubyte, GLubyte, GLubyte) -> VS.Vector GLubyte+fill texture (r, g, b) =+  VS.generate+    (3 * width * height)+    (\i ->+        case i `mod` 3 of+          0 -> r+          1 -> g+          2 -> b+          _ -> error "assert: 3-byte pitch"+    )+  where+    width  = fromIntegral (textureWidth texture)+    height = fromIntegral (textureHeight texture)+++main :: IO ()+main = do+  -- Initialize SDL+  SDL.initializeAll++  runManaged do+    -- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too.+    window <- do+      let title = "Hello, Dear ImGui!"+      let config = SDL.defaultWindow { SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL, SDL.windowResizable = True }+      managed $ bracket (SDL.createWindow title config) SDL.destroyWindow++    -- Create an OpenGL context+    glContext <- managed $ bracket (SDL.glCreateContext window) SDL.glDeleteContext++    -- Create an ImGui context+    _dearContext <- managed $ bracket createContext destroyContext++    -- Initialize ImGui's SDL2 backend+    managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown++    -- Initialize ImGui's OpenGL backend+    managed_ $ bracket_ openGL3Init do+      putStrLn "ImguiOpenGL shut down"+      openGL3Shutdown++    liftIO do+      blueish <- create2DTexture 320 240+      VS.unsafeWith (fill blueish (0x00, 0x7F, 0xFF)) $+        bindTexture blueish++      pinkish <- create2DTexture 240 320+      VS.unsafeWith (fill pinkish (0xFF, 0x00, 0x7F)) $+        bindTexture pinkish++      err <- glGetError+      putStrLn $ "Error-code: " ++ show err++      print (blueish, pinkish)+      mainLoop window (blueish, pinkish) False++mainLoop :: SDL.Window -> (Texture, Texture) -> Bool -> IO ()+mainLoop window textures flag = unlessQuit do+  -- Tell ImGui we're starting a new frame+  openGL3NewFrame+  sdl2NewFrame+  newFrame++  -- Build the GUI+  clicked <- withWindow "Image example" \open ->+    if open then do+      text "That's an image, click it"+      newLine++      let texture = if flag then fst textures else snd textures++      -- Drawing images require some backend-specific code.+      -- Meanwhile, we have to deal with raw binding.+      let openGLtextureID = intPtrToPtr $ fromIntegral $ textureID texture++      Foreign.with (textureSize texture) \sizePtr ->+        Foreign.with (ImVec2 0 0) \uv0Ptr ->+          Foreign.with (ImVec2 1 1) \uv1Ptr ->+            Foreign.with (ImVec4 1 1 1 1) \tintColPtr ->+              Foreign.with (ImVec4 1 1 1 1) \bgColPtr ->+                Raw.imageButton openGLtextureID sizePtr uv0Ptr uv1Ptr (-1) bgColPtr tintColPtr+    else+      pure False++  -- Render+  glClear GL_COLOR_BUFFER_BIT++  DearImGui.render+  DearImGui.getDrawData >>= openGL3RenderDrawData++  SDL.glSwapWindow window++  mainLoop window textures (flag /= clicked)++  where+    unlessQuit action = do+      shouldQuit <- checkEvents+      if shouldQuit then pure () else action++    checkEvents = do+      pollEventWithImGui >>= \case+        Nothing ->+          return False+        Just event ->+          (isQuit event ||) <$> checkEvents++    isQuit event =+      SDL.eventPayload event == SDL.QuitEvent
examples/vulkan/Main.hs view
@@ -83,6 +83,20 @@ deriving via ( ReaderT Handler (ResourceT IO) )   instance MonadResource ( LoggingT LogMessage (ResourceT IO) ) +gui :: MonadIO m => m ImGui.DrawData+gui = do+  -- Prepare frame+  ImGui.Vulkan.vulkanNewFrame+  ImGui.SDL.sdl2NewFrame+  ImGui.newFrame++  -- Run your windows+  ImGui.showDemoWindow++  -- Process ImGui state into draw commands+  ImGui.render+  ImGui.getDrawData+ main :: IO () main = runResourceT . ( `runLoggingT` logHandler ) $ app @( LoggingT LogMessage ( ResourceT IO ) ) @@ -120,6 +134,12 @@     ImGui.createContext     ImGui.destroyContext +  logDebug "Adding fonts"+  ImGui.clearFontAtlas+  _default <- ImGui.addFontDefault+  _custom <- ImGui.addFontFromFileTTF "imgui/misc/fonts/ProggyTiny.ttf" 10+  ImGui.buildFontAtlas+   let     preferredFormat :: Vulkan.SurfaceFormatKHR     preferredFormat =@@ -341,12 +361,6 @@                 pure ( True, False )               else                 handleJust vulkanException ( pure . reloadQuit ) do-                  ImGui.Vulkan.vulkanNewFrame-                  ImGui.SDL.sdl2NewFrame-                  ImGui.newFrame-                  ImGui.showDemoWindow-                  ImGui.render-                  drawData <- ImGui.getDrawData                   let                     commandBuffer :: Vulkan.CommandBuffer                     commandBuffer = commandBuffers Boxed.Vector.! fromIntegral nextImageIndex@@ -355,7 +369,10 @@                   Vulkan.resetCommandBuffer commandBuffer Vulkan.zero                   beginCommandBuffer commandBuffer                   cmdBeginRenderPass commandBuffer imGuiRenderPass framebuffer clearValues swapchainExtent++                  drawData <- gui                   ImGui.Vulkan.vulkanRenderDrawData drawData commandBuffer Nothing+                   cmdEndRenderPass commandBuffer                   endCommandBuffer commandBuffer                   submitCommandBuffer
generator/DearImGui/Generator.hs view
@@ -125,9 +125,9 @@     classes :: [ TH.Q TH.Type ]     classes       | isFlagEnum-      = map TH.conT [ ''Eq, ''Ord, ''Storable, ''Bits ]+      = map TH.conT [ ''Eq, ''Ord, ''Show, ''Storable, ''Bits ]       | otherwise-      = map TH.conT [ ''Eq, ''Ord, ''Storable ]+      = map TH.conT [ ''Eq, ''Ord, ''Show, ''Storable ]     derivClause :: TH.Q TH.DerivClause     derivClause = TH.derivClause ( Just TH.NewtypeStrategy ) classes 
src/DearImGui.hs view
@@ -20,6 +20,8 @@     Raw.Context(..)   , Raw.createContext   , Raw.destroyContext+  , Raw.getCurrentContext+  , Raw.setCurrentContext      -- * Main   , Raw.newFrame@@ -49,6 +51,15 @@    , begin   , Raw.end++    -- ** Utilities++  , Raw.getWindowPos+  , Raw.getWindowSize+  , Raw.getWindowWidth+  , Raw.getWindowHeight++    -- ** Manipulation   , setNextWindowPos   , setNextWindowSize   , Raw.setNextWindowFullscreen@@ -57,9 +68,10 @@   , setNextWindowCollapsed   , setNextWindowBgAlpha -    -- * Child Windows+    -- ** Child Windows   , withChild   , withChildOpen+  , withChildContext   , beginChild   , Raw.endChild @@ -111,7 +123,9 @@     -- ** Main   , button   , smallButton+  , invisibleButton   , arrowButton+  , Raw.image   , checkbox   , progressBar   , Raw.bullet@@ -155,6 +169,8 @@      -- ** Text Input   , inputText+  , inputTextMultiline+  , inputTextWithHint      -- * Color Editor/Picker   , colorPicker3@@ -229,6 +245,13 @@   , Raw.wantCaptureMouse   , Raw.wantCaptureKeyboard +    -- * Fonts+  , Raw.Font+  , addFontFromFileTTF+  , Raw.addFontDefault+  , Raw.buildFontAtlas+  , Raw.clearFontAtlas+     -- * Types   , module DearImGui.Enums   , module DearImGui.Structs@@ -243,6 +266,9 @@   ( foldl' ) import Foreign import Foreign.C+import qualified GHC.Foreign as Foreign+import System.IO+  ( utf8 )  -- dear-imgui import DearImGui.Enums@@ -283,7 +309,7 @@ begin :: MonadIO m => String -> m Bool begin name = liftIO do   withCString name \namePtr ->-    Raw.begin namePtr nullPtr (ImGuiWindowFlags 0)+    Raw.begin namePtr Nothing Nothing  -- | Append items to a window. --@@ -315,7 +341,7 @@     open = liftIO do       Raw.setNextWindowFullscreen       withCString "FullScreen" \namePtr ->-        Raw.begin namePtr nullPtr fullscreenFlags+        Raw.begin namePtr (Just nullPtr) (Just fullscreenFlags)      close = liftIO . const Raw.end @@ -333,31 +359,58 @@   , ImGuiWindowFlags_NoTitleBar   ] --- | Wraps @ImGui::BeginChild()@.-beginChild :: MonadIO m => String -> m Bool-beginChild name = liftIO do-  withCString name Raw.beginChild --- | Child windows used for self-contained independent scrolling/clipping regions--- within a host window. Child windows can embed their own child.+-- | Begin a self-contained independent scrolling/clipping regions within a host window. --+-- Child windows can embed their own child.+--+-- For each independent axis of @size@:+--   * ==0.0f: use remaining host window size+--   * >0.0f: fixed size+--   * <0.0f: use remaining window size minus abs(size)+--+-- Each axis can use a different mode, e.g. @ImVec2 0 400@.+--+-- @BeginChild()@ returns `False` to indicate the window is collapsed or fully clipped, so you may early out and omit submitting anything to the window.+--+-- Always call a matching `endChild` for each `beginChild` call, regardless of its return value.+--+-- Wraps @ImGui::BeginChild()@.+beginChild :: MonadIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> m Bool+beginChild name size border flags = liftIO do+  withCString name \namePtr ->+    with size \sizePtr ->+      Raw.beginChild namePtr sizePtr (bool 0 1 border) flags++-- | Action wrapper for child windows.+-- -- Action will get 'False' if the child region is collapsed or fully clipped.-withChild :: MonadUnliftIO m => String -> (Bool -> m a) -> m a-withChild name = bracket (beginChild name) (const Raw.endChild)+withChild :: MonadUnliftIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> (Bool -> m a) -> m a+withChild name size border flags = bracket (beginChild name size border flags) (const Raw.endChild) --- | Child windows used for self-contained independent scrolling/clipping regions--- within a host window. Child windows can embed their own child.+-- | Action-skipping wrapper for child windows. -- -- Action will be skipped if the child region is collapsed or fully clipped.-withChildOpen :: MonadUnliftIO m => String -> m () -> m ()-withChildOpen name action =-  withChild name (`when` action)+withChildOpen :: MonadUnliftIO m => String -> ImVec2 -> Bool -> ImGuiWindowFlags -> m () -> m ()+withChildOpen name size border flags action =+  withChild name size border flags (`when` action) +-- | Action wrapper to run in a context of another child window addressed by its name.+--+-- Action will get 'False' if the child region is collapsed or fully clipped.+withChildContext :: MonadUnliftIO m => String -> (Bool -> m a) -> m a+withChildContext name action =+  bracket+    (liftIO $ withCString name Raw.beginChildContext)+    (const Raw.endChild)+    action++ -- | Plain text. text :: MonadIO m => String -> m () text t = liftIO do   withCString t \textPtr ->-    Raw.textUnformatted textPtr nullPtr+    Raw.textUnformatted textPtr Nothing  -- | Colored text. textColored :: (HasGetter ref ImVec4, MonadIO m) => ref -> String -> m ()@@ -407,6 +460,19 @@   withCString label Raw.smallButton  +-- | Flexible button behavior without the visuals.+--+-- Frequently useful to build custom behaviors using the public api+-- (along with IsItemActive, IsItemHovered, etc).+--+-- Wraps @ImGui::InvisibleButton()@.+invisibleButton :: MonadIO m => String -> ImVec2 -> ImGuiButtonFlags -> m Bool+invisibleButton label size flags = liftIO do+  withCString label \labelPtr ->+    with size \sizePtr ->+      Raw.invisibleButton labelPtr sizePtr flags++ -- | Square button with an arrow shape. -- -- Wraps @ImGui::ArrowButton()@.@@ -1065,18 +1131,69 @@  -- | Wraps @ImGui::InputText()@. inputText :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> ref -> Int -> m Bool-inputText desc ref refSize = liftIO do+inputText label ref bufSize =+  withInputString ref bufSize \bufPtrLen ->+      Foreign.withCString utf8 label \labelPtr ->+        Raw.inputText+          labelPtr+          bufPtrLen+          ImGuiInputTextFlags_None+++-- | Wraps @ImGui::InputTextMultiline()@.+inputTextMultiline :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> ref -> Int -> ImVec2 -> m Bool+inputTextMultiline label ref bufSize size =+  withInputString ref bufSize \bufPtrLen ->+    Foreign.withCString utf8 label \labelPtr ->+      with size \sizePtr ->+        Raw.inputTextMultiline+          labelPtr+          bufPtrLen+          sizePtr+          ImGuiInputTextFlags_None+++-- | Wraps @ImGui::InputTextWithHint()@.+inputTextWithHint :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> String -> ref -> Int -> m Bool+inputTextWithHint label hint ref bufSize =+  withInputString ref bufSize \bufPtrLen ->+    Foreign.withCString utf8 label \labelPtr ->+      Foreign.withCString utf8 hint \hintPtr ->+        Raw.inputTextWithHint+          labelPtr+          hintPtr+          bufPtrLen+          ImGuiInputTextFlags_None+++-- | Internal helper to prepare appropriately sized and encoded input buffer.+withInputString+  :: (MonadIO m, HasSetter ref String, HasGetter ref String)+  => ref+  -> Int+  -> (CStringLen -> IO Bool)+  -> m Bool+withInputString ref bufSize action = liftIO do   input <- get ref-  withCString input \ refPtr -> do-    withCString desc \ descPtr -> do-      let refSize' :: CInt-          refSize' = fromIntegral refSize-      changed <- Raw.inputText descPtr refPtr refSize'+  Foreign.withCStringLen utf8 input \(refPtr, refSize) ->+    -- XXX: Allocate and zero buffer to receive imgui updates.+    bracket (mkBuf refSize) free \bufPtr -> do+      -- XXX: Copy the original input.+      copyBytes bufPtr refPtr refSize +      changed <- action (bufPtr, bufSize)+       when changed do-        peekCString refPtr >>= ($=!) ref+        -- XXX: Assuming Imgui wouldn't write over the bump stop so peekCString would finish.+        newValue <- Foreign.peekCString utf8 bufPtr+        ref $=! newValue        return changed+  where+    mkBuf refSize =+      callocBytes $+        max refSize bufSize ++        5 -- XXX: max size of UTF8 code point + NUL terminator   -- | Wraps @ImGui::ColorPicker3()@.@@ -1369,9 +1486,9 @@       Just pivotRef -> do         pivot <- get pivotRef         with pivot $ \pivotPtr ->-          Raw.setNextWindowPos posPtr cond pivotPtr+          Raw.setNextWindowPos posPtr cond (Just pivotPtr)       Nothing ->-        Raw.setNextWindowPos posPtr cond nullPtr+        Raw.setNextWindowPos posPtr cond Nothing  -- | Set next window size. Call before `begin` --@@ -1554,3 +1671,22 @@ popStyleVar :: (MonadIO m) => Int -> m () popStyleVar n = liftIO do   Raw.popStyleVar (fromIntegral n)+++-- | Load a font from TTF file.+--+-- Specify font path and atlas glyph size.+--+-- Use 'addFontDefault' if you want to retain built-in font too.+--+-- Call 'buildFontAtlas' after adding all the fonts.+--+-- Call backend-specific `CreateFontsTexture` before using 'newFrame'.+addFontFromFileTTF :: MonadIO m => FilePath -> Float -> m (Maybe Raw.Font)+addFontFromFileTTF font size = liftIO do+  res@(Raw.Font ptr) <- withCString font \fontPtr ->+    Raw.addFontFromFileTTF fontPtr (CFloat size)+  pure $+    if castPtr ptr == nullPtr+      then Nothing+      else Just res
src/DearImGui/Context.hs view
@@ -33,5 +33,7 @@       [ ( TypeName "ImVec2", [t| ImVec2 |] )       , ( TypeName "ImVec3", [t| ImVec3 |] )       , ( TypeName "ImVec4", [t| ImVec4 |] )+      , ( TypeName "ImGuiContext", [t| ImGuiContext |] )+      , ( TypeName "ImFont", [t| ImFont |] )       ]   }
src/DearImGui/Raw.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}  {-| Module: DearImGui@@ -19,6 +20,8 @@     Context(..)   , createContext   , destroyContext+  , getCurrentContext+  , setCurrentContext      -- * Main   , newFrame@@ -43,6 +46,16 @@     -- * Windows   , begin   , end++    -- ** Utilities++  , getWindowPos+  , getWindowSize+  , getWindowWidth+  , getWindowHeight++    -- ** Manipulation+   , setNextWindowPos   , setNextWindowSize   , setNextWindowFullscreen@@ -51,8 +64,9 @@   , setNextWindowCollapsed   , setNextWindowBgAlpha -    -- * Child Windows+    -- ** Child Windows   , beginChild+  , beginChildContext   , endChild      -- * Parameter stacks@@ -89,7 +103,10 @@     -- ** Main   , button   , smallButton+  , invisibleButton   , arrowButton+  , image+  , imageButton   , checkbox   , progressBar   , bullet@@ -131,6 +148,8 @@      -- ** Text Input   , inputText+  , inputTextMultiline+  , inputTextWithHint      -- * Color Editor/Picker   , colorPicker3@@ -190,6 +209,14 @@   , wantCaptureMouse   , wantCaptureKeyboard +    -- * Fonts in default font atlas+  , Font(..)+  , addFontDefault+  , addFontFromFileTTF+  , addFontFromMemoryTTF+  , buildFontAtlas+  , clearFontAtlas+     -- * Types   , module DearImGui.Enums   , module DearImGui.Structs@@ -220,21 +247,32 @@   -- | Wraps @ImGuiContext*@.-newtype Context = Context (Ptr ())+newtype Context = Context (Ptr ImGuiContext)   -- | Wraps @ImGui::CreateContext()@. createContext :: (MonadIO m) => m Context createContext = liftIO do-  Context <$> [C.exp| void* { CreateContext() } |]+  Context <$> [C.exp| ImGuiContext* { CreateContext() } |]   -- | Wraps @ImGui::DestroyContext()@. destroyContext :: (MonadIO m) => Context -> m () destroyContext (Context contextPtr) = liftIO do-  [C.exp| void { DestroyContext((ImGuiContext*)$(void* contextPtr)); } |]+  [C.exp| void { DestroyContext($(ImGuiContext* contextPtr)); } |] +-- | Wraps @ImGui::GetCurrentContext()@.+getCurrentContext :: MonadIO m => m Context+getCurrentContext = liftIO do+  Context <$> [C.exp| ImGuiContext* { GetCurrentContext() } |] ++-- | Wraps @ImGui::SetCurrentContext()@.+setCurrentContext :: MonadIO m => Context -> m ()+setCurrentContext (Context contextPtr) = liftIO do+  [C.exp| void { SetCurrentContext($(ImGuiContext* contextPtr)) } |]++ -- | Start a new Dear ImGui frame, you can submit any command from this point -- until 'render'/'endFrame'. --@@ -346,10 +384,14 @@ -- -- Passing non-null @Ptr CBool@ shows a window-closing widget in the upper-right corner of the window, -- wich clicking will set the boolean to false when clicked.-begin :: (MonadIO m) => CString -> Ptr CBool -> ImGuiWindowFlags -> m Bool-begin namePtr openPtr flags = liftIO do+begin :: (MonadIO m) => CString -> Maybe (Ptr CBool) -> Maybe (ImGuiWindowFlags) -> m Bool+begin namePtr (Just openPtr) (Just flags) = liftIO do   (0 /=) <$> [C.exp| bool { Begin($(char* namePtr), $(bool* openPtr), $(ImGuiWindowFlags flags)) } |]-+begin namePtr (Just openPtr) Nothing = liftIO do+  (0 /=) <$> [C.exp| bool { Begin($(char* namePtr), $(bool* openPtr)) } |]+begin namePtr Nothing Nothing = liftIO do+  (0 /=) <$> [C.exp| bool { Begin($(char* namePtr)) } |]+begin _ Nothing _ = error "C++ default argument restriction."  -- | Pop window from the stack. --@@ -359,11 +401,47 @@   [C.exp| void { End(); } |]  --- | Wraps @ImGui::BeginChild()@.-beginChild :: (MonadIO m) => CString -> m Bool-beginChild namePtr = liftIO do-  (0 /=) <$> [C.exp| bool { BeginChild($(char* namePtr)) } |]+-- | Begin a self-contained independent scrolling/clipping regions within a host window.+--+-- Child windows can embed their own child.+--+-- For each independent axis of @size@:+--   * ==0.0f: use remaining host window size+--   * >0.0f: fixed size+--   * <0.0f: use remaining window size minus abs(size)+--+-- Each axis can use a different mode, e.g. @ImVec2 0 400@.+--+-- @BeginChild()@ returns `False` to indicate the window is collapsed or fully clipped, so you may early out and omit submitting anything to the window.+--+-- Always call a matching `endChild` for each `beginChild` call, regardless of its return value.+--+-- Wraps @ImGui::BeginChild()@.+beginChild :: (MonadIO m) => CString -> Ptr ImVec2 -> CBool -> ImGuiWindowFlags -> m Bool+beginChild namePtr sizePtr border flags = liftIO do+  (0 /=) <$> [C.exp|+    bool {+      BeginChild(+        $(char* namePtr),+        *$(ImVec2* sizePtr),+        $(bool border),+        $(ImGuiWindowFlags flags)+      )+    }+  |] +-- | Switch context to another child window by its ID+--+-- Wraps @ImGui::BeginChild()@.+beginChildContext :: (MonadIO m) => CString -> m Bool+beginChildContext namePtr = liftIO do+  (0 /=) <$> [C.exp|+    bool {+      BeginChild(+        $(char* namePtr)+      )+    }+  |]  -- | Wraps @ImGui::EndChild()@. endChild :: (MonadIO m) => m ()@@ -394,9 +472,11 @@ --   B) it's faster, no memory copy is done, no buffer size limits, recommended for long chunks of text. -- -- Wraps @ImGui::TextUnformatted()@.-textUnformatted :: (MonadIO m) => CString -> CString -> m ()-textUnformatted textPtr textEndPtr = liftIO do+textUnformatted :: (MonadIO m) => CString -> Maybe CString -> m ()+textUnformatted textPtr (Just textEndPtr) = liftIO do   [C.exp| void { TextUnformatted($(char* textPtr), $(char* textEndPtr)) } |]+textUnformatted textPtr Nothing = liftIO do+  [C.exp| void { TextUnformatted($(char* textPtr)) } |]  -- | Shortcut for @PushStyleColor(ImGuiCol_Text, col); Text(fmt, ...); PopStyleColor();@. --@@ -462,6 +542,24 @@   (0 /=) <$> [C.exp| bool { SmallButton($(char* labelPtr)) } |]  +-- | Flexible button behavior without the visuals.+--+-- Frequently useful to build custom behaviors using the public api+-- (along with IsItemActive, IsItemHovered, etc).+--+-- Wraps @ImGui::InvisibleButton()@.+invisibleButton :: (MonadIO m) => CString -> Ptr ImVec2 -> ImGuiButtonFlags -> m Bool+invisibleButton labelPtr size flags = liftIO do+  (0 /=) <$> [C.exp|+    bool {+      InvisibleButton(+        $(char* labelPtr),+        *$(ImVec2* size),+        $(ImGuiButtonFlags flags)+      )+    }+  |]+ -- | Square button with an arrow shape. -- -- Wraps @ImGui::ArrowButton()@.@@ -470,6 +568,50 @@   (0 /=) <$> [C.exp| bool { ArrowButton($(char* strIdPtr), $(ImGuiDir dir)) } |]  +-- | Image Area to draw a texture.+--+-- For OpenGL: The @userTextureIDPtr@ points to the texture memory (eg. @0x0000000000000001@)+--+-- 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+  [C.exp|+    void {+      Image(+        $(void* userTextureIDPtr),+        *$(ImVec2* sizePtr),+        *$(ImVec2* uv0Ptr),+        *$(ImVec2* uv1Ptr),+        *$(ImVec4* tintColPtr),+        *$(ImVec4* borderColPtr)+      )+    }+  |]++-- | Clickable Image Area.+--+-- Negative @frame_padding@ uses default frame padding settings. Set to 0 for no padding.+--+-- Wraps @ImGui::ImageButton()@.+imageButton :: (MonadIO m) => Ptr () -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> CInt -> Ptr ImVec4 -> Ptr ImVec4 -> m Bool+imageButton userTextureIDPtr sizePtr uv0Ptr uv1Ptr framePadding bgColPtr tintColPtr = liftIO do+  (0 /=) <$> [C.exp|+    bool {+      ImageButton(+        $(void* userTextureIDPtr),+        *$(ImVec2* sizePtr),+        *$(ImVec2* uv0Ptr),+        *$(ImVec2* uv1Ptr),+        $(int framePadding),+        *$(ImVec4* bgColPtr),+        *$(ImVec4* tintColPtr)+      )+    }+  |]++ -- | Wraps @ImGui::Checkbox()@. checkbox :: (MonadIO m) => CString -> Ptr CBool -> m Bool checkbox labelPtr boolPtr = liftIO do@@ -857,12 +999,52 @@     minPtr_ = castPtr minPtr     maxPtr_ = castPtr maxPtr + -- | Wraps @ImGui::InputText()@.-inputText :: (MonadIO m) => CString -> CString -> CInt -> m Bool-inputText descPtr refPtr refSize = liftIO do-  (0 /= ) <$> [C.exp| bool { InputText( $(char* descPtr), $(char* refPtr), $(int refSize) ) } |]+inputText :: (MonadIO m) => CString -> CStringLen -> ImGuiInputTextFlags -> m Bool+inputText labelPtr (bufPtr, fromIntegral -> bufSize) flags = liftIO do+  (0 /= ) <$> [C.exp|+    bool {+      InputText(+        $(char* labelPtr),+        $(char* bufPtr),+        $(int bufSize),+        $(ImGuiInputTextFlags flags)+      )+    }+  |] +-- | Wraps @ImGui::InputTextMultiline()@.+inputTextMultiline :: (MonadIO m) => CString -> CStringLen -> Ptr ImVec2 -> ImGuiInputTextFlags -> m Bool+inputTextMultiline labelPtr (bufPtr, fromIntegral -> bufSize) sizePtr flags = liftIO do+  (0 /= ) <$> [C.exp|+    bool {+      InputTextMultiline(+        $(char* labelPtr),+        $(char* bufPtr),+        $(size_t bufSize),+        *$(ImVec2* sizePtr),+        $(ImGuiInputTextFlags flags)+      )+    }+  |] +-- | Wraps @ImGui::InputTextWithHint()@.+inputTextWithHint :: (MonadIO m) => CString -> CString -> CStringLen -> ImGuiInputTextFlags -> m Bool+inputTextWithHint labelPtr hintPtr (bufPtr, fromIntegral -> bufSize) flags = liftIO do+  (0 /= ) <$> [C.exp|+    bool {+      InputTextWithHint(+        $(char* labelPtr),+        $(char* hintPtr),+        $(char* bufPtr),+        $(int bufSize),+        $(ImGuiInputTextFlags flags)+      )+    }+  |]++ -- | Wraps @ImGui::ColorPicker3()@. colorPicker3 :: (MonadIO m) => CString -> Ptr CFloat -> m Bool colorPicker3 descPtr refPtr = liftIO do@@ -1082,13 +1264,40 @@ isItemHovered = liftIO do   (0 /=) <$> [C.exp| bool { IsItemHovered() } |] +getWindowPos :: (MonadIO m) => m ImVec2+getWindowPos = liftIO do+  C.withPtr_ \ptr ->+    [C.block|+      void {+        *$(ImVec2 * ptr) = GetWindowPos();+      }+    |] +getWindowSize :: (MonadIO m) => m ImVec2+getWindowSize = liftIO do+  C.withPtr_ \ptr ->+    [C.block|+      void {+        *$(ImVec2 * ptr) = GetWindowSize();+      }+    |]++getWindowWidth :: (MonadIO m) => m CFloat+getWindowWidth = liftIO do+  [C.exp| float { GetWindowWidth() } |]++getWindowHeight :: (MonadIO m) => m CFloat+getWindowHeight = liftIO do+  [C.exp| float { GetWindowHeight() } |]+ -- | Set next window position. Call before `begin` Use pivot=(0.5,0.5) to center on given point, etc. -- -- Wraps @ImGui::SetNextWindowPos()@-setNextWindowPos :: (MonadIO m) => Ptr ImVec2 -> ImGuiCond -> Ptr ImVec2 -> m ()-setNextWindowPos posPtr cond pivotPtr = liftIO do+setNextWindowPos :: (MonadIO m) => Ptr ImVec2 -> ImGuiCond -> Maybe (Ptr ImVec2) -> m ()+setNextWindowPos posPtr cond (Just pivotPtr) = liftIO do   [C.exp| void { SetNextWindowPos(*$(ImVec2* posPtr), $(ImGuiCond cond), *$(ImVec2* pivotPtr)) } |]+setNextWindowPos posPtr cond Nothing = liftIO do+  [C.exp| void { SetNextWindowPos(*$(ImVec2* posPtr), $(ImGuiCond cond)) } |]   -- | Set next window size. Call before `begin`@@ -1313,3 +1522,54 @@ wantCaptureKeyboard :: MonadIO m => m Bool wantCaptureKeyboard = liftIO do   (0 /=) <$> [C.exp| bool { GetIO().WantCaptureKeyboard } |]+++-- | Wraps @ImFont*@.+newtype Font = Font (Ptr ImFont)++addFontDefault :: MonadIO m => m Font+addFontDefault = liftIO do+  Font <$> [C.block|+    ImFont* {+      return GetIO().Fonts->AddFontDefault();+    }+  |]++addFontFromFileTTF :: MonadIO m => CString -> CFloat -> m Font+addFontFromFileTTF filenamePtr sizePixels = liftIO do+  Font <$> [C.block|+    ImFont* {+      return GetIO().Fonts->AddFontFromFileTTF(+        $(char* filenamePtr),+        $(float sizePixels));+    }+  |]++-- | Transfer a buffer with TTF data to font atlas builder.+addFontFromMemoryTTF :: MonadIO m => CStringLen -> CFloat -> m Font+addFontFromMemoryTTF (castPtr -> fontDataPtr, fromIntegral -> fontSize) sizePixels = liftIO do+  Font <$> [C.block|+    ImFont* {+      return GetIO().Fonts->AddFontFromMemoryTTF(+        $(void* fontDataPtr),+        $(int fontSize),+        $(float sizePixels)+      );+    }+  |]++buildFontAtlas :: MonadIO m => m ()+buildFontAtlas = liftIO do+  [C.block|+    void {+      GetIO().Fonts->Build();+    }+  |]++clearFontAtlas :: MonadIO m => m ()+clearFontAtlas = liftIO do+  [C.block|+    void {+      GetIO().Fonts->Clear();+    }+  |]
src/DearImGui/Structs.hs view
@@ -9,6 +9,7 @@  -------------------------------------------------------------------------------- data ImVec2 = ImVec2 { x, y :: {-# unpack #-} !Float }+  deriving (Show)   instance Storable ImVec2 where@@ -27,6 +28,7 @@   data ImVec3 = ImVec3 { x, y, z :: {-# unpack #-} !Float }+  deriving (Show)   instance Storable ImVec3 where@@ -47,6 +49,7 @@   data ImVec4 = ImVec4 { x, y, z, w :: {-# unpack #-} !Float }+  deriving (Show)   instance Storable ImVec4 where@@ -66,3 +69,11 @@     z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2))     w <- peek (castPtr ptr `plusPtr` (sizeOf x * 3))     return ImVec4{ x, y, z, w }++--------------------------------------------------------------------------------++-- | DearImGui context handle.+data ImGuiContext++-- | Individual font handle.+data ImFont