diff --git a/Main.hs b/Main.hs index f28d0e0..2f47e00 100644 --- a/Main.hs +++ b/Main.hs @@ -29,12 +29,14 @@ main = do checked <- newIORef False color <- newIORef $ ImVec3 1 0 0 slider <- newIORef (0.42, 0, 0.314) - loop w checked color slider + r <- newIORef 4 + loop w checked color slider r openGL2Shutdown -loop :: Window -> IORef Bool -> IORef ImVec3 -> IORef (Float, Float, Float) -> IO () -loop w checked color slider = do + +loop :: Window -> IORef Bool -> IORef ImVec3 -> IORef (Float, Float, Float) -> IORef Int -> IO () +loop w checked color slider r = do quit <- pollEvents openGL2NewFrame @@ -49,6 +51,8 @@ loop w checked color slider = do begin "My Window" text "Hello!" + listBox "Items" r [ "A", "B", "C" ] + button "Click me" >>= \case True -> openPopup "Button Popup" False -> return () @@ -120,7 +124,7 @@ loop w checked color slider = do glSwapWindow w - if quit then return () else loop w checked color slider + if quit then return () else loop w checked color slider r where diff --git a/dear-imgui.cabal b/dear-imgui.cabal index 1de71bd..7d77c14 100644 --- a/dear-imgui.cabal +++ b/dear-imgui.cabal @@ -52,6 +52,7 @@ library build-depends: base , containers + , managed , inline-c , inline-c-cpp , StateVar diff --git a/src/DearImGui.hs b/src/DearImGui.hs index 4c458fa..4f3f892 100644 --- a/src/DearImGui.hs +++ b/src/DearImGui.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} @@ -91,6 +92,9 @@ module DearImGui -- ** Selectables , selectable + -- ** List Boxes + , listBox + -- * Data Plotting , plotHistogram @@ -142,6 +146,9 @@ import qualified Language.C.Inline as C -- inline-c-cpp import qualified Language.C.Inline.Cpp as Cpp +-- managed +import qualified Control.Monad.Managed as Managed + -- StateVar import Data.StateVar ( HasGetter(get), HasSetter, ($=!) ) @@ -615,6 +622,26 @@ selectable label = liftIO do (0 /=) <$> [C.exp| bool { Selectable($(char* labelPtr)) } |] +listBox :: (MonadIO m, HasGetter ref Int, HasSetter ref Int) => String -> ref -> [String] -> m Bool +listBox label selectedIndex items = liftIO $ Managed.with m return + where + m = do + i <- get selectedIndex + + cStrings <- traverse (\str -> Managed.managed (withCString str)) items + labelPtr <- Managed.managed $ withCString label + iPtr <- Managed.managed $ with (fromIntegral i) + + liftIO $ withArrayLen cStrings \len itemsPtr -> do + let len' = fromIntegral len + [C.exp| bool { ListBox($(char* labelPtr), $(int* iPtr), $(char** itemsPtr), $(int len')) }|] >>= \case + 0 -> return False + _ -> do + i' <- peek iPtr + selectedIndex $=! fromIntegral i' + return True + + -- | Wraps @ImGui::PlotHistogram()@. plotHistogram :: MonadIO m => String -> [CFloat] -> m () plotHistogram label values = liftIO $