Wrap ImGui::ListBox() (#25)

This commit is contained in:
Ollie Charles 2021-01-28 23:38:59 +00:00 committed by GitHub
parent bb82e87553
commit af49a7b3fb
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 36 additions and 4 deletions

12
Main.hs
View File

@ -29,12 +29,14 @@ main = do
checked <- newIORef False checked <- newIORef False
color <- newIORef $ ImVec3 1 0 0 color <- newIORef $ ImVec3 1 0 0
slider <- newIORef (0.42, 0, 0.314) slider <- newIORef (0.42, 0, 0.314)
loop w checked color slider r <- newIORef 4
loop w checked color slider r
openGL2Shutdown 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 quit <- pollEvents
openGL2NewFrame openGL2NewFrame
@ -49,6 +51,8 @@ loop w checked color slider = do
begin "My Window" begin "My Window"
text "Hello!" text "Hello!"
listBox "Items" r [ "A", "B", "C" ]
button "Click me" >>= \case button "Click me" >>= \case
True -> openPopup "Button Popup" True -> openPopup "Button Popup"
False -> return () False -> return ()
@ -120,7 +124,7 @@ loop w checked color slider = do
glSwapWindow w glSwapWindow w
if quit then return () else loop w checked color slider if quit then return () else loop w checked color slider r
where where

View File

@ -52,6 +52,7 @@ library
build-depends: build-depends:
base base
, containers , containers
, managed
, inline-c , inline-c
, inline-c-cpp , inline-c-cpp
, StateVar , StateVar

View File

@ -1,6 +1,7 @@
{-# LANGUAGE BlockArguments #-} {-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
@ -91,6 +92,9 @@ module DearImGui
-- ** Selectables -- ** Selectables
, selectable , selectable
-- ** List Boxes
, listBox
-- * Data Plotting -- * Data Plotting
, plotHistogram , plotHistogram
@ -142,6 +146,9 @@ import qualified Language.C.Inline as C
-- inline-c-cpp -- inline-c-cpp
import qualified Language.C.Inline.Cpp as Cpp import qualified Language.C.Inline.Cpp as Cpp
-- managed
import qualified Control.Monad.Managed as Managed
-- StateVar -- StateVar
import Data.StateVar import Data.StateVar
( HasGetter(get), HasSetter, ($=!) ) ( HasGetter(get), HasSetter, ($=!) )
@ -615,6 +622,26 @@ selectable label = liftIO do
(0 /=) <$> [C.exp| bool { Selectable($(char* labelPtr)) } |] (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()@. -- | Wraps @ImGui::PlotHistogram()@.
plotHistogram :: MonadIO m => String -> [CFloat] -> m () plotHistogram :: MonadIO m => String -> [CFloat] -> m ()
plotHistogram label values = liftIO $ plotHistogram label values = liftIO $