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 +14/−0
- Main.hs +1/−3
- dear-imgui.cabal +10/−2
- examples/sdl/Image.hs +181/−0
- examples/vulkan/Main.hs +23/−6
- generator/DearImGui/Generator.hs +2/−2
- src/DearImGui.hs +162/−26
- src/DearImGui/Context.hs +2/−0
- src/DearImGui/Raw.hs +278/−18
- src/DearImGui/Structs.hs +11/−0
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