diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog for dear-imgui +## [1.2.1] + +- Added `DearImGui.Raw.IO` with attribute setters. + ## [1.2.0] - Fixed `nullPtr` in place of default arguments. diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -7,6 +7,7 @@ import Control.Monad import Data.IORef +import qualified Data.Vector as Vector import DearImGui import DearImGui.OpenGL3 import DearImGui.SDL @@ -130,6 +131,21 @@ combo "Simple" selected [ "1", "2", "3" ] endChild + + text "ListClipper" + withChildOpen "##fixed" (ImVec2 0 200) True ImGuiWindowFlags_None do + let lotsOfItems = Vector.generate 50 (mappend "Item " . show) + withListClipper Nothing lotsOfItems text + + text "ListClipper, Haskell-powered" + withChildOpen "##infinite" (ImVec2 0 200) True ImGuiWindowFlags_None do + let infiniteItems = map (mappend "Item " . show) [0 :: Int ..] + withListClipper Nothing infiniteItems text + + text "Ethereal ListClipper" + withChildOpen "##ethereal" (ImVec2 0 200) True ImGuiWindowFlags_None do + withListClipper Nothing (ClipRange (0 :: Int) 1000) $ + text . mappend "Item " . show plotHistogram "A histogram" [ 10, 10, 20, 30, 90 ] diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -54,38 +54,35 @@ runManaged do -- Create a window using SDL. As we're using OpenGL, we need to enable OpenGL too. - w <- do + window <- do let title = "Hello, Dear ImGui!" let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL } managed $ bracket (createWindow title config) destroyWindow -- Create an OpenGL context - glContext <- managed $ bracket (glCreateContext w) glDeleteContext + glContext <- managed $ bracket (glCreateContext window) glDeleteContext -- Create an ImGui context _ <- managed $ bracket createContext destroyContext -- Initialize ImGui's SDL2 backend - _ <- managed_ $ bracket_ (sdl2InitForOpenGL w glContext) sdl2Shutdown + _ <- managed_ $ bracket_ (sdl2InitForOpenGL window glContext) sdl2Shutdown -- Initialize ImGui's OpenGL backend _ <- managed_ $ bracket_ openGL2Init openGL2Shutdown - liftIO $ mainLoop w + liftIO $ mainLoop window mainLoop :: Window -> IO () -mainLoop w = do - -- Process the event loop - untilNothingM pollEventWithImGui - +mainLoop window = unlessQuit do -- Tell ImGui we're starting a new frame openGL2NewFrame sdl2NewFrame newFrame -- Build the GUI - bracket_ (begin "Hello, ImGui!") end do + withWindowOpen "Hello, ImGui!" do -- Add a text widget text "Hello, ImGui!" @@ -103,12 +100,25 @@ render openGL2RenderDrawData =<< getDrawData - glSwapWindow w + glSwapWindow window - mainLoop w + mainLoop window where - untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m) + -- Process the event loop + 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 ``` # Hacking diff --git a/dear-imgui.cabal b/dear-imgui.cabal --- a/dear-imgui.cabal +++ b/dear-imgui.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: dear-imgui -version: 1.2.0 +version: 1.2.1 author: Oliver Charles maintainer: ollie@ocharles.org.uk, aenor.realm@gmail.com license: BSD-3-Clause @@ -24,10 +24,45 @@ imgui/imconfig.h, imgui/LICENSE.txt +common build-flags + if flag(debug) + if os(linux) + ghc-options: -Wall -g -rtsopts -dcore-lint -debug + cc-options: -g -O0 -fsanitize=address -fno-omit-frame-pointer + cxx-options: -g -O0 -fsanitize=address -fno-omit-frame-pointer -std=c++11 + if os(darwin) + ghc-options: -Wall -g -rtsopts -dcore-lint -debug + cc-options: -g -O0 -fsanitize=address -fno-omit-frame-pointer + cxx-options: -g -O0 -fsanitize=address -fno-omit-frame-pointer -std=c++11 + if os(windows) + ghc-options: -Wall -g -rtsopts -dcore-lint -debug + cc-options: -g -O0 + cxx-options: -g -O0 -std=c++11 + else + if os(linux) + ghc-options: -Wall -O2 + cc-options: -O2 + cxx-options: -std=c++11 -O2 + if os(darwin) + ghc-options: -Wall -O2 + cc-options: -O2 + if os(windows) + ghc-options: -Wall -O2 + cc-options: -O2 + + source-repository head type: git location: https://github.com/haskell-game/dear-imgui.hs +flag debug + description: + Enable debug mode. + default: + False + manual: + True + flag opengl2 description: Enable OpenGL 2 backend. @@ -82,8 +117,6 @@ >= 4.12 && < 4.17 default-language: Haskell2010 - ghc-options: - -Wall library import: common @@ -92,18 +125,20 @@ exposed-modules: DearImGui DearImGui.Raw + DearImGui.Raw.DrawList + DearImGui.Raw.ListClipper + DearImGui.Raw.IO other-modules: DearImGui.Context DearImGui.Enums DearImGui.Structs + cxx-options: -std=c++11 cxx-sources: imgui/imgui.cpp imgui/imgui_demo.cpp imgui/imgui_draw.cpp imgui/imgui_tables.cpp imgui/imgui_widgets.cpp - cxx-options: - -std=c++11 extra-libraries: stdc++ include-dirs: @@ -116,6 +151,7 @@ , inline-c-cpp , StateVar , unliftio + , vector if flag(opengl2) exposed-modules: @@ -233,27 +269,26 @@ >= 0.2.11 && < 0.2.15 executable test - import: common + import: common, build-flags main-is: Main.hs default-language: Haskell2010 - ghc-options: -Wall if (!flag(examples) || !flag(sdl) || !flag(opengl2)) buildable: False else - build-depends: base, sdl2, gl, dear-imgui + build-depends: base, sdl2, gl, dear-imgui, vector executable glfw + import: common, build-flags main-is: Main.hs hs-source-dirs: examples/glfw default-language: Haskell2010 - ghc-options: -Wall if (!flag(examples) || !flag(glfw) || !flag(opengl2)) buildable: False else build-depends: base, GLFW-b, gl, dear-imgui, managed executable readme - import: common + import: common, build-flags main-is: Readme.hs hs-source-dirs: examples build-depends: sdl2, gl, dear-imgui, managed @@ -261,7 +296,7 @@ buildable: False executable image - import: common + import: common, build-flags main-is: Image.hs hs-source-dirs: examples/sdl build-depends: sdl2, gl, dear-imgui, managed, vector @@ -269,12 +304,11 @@ buildable: False executable vulkan - import: common + import: common, build-flags main-is: Main.hs other-modules: Attachments, Backend, Input, Util hs-source-dirs: examples/vulkan default-language: Haskell2010 - ghc-options: -Wall if (!flag(examples) || !flag(sdl) || !flag(vulkan)) buildable: False else diff --git a/examples/Readme.hs b/examples/Readme.hs --- a/examples/Readme.hs +++ b/examples/Readme.hs @@ -45,10 +45,7 @@ mainLoop :: Window -> IO () -mainLoop window = do - -- Process the event loop - untilNothingM pollEventWithImGui - +mainLoop window = unlessQuit do -- Tell ImGui we're starting a new frame openGL2NewFrame sdl2NewFrame @@ -78,4 +75,17 @@ mainLoop window where - untilNothingM m = m >>= maybe (return ()) (\_ -> untilNothingM m) + -- Process the event loop + 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 diff --git a/examples/sdl/Image.hs b/examples/sdl/Image.hs --- a/examples/sdl/Image.hs +++ b/examples/sdl/Image.hs @@ -14,6 +14,7 @@ import Control.Monad.Managed (managed, managed_, runManaged) import DearImGui import qualified DearImGui.Raw as Raw +import qualified DearImGui.Raw.DrawList as DrawList import DearImGui.OpenGL3 import DearImGui.SDL import DearImGui.SDL.OpenGL @@ -134,18 +135,18 @@ sdl2NewFrame newFrame + 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 + -- 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 - + -- Using imageButton Foreign.with (textureSize texture) \sizePtr -> Foreign.with (ImVec2 0 0) \uv0Ptr -> Foreign.with (ImVec2 1 1) \uv1Ptr -> @@ -154,6 +155,19 @@ Raw.imageButton openGLtextureID sizePtr uv0Ptr uv1Ptr (-1) bgColPtr tintColPtr else pure False + + -- Using DrawList + bg <- getBackgroundDrawList + Foreign.with (ImVec2 100 100) \pMin -> + Foreign.with (ImVec2 200 200) \pMax -> + Foreign.with (ImVec2 0.25 0.25) \uvMin -> + Foreign.with (ImVec2 0.75 0.75) \uvMax -> + DrawList.addImageRounded + bg + openGLtextureID + pMin pMax uvMin uvMax + (Raw.imCol32 0 255 0 0xFF) -- Extract green channel + 32 ImDrawFlags_RoundCornersBottom -- Render glClear GL_COLOR_BUFFER_BIT diff --git a/src/DearImGui.hs b/src/DearImGui.hs --- a/src/DearImGui.hs +++ b/src/DearImGui.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} @@ -54,6 +55,7 @@ -- ** Utilities + , Raw.getWindowDrawList , Raw.getWindowPos , Raw.getWindowSize , Raw.getWindowWidth @@ -172,11 +174,11 @@ , inputTextMultiline , inputTextWithHint - -- * Color Editor/Picker + -- ** Color Editor/Picker , colorPicker3 , colorButton - -- * Trees + -- ** Trees , treeNode , treePush , Raw.treePop @@ -187,7 +189,7 @@ -- ** List Boxes , listBox - -- * Data Plotting + -- ** Data Plotting , plotHistogram -- ** Menus @@ -221,7 +223,7 @@ , tabItemButton , setTabItemClosed - -- * Tooltips + -- ** Tooltips , withTooltip , Raw.beginTooltip , Raw.endTooltip @@ -252,6 +254,18 @@ , Raw.buildFontAtlas , Raw.clearFontAtlas + -- * Utilities + + -- ** ListClipper + , withListClipper + , ClipItems(..) + , ClipRange(..) + + -- ** Miscellaneous + , Raw.getBackgroundDrawList + , Raw.getForegroundDrawList + , Raw.imCol32 + -- * Types , module DearImGui.Enums , module DearImGui.Structs @@ -290,7 +304,12 @@ import UnliftIO.Exception (bracket, bracket_) import qualified DearImGui.Raw as Raw +import qualified DearImGui.Raw.ListClipper as Raw.ListClipper +-- vector +import qualified Data.Vector as V +import qualified Data.Vector.Storable as VS +import qualified Data.Vector.Unboxed as VU -- | Get the compiled version string e.g. "1.80 WIP" (essentially the value for -- @IMGUI_VERSION@ from the compiled version of @imgui.cpp@). @@ -1690,3 +1709,86 @@ if castPtr ptr == nullPtr then Nothing else Just res + +-- | Clips a large list of items +-- +-- The requirements on @a@ are that they are all of the same height. +withListClipper :: (ClipItems t a, MonadUnliftIO m) => Maybe Float -> t a -> (a -> m ()) -> m () +withListClipper itemHeight items action = + bracket + (liftIO $ throwIfNull "withListClipper: ListClipper allocation failed" Raw.ListClipper.new) + Raw.ListClipper.delete + step + where + itemHeight' = maybe (-1.0) CFloat itemHeight + itemCount' = maybe maxBound fromIntegral (itemCount items) + + step clipper = do + Raw.ListClipper.begin clipper itemCount' itemHeight' + go clipper + + go clipper = do + doStep <- Raw.ListClipper.step clipper + when doStep do + let + startIndex = fromIntegral $ Raw.ListClipper.displayStart clipper + endIndex = fromIntegral $ Raw.ListClipper.displayEnd clipper + stepItems action $ + clipItems startIndex endIndex items + + go clipper + +-- | Containers usable with 'ListClipper'. +class ClipItems t a where + itemCount :: t a -> Maybe Int + clipItems :: Int -> Int -> t a -> t a + stepItems :: Monad m => (a -> m ()) -> t a -> m () + +-- | Unbounded stream of items. +instance ClipItems [] a where + itemCount = const Nothing + + clipItems displayStart displayEnd = + take (displayEnd - displayStart) . drop displayStart + + stepItems = mapM_ + +instance ClipItems V.Vector a where + itemCount = Just . V.length + + clipItems displayStart displayEnd = + V.slice displayStart (displayEnd - displayStart) + + stepItems = V.mapM_ + +instance Storable a => ClipItems VS.Vector a where + itemCount = Just . VS.length + + clipItems displayStart displayEnd = + VS.slice displayStart (displayEnd - displayStart) + + stepItems = VS.mapM_ + +instance VU.Unbox a => ClipItems VU.Vector a where + itemCount = Just . VU.length + + clipItems displayStart displayEnd = + VU.slice displayStart (displayEnd - displayStart) + + stepItems = VU.mapM_ + +-- | ClipList helper for arbitrary unmaterialized ranges. +data ClipRange a = ClipRange a a + deriving (Eq, Ord, Show) + +instance (Ord a, Enum a, Num a) => ClipItems ClipRange a where + itemCount (ClipRange _begin end) = + Just $ fromEnum end + + clipItems clipBegin clipEnd (ClipRange oldBegin oldEnd) = + ClipRange + (toEnum $ max clipBegin $ fromEnum oldBegin) + (toEnum $ min clipEnd $ fromEnum oldEnd) + + stepItems action (ClipRange start end) = + mapM_ action [start .. end - 1] diff --git a/src/DearImGui/Context.hs b/src/DearImGui/Context.hs --- a/src/DearImGui/Context.hs +++ b/src/DearImGui/Context.hs @@ -33,7 +33,10 @@ [ ( TypeName "ImVec2", [t| ImVec2 |] ) , ( TypeName "ImVec3", [t| ImVec3 |] ) , ( TypeName "ImVec4", [t| ImVec4 |] ) + , ( TypeName "ImU32", [t| ImU32 |] ) + , ( TypeName "ImDrawList", [t| ImDrawList |] ) , ( TypeName "ImGuiContext", [t| ImGuiContext |] ) , ( TypeName "ImFont", [t| ImFont |] ) + , ( TypeName "ImGuiListClipper", [t| ImGuiListClipper |] ) ] } diff --git a/src/DearImGui/Raw.hs b/src/DearImGui/Raw.hs --- a/src/DearImGui/Raw.hs +++ b/src/DearImGui/Raw.hs @@ -49,6 +49,7 @@ -- ** Utilities + , getWindowDrawList , getWindowPos , getWindowSize , getWindowWidth @@ -89,6 +90,7 @@ , beginGroup , endGroup , setCursorPos + , getCursorScreenPos , alignTextToFramePadding -- * Widgets @@ -217,6 +219,13 @@ , buildFontAtlas , clearFontAtlas + -- * Utilities + + -- ** Miscellaneous + , getBackgroundDrawList + , getForegroundDrawList + , imCol32 + -- * Types , module DearImGui.Enums , module DearImGui.Structs @@ -228,12 +237,15 @@ ( MonadIO, liftIO ) import Foreign import Foreign.C +import System.IO.Unsafe + ( unsafePerformIO ) -- dear-imgui import DearImGui.Context ( imguiContext ) import DearImGui.Enums import DearImGui.Structs +import DearImGui.Raw.DrawList (DrawList(..)) -- inline-c import qualified Language.C.Inline as C @@ -1264,6 +1276,19 @@ isItemHovered = liftIO do (0 /=) <$> [C.exp| bool { IsItemHovered() } |] + +-- | Get draw list associated to the current window. +getWindowDrawList :: (MonadIO m) => m DrawList +getWindowDrawList = liftIO do + DrawList <$> [C.exp| + ImDrawList* { + GetWindowDrawList() + } + |] + +-- | Get current window position in screen space. +-- +-- Useful if you want to do your own drawing via the "DrawList" API. getWindowPos :: (MonadIO m) => m ImVec2 getWindowPos = liftIO do C.withPtr_ \ptr -> @@ -1445,7 +1470,22 @@ setCursorPos posPtr = liftIO do [C.exp| void { SetCursorPos(*$(ImVec2* posPtr)) } |] +-- | Cursor position in absolute coordinates. +-- +-- Useful to work with 'DrawList' API. +-- +-- Generally top-left == @GetMainViewport()->Pos == (0,0)@ in single viewport mode, +-- and bottom-right == @GetMainViewport()->Pos+Size == io.DisplaySize@ in single-viewport mode. +getCursorScreenPos :: (MonadIO m) => m ImVec2 +getCursorScreenPos = liftIO do + C.withPtr_ \ptr -> + [C.block| + void { + *$(ImVec2 * ptr) = GetCursorScreenPos(); + } + |] + -- | Modify a style color by pushing to the shared stack. always use this if you modify the style after `newFrame` -- -- Wraps @ImGui::PushStyleColor()@ @@ -1571,5 +1611,44 @@ [C.block| void { GetIO().Fonts->Clear(); + } + |] + + +-- | This draw list will be the first rendering one. +-- +-- Useful to quickly draw shapes/text behind dear imgui contents. +getBackgroundDrawList :: (MonadIO m) => m DrawList +getBackgroundDrawList = liftIO do + DrawList <$> [C.exp| + ImDrawList* { + GetBackgroundDrawList() + } + |] + +-- | This draw list will be the last rendered one. +-- +-- Useful to quickly draw shapes/text over dear imgui contents. +getForegroundDrawList :: (MonadIO m) => m DrawList +getForegroundDrawList = liftIO do + DrawList <$> [C.exp| + ImDrawList* { + GetForegroundDrawList() + } + |] + +-- | Generate 32-bit encoded colors using DearImgui macros. +-- +-- Follows @IMGUI_USE_BGRA_PACKED_COLOR@ define to put bytes in appropriate positions. +imCol32 :: CUChar -> CUChar -> CUChar -> CUChar -> ImU32 +imCol32 r g b a = unsafePerformIO + [C.exp| + ImU32 { + IM_COL32( + $(unsigned char r), + $(unsigned char g), + $(unsigned char b), + $(unsigned char a) + ) } |] diff --git a/src/DearImGui/Raw/DrawList.hs b/src/DearImGui/Raw/DrawList.hs new file mode 100644 --- /dev/null +++ b/src/DearImGui/Raw/DrawList.hs @@ -0,0 +1,742 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} + +{-| Draw command list + +This is the low-level list of polygons that ImGui functions are filling. + +At the end of the frame, all command lists are passed to your @ImGuiIO::RenderDrawListFn@ function for rendering. + +Each dear imgui window contains its own ImDrawList. + +You can use 'getWindowDrawList' to access the current window draw list and draw custom primitives. + +You can interleave normal ImGui calls and adding primitives to the current draw list. + +In single viewport mode, top-left is == @GetMainViewport()->Pos@ (generally @0,0@), +bottom-right is == @GetMainViewport()->Pos+Size@ (generally io.DisplaySize). + +You are totally free to apply whatever transformation matrix to want to the data +(depending on the use of the transformation you may want to apply it to ClipRect as well!). + +__Important__: Primitives are always added to the list and not culled (culling is done at higher-level by ImGui functions), +if you use this API a lot consider coarse culling your drawn objects. +-} + +module DearImGui.Raw.DrawList + ( DrawList(..) + , new + , destroy + + -- * Primitives + + -- $primitives + , addLine + + , addRect + , addRectFilled + , addRectFilledMultiColor + + , addQuad + , addQuadFilled + + , addTriangle + , addTriangleFilled + + , addCircle + , addCircleFilled + + , addNgon + , addNgonFilled + + , addText_ + , addText + + , addPolyLine + , addConvexPolyFilled + + , addBezierCubic + , addBezierQuadratic + + -- ** Image primitives + + -- $image + , addImage + , addImageQuad + , addImageRounded + + -- * Stateful path API + + -- $stateful + , pathClear + , pathLineTo + , pathLineToMergeDuplicate + , pathFillConvex + , pathStroke + + , pathArcTo + , pathArcToFast + + , pathBezierCubicCurveTo + , pathBezierQuadraticCurveTo + + , pathRect + + -- * Advanced + + -- , addCallback + , addDrawCmd + , cloneOutput + + -- * Internal state + + , pushClipRect + , pushClipRectFullScreen + , popClipRect + , getClipRectMin + , getClipRectMax + + , pushTextureID + , popTextureID + ) + where + +import Control.Monad.IO.Class + ( MonadIO, liftIO ) +import Foreign hiding (new) +import Foreign.C + +-- dear-imgui +import DearImGui.Context + ( imguiContext ) +import DearImGui.Enums +import DearImGui.Structs + +-- inline-c +import qualified Language.C.Inline as C + +-- inline-c-cpp +import qualified Language.C.Inline.Cpp as Cpp + +C.context (Cpp.cppCtx <> C.bsCtx <> imguiContext) +C.include "imgui.h" +Cpp.using "namespace ImGui" + +-- | A single draw command list. +-- Generally one per window, conceptually you may see this as a dynamic "mesh" builder. +newtype DrawList = DrawList (Ptr ImDrawList) + +new :: MonadIO m => m DrawList +new = liftIO do + DrawList <$> [C.block| + ImDrawList* { + return IM_NEW(ImDrawList(GetDrawListSharedData())); + } + |] + +destroy :: MonadIO m => DrawList -> m () +destroy (DrawList drawList) = liftIO do + [C.block| + void { + IM_DELETE($(ImDrawList* drawList)); + } + |] + + +pushClipRect :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> CBool -> m () +pushClipRect (DrawList drawList) clip_rect_min clip_rect_max intersect_with_current_clip_rect = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PushClipRect( + *$(ImVec2* clip_rect_min), + *$(ImVec2* clip_rect_max), + $(bool intersect_with_current_clip_rect) + ); + } + |] + +pushClipRectFullScreen :: MonadIO m => DrawList -> m () +pushClipRectFullScreen (DrawList drawList) = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PushClipRectFullScreen(); + } + |] + +popClipRect :: MonadIO m => DrawList -> m () +popClipRect (DrawList drawList) = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PopClipRect(); + } + |] + + +getClipRectMin :: MonadIO m => DrawList -> m ImVec2 +getClipRectMin (DrawList drawList) = liftIO do + C.withPtr_ \ptr -> + [C.block| + void { + *$(ImVec2 * ptr) = $(ImDrawList* drawList)->GetClipRectMin(); + } + |] + +getClipRectMax :: MonadIO m => DrawList -> m ImVec2 +getClipRectMax (DrawList drawList) = liftIO do + C.withPtr_ \ptr -> + [C.block| + void { + *$(ImVec2 * ptr) = $(ImDrawList* drawList)->GetClipRectMax(); + } + |] + + +pushTextureID :: MonadIO m => DrawList -> Ptr () -> m () +pushTextureID (DrawList drawList) userTextureIDPtr = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PushTextureID( + $(void* userTextureIDPtr) + ); + } + |] + +popTextureID :: MonadIO m => DrawList -> m () +popTextureID (DrawList drawList) = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PopTextureID(); + } + |] + + +{- $primitives +- For rectangular primitives, @p_min@ and @p_max@ represent the upper-left and lower-right corners. +- For circle primitives, use @num_segments == 0@ to automatically calculate tessellation (preferred). + In older versions (until Dear ImGui 1.77) the 'addCircle' functions defaulted to num_segments == 12. + In future versions we will use textures to provide cheaper and higher-quality circles. + Use 'addNgon' and 'addNgonFilled' functions if you need to guaranteed a specific number of sides. +-} + +addLine :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> m () +addLine (DrawList drawList) p1 p2 col thickness = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddLine( + *$(ImVec2* p1), + *$(ImVec2* p2), + $(ImU32 col), + $(float thickness) + ); + } + |] + + +addRect :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> ImDrawFlags -> CFloat -> m () +addRect (DrawList drawList) p_min p_max col rounding flags thickness = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddRect( + *$(ImVec2* p_min), + *$(ImVec2* p_max), + $(ImU32 col), + $(float rounding), + $(ImDrawFlags flags), + $(float thickness) + ); + } + |] + +addRectFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> ImDrawFlags -> m () +addRectFilled (DrawList drawList) p_min p_max col rounding flags = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddRectFilled( + *$(ImVec2* p_min), + *$(ImVec2* p_max), + $(ImU32 col), + $(float rounding), + $(ImDrawFlags flags) + ); + } + |] + +addRectFilledMultiColor :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> ImU32 -> ImU32 -> ImU32 -> m () +addRectFilledMultiColor (DrawList drawList) p_min p_max col_upr_left col_upr_right col_bot_right col_bot_left = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddRectFilledMultiColor( + *$(ImVec2* p_min), + *$(ImVec2* p_max), + $(ImU32 col_upr_left), + $(ImU32 col_upr_right), + $(ImU32 col_bot_right), + $(ImU32 col_bot_left) + ); + } + |] + + +addQuad :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> m () +addQuad (DrawList drawList) p1 p2 p3 p4 col thickness = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddQuad( + *$(ImVec2* p1), + *$(ImVec2* p2), + *$(ImVec2* p3), + *$(ImVec2* p4), + $(ImU32 col), + $(float thickness) + ); + } + |] + +addQuadFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> m () +addQuadFilled (DrawList drawList) p1 p2 p3 p4 col = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddQuadFilled( + *$(ImVec2* p1), + *$(ImVec2* p2), + *$(ImVec2* p3), + *$(ImVec2* p4), + $(ImU32 col) + ); + } + |] + + +addTriangle :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> CFloat -> m () +addTriangle (DrawList drawList) p1 p2 p3 col thickness = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddTriangle( + *$(ImVec2* p1), + *$(ImVec2* p2), + *$(ImVec2* p3), + $(ImU32 col), + $(float thickness) + ); + } + |] + +addTriangleFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> ImU32 -> m () +addTriangleFilled (DrawList drawList) p1 p2 p3 col = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddTriangleFilled( + *$(ImVec2* p1), + *$(ImVec2* p2), + *$(ImVec2* p3), + $(ImU32 col) + ); + } + |] + + +addCircle :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> CFloat -> m () +addCircle (DrawList drawList) center radius col num_segments thickness = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddCircle( + *$(ImVec2* center), + $(float radius), + $(ImU32 col), + $(int num_segments), + $(float thickness) + ); + } + |] + +addCircleFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> m () +addCircleFilled (DrawList drawList) center radius col num_segments = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddCircleFilled( + *$(ImVec2* center), + $(float radius), + $(ImU32 col), + $(int num_segments) + ); + } + |] + + +addNgon :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> CFloat -> m () +addNgon (DrawList drawList) center radius col num_segments thickness = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddNgon( + *$(ImVec2* center), + $(float radius), + $(ImU32 col), + $(int num_segments), + $(float thickness) + ); + } + |] + +addNgonFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> ImU32 -> CInt -> m () +addNgonFilled (DrawList drawList) center radius col num_segments = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddNgonFilled( + *$(ImVec2* center), + $(float radius), + $(ImU32 col), + $(int num_segments) + ); + } + |] + + +addText_ :: MonadIO m => DrawList -> Ptr ImVec2 -> ImU32 -> CString -> CString -> m () +addText_ (DrawList drawList) pos col text_begin text_end = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddText( + *$(ImVec2* pos), + $(ImU32 col), + $(char* text_begin), + $(char* text_end) + ); + } + |] + +addText :: MonadIO m => DrawList -> Ptr ImFont -> CFloat -> Ptr ImVec2 -> ImU32 -> CString -> CString -> CFloat -> Ptr ImVec4 -> m () +addText (DrawList drawList) fontPtr font_size pos col text_begin text_end wrap_width cpu_fine_clip_rect = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddText( + $(ImFont* fontPtr), + $(float font_size), + *$(ImVec2* pos), + $(ImU32 col), + $(char* text_begin), + $(char* text_end), + $(float wrap_width), + $(ImVec4* cpu_fine_clip_rect) + ); + } + |] + + +addPolyLine :: MonadIO m => DrawList -> Ptr ImVec2 -> CInt -> ImU32 -> ImDrawFlags -> CFloat -> m () +addPolyLine (DrawList drawList) points num_points col flags thickness = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddPolyline( + $(ImVec2* points), + $(int num_points), + $(ImU32 col), + $(ImDrawFlags flags), + $(float thickness) + ); + } + |] + +addConvexPolyFilled :: MonadIO m => DrawList -> Ptr ImVec2 -> CInt -> ImU32 -> m () +addConvexPolyFilled (DrawList drawList) points num_points col = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddConvexPolyFilled( + $(ImVec2* points), + $(int num_points), + $(ImU32 col) + ); + } + |] + + +addBezierCubic + :: MonadIO m + => DrawList + -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -- Positions (control points) + -> ImU32 + -> CFloat + -> CInt + -> m () +addBezierCubic (DrawList drawList) p1 p2 p3 p4 col thickness numSegments = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddBezierCubic( + *$(ImVec2* p1), + *$(ImVec2* p2), + *$(ImVec2* p3), + *$(ImVec2* p4), + $(ImU32 col), + $(float thickness), + $(int numSegments) + ); + } + |] + +addBezierQuadratic + :: MonadIO m + => DrawList + -> Ptr ImVec2 -> Ptr ImVec2 -> Ptr ImVec2 -- Positions (control points) + -> ImU32 + -> CFloat + -> CInt + -> m () +addBezierQuadratic (DrawList drawList) p1 p2 p3 col thickness numSegments = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddBezierQuadratic( + *$(ImVec2* p1), + *$(ImVec2* p2), + *$(ImVec2* p3), + $(ImU32 col), + $(float thickness), + $(int numSegments) + ); + } + |] + + +{- $image +* Read FAQ to understand what @ImTextureID@ is. +* @p_min@ and @p_max@ represent the upper-left and lower-right corners of the rectangle. +* @uv_min@ and @uv_max@ represent the normalized texture coordinates to use for those corners. + Using @(0,0)->(1,1)@ texture coordinates will generally display the entire texture. +-} + +addImage + :: MonadIO m + => DrawList + -> Ptr () + -> 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 + [C.block| + void { + $(ImDrawList* drawList)->AddImage( + $(void* userTextureIDPtr), + *$(ImVec2* p_min), + *$(ImVec2* p_max), + *$(ImVec2* uv_min), + *$(ImVec2* uv_max), + $(ImU32 col) + ); + } + |] + +addImageQuad + :: MonadIO m + => DrawList + -> Ptr () + -> 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 + [C.block| + void { + $(ImDrawList* drawList)->AddImageQuad( + $(void* userTextureIDPtr), + *$(ImVec2* p1), + *$(ImVec2* p2), + *$(ImVec2* p3), + *$(ImVec2* p4), + *$(ImVec2* uv1), + *$(ImVec2* uv2), + *$(ImVec2* uv3), + *$(ImVec2* uv4), + $(ImU32 col) + ); + } + |] + +addImageRounded + :: MonadIO m + => DrawList + -> Ptr () + -> 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 + [C.block| + void { + $(ImDrawList* drawList)->AddImageRounded( + $(void* userTextureIDPtr), + *$(ImVec2* p_min), + *$(ImVec2* p_max), + *$(ImVec2* uv_min), + *$(ImVec2* uv_max), + $(ImU32 col), + $(float rounding), + $(ImDrawFlags flags) + ); + } + |] + +{- $stateful +Add points then finish with 'pathFillConvex' or 'pathStroke'. +-} + +pathClear :: MonadIO m => DrawList -> m () +pathClear (DrawList drawList) = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PathClear(); + } + |] + +pathLineTo :: MonadIO m => DrawList -> Ptr ImVec2 -> m () +pathLineTo (DrawList drawList) pos = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PathLineTo( + *$(ImVec2* pos) + ); + } + |] + +pathLineToMergeDuplicate :: MonadIO m => DrawList -> Ptr ImVec2 -> m () +pathLineToMergeDuplicate (DrawList drawList) pos = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PathLineToMergeDuplicate( + *$(ImVec2* pos) + ); + } + |] + +-- | Note: Anti-aliased filling requires points to be in clockwise order. +pathFillConvex :: MonadIO m => DrawList -> ImU32 -> m () +pathFillConvex (DrawList drawList) col = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PathFillConvex( + $(ImU32 col) + ); + } + |] + +pathStroke :: MonadIO m => DrawList -> ImU32 -> ImDrawFlags -> CFloat -> m () +pathStroke (DrawList drawList) col flags thickness = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PathStroke( + $(ImU32 col), + $(ImDrawFlags flags), + $(float thickness) + ); + } + |] + + +pathArcTo :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> CFloat -> CFloat -> CInt -> m () +pathArcTo (DrawList drawList) center radius a_min a_max num_segments = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PathArcTo( + *$(ImVec2* center), + $(float radius), + $(float a_min), + $(float a_max), + $(int num_segments) + ); + } + |] + +-- | Use precomputed angles for a 12 steps circle. +pathArcToFast :: MonadIO m => DrawList -> Ptr ImVec2 -> CFloat -> CInt -> CInt -> m () +pathArcToFast (DrawList drawList) center radius a_min_of_12 a_max_of_12 = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PathArcToFast( + *$(ImVec2* center), + $(float radius), + $(int a_min_of_12), + $(int a_max_of_12) + ); + } + |] + + +pathBezierCubicCurveTo + :: MonadIO m + => DrawList + -> Ptr ImVec2 + -> Ptr ImVec2 + -> Ptr ImVec2 + -> CInt + -> m () +pathBezierCubicCurveTo (DrawList drawList) p1 p2 p3 num_segments = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PathBezierCubicCurveTo( + *$(ImVec2* p1), + *$(ImVec2* p2), + *$(ImVec2* p3), + $(int num_segments) + ); + } + |] + +pathBezierQuadraticCurveTo + :: MonadIO m + => DrawList + -> Ptr ImVec2 + -> Ptr ImVec2 + -> CInt + -> m () +pathBezierQuadraticCurveTo (DrawList drawList) p1 p2 num_segments = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PathBezierQuadraticCurveTo( + *$(ImVec2* p1), + *$(ImVec2* p2), + $(int num_segments) + ); + } + |] + + +pathRect :: MonadIO m => DrawList -> Ptr ImVec2 -> Ptr ImVec2 -> CFloat -> ImDrawFlags -> m () +pathRect (DrawList drawList) rect_min rect_max rounding flags = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->PathRect( + *$(ImVec2* rect_min), + *$(ImVec2* rect_max), + $(float rounding), + $(ImDrawFlags flags) + ); + } + |] + + +-- | This is useful if you need to forcefully create a new draw call (to allow for dependent rendering / blending). +-- Otherwise primitives are merged into the same draw-call as much as possible. +addDrawCmd :: MonadIO m => DrawList -> m () +addDrawCmd (DrawList drawList) = liftIO do + [C.block| + void { + $(ImDrawList* drawList)->AddDrawCmd(); + } + |] + +-- | Create a clone of the CmdBuffer/IdxBuffer/VtxBuffer. +cloneOutput :: MonadIO m => DrawList -> m DrawList +cloneOutput (DrawList drawList) = liftIO do + DrawList <$> [C.block| + ImDrawList* { + return $(ImDrawList* drawList)->CloneOutput(); + } + |] diff --git a/src/DearImGui/Raw/IO.hs b/src/DearImGui/Raw/IO.hs new file mode 100644 --- /dev/null +++ b/src/DearImGui/Raw/IO.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} + +{-| Main configuration and I/O between your application and ImGui + +-} + +module DearImGui.Raw.IO + ( setIniFilename + , setLogFilename + + , setMouseDoubleClickMaxDist + , setMouseDoubleClickTime + , setMouseDragThreshold + + , setKeyRepeatDelay + , setKeyRepeatRate + + , setUserData + ) where + +-- TODO: add exports + +import Control.Monad.IO.Class + ( MonadIO, liftIO ) +import Foreign + ( Ptr ) +import Foreign.C + ( CFloat(..) + , CString + ) + +-- dear-imgui +import DearImGui.Context + ( imguiContext ) +-- import DearImGui.Enums +-- import DearImGui.Structs + +-- inline-c +import qualified Language.C.Inline as C + +-- inline-c-cpp +import qualified Language.C.Inline.Cpp as Cpp + +C.context (Cpp.cppCtx <> C.bsCtx <> imguiContext) +C.include "imgui.h" +Cpp.using "namespace ImGui" + +setIniFilename :: MonadIO m => CString -> m () +setIniFilename ptr = liftIO do + [C.block| + void { + GetIO().IniFilename = $(char * ptr); + } + |] + +setLogFilename :: MonadIO m => CString -> m () +setLogFilename ptr = liftIO do + [C.block| + void { + GetIO().LogFilename = $(char * ptr); + } + |] + +setMouseDoubleClickTime :: MonadIO m => CFloat -> m () +setMouseDoubleClickTime seconds = liftIO do + [C.block| + void { + GetIO().MouseDoubleClickTime = $(float seconds); + } + |] + +setMouseDoubleClickMaxDist :: MonadIO m => CFloat -> m () +setMouseDoubleClickMaxDist pixels = liftIO do + [C.block| + void { + GetIO().MouseDoubleClickMaxDist = $(float pixels); + } + |] + +setMouseDragThreshold :: MonadIO m => CFloat -> m () +setMouseDragThreshold pixels = liftIO do + [C.block| + void { + GetIO().MouseDragThreshold = $(float pixels); + } + |] + +setKeyRepeatDelay :: MonadIO m => CFloat -> m () +setKeyRepeatDelay seconds = liftIO do + [C.block| + void { + GetIO().KeyRepeatDelay = $(float seconds); + } + |] + +setKeyRepeatRate :: MonadIO m => CFloat -> m () +setKeyRepeatRate pixels = liftIO do + [C.block| + void { + GetIO().KeyRepeatRate = $(float pixels); + } + |] + +setUserData :: MonadIO m => Ptr () -> m () +setUserData ptr = liftIO do + [C.block| + void { + GetIO().UserData = $(void* ptr); + } + |] + +{- TODO: + +bool WantCaptureMouse; // Set when Dear ImGui will use mouse inputs, in this case do not dispatch them to your main game/application (either way, always pass on mouse inputs to imgui). (e.g. unclicked mouse is hovering over an imgui window, widget is active, mouse was clicked over an imgui window, etc.). +bool WantCaptureKeyboard; // Set when Dear ImGui will use keyboard inputs, in this case do not dispatch them to your main game/application (either way, always pass keyboard inputs to imgui). (e.g. InputText active, or an imgui window is focused and navigation is enabled, etc.). +bool WantTextInput; // Mobile/console: when set, you may display an on-screen keyboard. This is set by Dear ImGui when it wants textual keyboard input to happen (e.g. when a InputText widget is active). +bool WantSetMousePos; // MousePos has been altered, backend should reposition mouse on next frame. Rarely used! Set only when ImGuiConfigFlags_NavEnableSetMousePos flag is enabled. +bool WantSaveIniSettings; // When manual .ini load/save is active (io.IniFilename == NULL), this will be set to notify your application that you can call SaveIniSettingsToMemory() and save yourself. Important: clear io.WantSaveIniSettings yourself after saving! +bool NavActive; // Keyboard/Gamepad navigation is currently allowed (will handle ImGuiKey_NavXXX events) = a window is focused and it doesn't use the ImGuiWindowFlags_NoNavInputs flag. +bool NavVisible; // Keyboard/Gamepad navigation is visible and allowed (will handle ImGuiKey_NavXXX events). +float Framerate; // Rough estimate of application framerate, in frame per second. Solely for convenience. Rolling average estimation based on io.DeltaTime over 120 frames. +int MetricsRenderVertices; // Vertices output during last call to Render() +int MetricsRenderIndices; // Indices output during last call to Render() = number of triangles * 3 +int MetricsRenderWindows; // Number of visible windows +int MetricsActiveWindows; // Number of active windows +int MetricsActiveAllocations; // Number of active allocations, updated by MemAlloc/MemFree based on current context. May be off if you have multiple imgui contexts. +ImVec2 MouseDelta; +-} diff --git a/src/DearImGui/Raw/ListClipper.hs b/src/DearImGui/Raw/ListClipper.hs new file mode 100644 --- /dev/null +++ b/src/DearImGui/Raw/ListClipper.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} + +{-| Helper: Manually clip large list of items. + +If you are submitting lots of evenly spaced items and you have a random access to the list, +you can perform coarse clipping based on visibility to save yourself from processing those items at all. + +The clipper calculates the range of visible items and advance the cursor to compensate for the non-visible items we have skipped. + +Dear ImGui already clips items based on their bounds but it needs to measure text size to do so, +whereas manual coarse clipping before submission makes this cost and your own data fetching/submission cost almost null. + +Usage: + +@ +clipper <- ListClipper.new +ListClipper.begin clipper 1000 -- We have 1000 elements, evenly spaced. +whileTrue (ListClipper.step clipper) $ + start <- ListClipper.displayStart clipper + end <- ListClipper.displayEnd clipper + for_ [start .. end] \ix -> + ImGui.text $ "line number " <> show ix +@ + +Generally what happens is: + +* Clipper lets you process the first element (DisplayStart = 0, DisplayEnd = 1) regardless of it being visible or not. +* User code submit one element. +* Clipper can measure the height of the first element +* Clipper calculate the actual range of elements to display based on the current clipping rectangle, + position the cursor before the first visible element. +* User code submit visible elements. +-} + +module DearImGui.Raw.ListClipper + ( ListClipper + , new + , delete + , begin + , displayStart + , displayEnd + , step + ) + where + +import Control.Monad.IO.Class + ( MonadIO, liftIO ) +import Foreign hiding (new) +import Foreign.C +import System.IO.Unsafe (unsafePerformIO) + +-- dear-imgui +import DearImGui.Context + ( imguiContext ) +import DearImGui.Structs + ( ImGuiListClipper ) + +-- inline-c +import qualified Language.C.Inline as C + +-- inline-c-cpp +import qualified Language.C.Inline.Cpp as Cpp + +C.context (Cpp.cppCtx <> C.bsCtx <> imguiContext) +C.include "imgui.h" +Cpp.using "namespace ImGui" + + +-- | @ImGuiListClipper@ object handle. +type ListClipper = Ptr ImGuiListClipper + + +-- | Create a new 'ListClipper' instance. +new :: (MonadIO m) => m ListClipper +new = liftIO do + [C.block| + ImGuiListClipper* { + return IM_NEW(ImGuiListClipper); + } + |] + +-- | Destroy 'ListClipper' instance. +delete :: (MonadIO m) => ListClipper -> m () +delete clipper = liftIO do + [C.block| + void { + IM_DELETE($(ImGuiListClipper* clipper)); + } + |] + + +-- | ListClipper setup +-- +-- @items_count@: Use 'maxBound' if you don't know how many items you have +-- (in which case the cursor won't be advanced in the final step). +-- +-- @items_height@: Use -1.0f to be calculated automatically on first step. +-- Otherwise pass in the distance between your items, typically +-- 'getTextLineHeightWithSpacing' or 'getFrameHeightWithSpacing'. +-- +-- Wraps @ListClipper::Begin()@. +begin :: (MonadIO m) => ListClipper -> CInt -> CFloat -> m () +begin clipper items_count items_height = liftIO do + [C.block| + void { + $(ImGuiListClipper* clipper)->Begin($(int items_count), $(float items_height)); + } + |] + +-- | An accessor for @ListClipper::Begin@ +displayStart :: ListClipper -> CInt +displayStart clipper = unsafePerformIO do + [C.exp| + int { + $(ImGuiListClipper* clipper)->DisplayStart + } + |] + +-- | An accessor for @ListClipper::DisplayStart@ +displayEnd :: ListClipper -> CInt +displayEnd clipper = unsafePerformIO + [C.exp| + int { + $(ImGuiListClipper* clipper)->DisplayEnd + } + |] + + +-- | Call until it returns 'False'. +-- +-- The 'displayStart'/'displayEnd' fields will be set and you can process/draw those items. +-- +-- Wraps @ListClipper::Step()@. +step :: (MonadIO m) => ListClipper -> m Bool +step clipper = liftIO do + (0 /=) <$> [C.block| + bool { + return $(ImGuiListClipper* clipper)->Step(); + } + |] diff --git a/src/DearImGui/Structs.hs b/src/DearImGui/Structs.hs --- a/src/DearImGui/Structs.hs +++ b/src/DearImGui/Structs.hs @@ -4,6 +4,8 @@ module DearImGui.Structs where -- base +import Data.Word + ( Word32 ) import Foreign ( Storable(..), castPtr, plusPtr ) @@ -77,3 +79,12 @@ -- | Individual font handle. data ImFont + +-- | Opaque DrawList handle. +data ImDrawList + +-- | 'DearImGui.Raw.ListClipper.ListClipper' pointer tag. +data ImGuiListClipper + +-- | 32-bit unsigned integer (often used to store packed colors). +type ImU32 = Word32