From af49a7b3fbd1833ed36459ec36fed3d58fb3d30f Mon Sep 17 00:00:00 2001
From: Ollie Charles <ollie@ocharles.org.uk>
Date: Thu, 28 Jan 2021 23:38:59 +0000
Subject: [PATCH] Wrap ImGui::ListBox() (#25)

---
 Main.hs          | 12 ++++++++----
 dear-imgui.cabal |  1 +
 src/DearImGui.hs | 27 +++++++++++++++++++++++++++
 3 files changed, 36 insertions(+), 4 deletions(-)

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 $