From 643d2ea5b76490bfbc47742520ddbd53f702b645 Mon Sep 17 00:00:00 2001
From: Shaun Sharples <shaun.sharples@gmail.com>
Date: Fri, 5 Feb 2021 23:20:32 +0200
Subject: [PATCH] Add combo to wrap ImGUI::Combo() (#28)

Co-authored-by: Oliver Charles <ollie@ocharles.org.uk>
---
 Main.hs          | 18 ++++++++++++++----
 src/DearImGui.hs | 22 ++++++++++++++++++++++
 2 files changed, 36 insertions(+), 4 deletions(-)

diff --git a/Main.hs b/Main.hs
index f5d8b0b..f69aa7f 100644
--- a/Main.hs
+++ b/Main.hs
@@ -30,13 +30,21 @@ main = do
       color <- newIORef $ ImVec3 1 0 0
       slider <- newIORef (0.42, 0, 0.314)
       r <- newIORef 4
-      loop w checked color slider r
+      selected <- newIORef 4
+      loop w checked color slider r selected
 
       openGL2Shutdown
 
 
-loop :: Window -> IORef Bool -> IORef ImVec3 -> IORef (Float, Float, Float) -> IORef Int -> IO ()
-loop w checked color slider r = do
+loop 
+  :: Window 
+  -> IORef Bool 
+  -> IORef ImVec3 
+  -> IORef (Float, Float, Float) 
+  -> IORef Int 
+  -> IORef Int 
+  -> IO ()
+loop w checked color slider r selected = do
   quit <- pollEvents
 
   openGL2NewFrame
@@ -89,6 +97,8 @@ loop w checked color slider r = do
     selectable "Testing 2"
     endCombo
 
+  combo "Simple" selected [ "1", "2", "3" ]
+
   endChild
 
   plotHistogram "A histogram" [ 10, 10, 20, 30, 90 ]
@@ -124,7 +134,7 @@ loop w checked color slider r = do
 
   glSwapWindow w
 
-  if quit then return () else loop w checked color slider r
+  if quit then return () else loop w checked color slider r selected
 
   where
 
diff --git a/src/DearImGui.hs b/src/DearImGui.hs
index da135a8..341ec00 100644
--- a/src/DearImGui.hs
+++ b/src/DearImGui.hs
@@ -67,6 +67,7 @@ module DearImGui
     -- ** Combo Box
   , beginCombo
   , endCombo
+  , combo
 
     -- ** Drag Sliders
   , dragFloat
@@ -416,6 +417,27 @@ endCombo = liftIO do
   [C.exp| void { EndCombo() } |]
 
 
+-- Wraps @ImGui::Combo()@.
+combo :: (MonadIO m, HasGetter ref Int, HasSetter ref Int) => String -> ref -> [String] -> m Bool
+combo 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 { Combo($(char* labelPtr), $(int* iPtr), $(char** itemsPtr), $(int len')) }|] >>= \case
+          0 -> return False
+          _ -> do
+            i' <- peek iPtr
+            selectedIndex $=! fromIntegral i'
+            return True
+
+
 -- | Wraps @ImGui::DragFloat()@
 dragFloat :: (MonadIO m, HasSetter ref Float, HasGetter ref Float) => String -> ref -> Float -> Float -> Float -> m Bool
 dragFloat desc ref speed minValue maxValue = liftIO do