mirror of
https://github.com/Drezil/dear-imgui.hs.git
synced 2024-11-25 10:07:01 +00:00
Wrap ImGui::ListBox() (#25)
This commit is contained in:
parent
bb82e87553
commit
af49a7b3fb
12
Main.hs
12
Main.hs
@ -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
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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 $
|
||||||
|
Loading…
Reference in New Issue
Block a user