From 2fbe257c2497ff0e2193289f33ca276baf016f93 Mon Sep 17 00:00:00 2001
From: Tristan de Cacqueray <tdecacqu@redhat.com>
Date: Mon, 25 Jan 2021 19:04:43 +0000
Subject: [PATCH] Wrap ImGui::SliderFloat() (#9)

Co-authored-by: Ollie Charles <ollie@ocharles.org.uk>
---
 Main.hs          | 11 +++++++----
 src/DearImGui.hs | 19 +++++++++++++++++++
 2 files changed, 26 insertions(+), 4 deletions(-)

diff --git a/Main.hs b/Main.hs
index d02ad6d..5485202 100644
--- a/Main.hs
+++ b/Main.hs
@@ -28,12 +28,13 @@ main = do
 
       checked <- newIORef False
       color <- newIORef $ ImVec3 1 0 0
-      loop w checked color
+      slider <- newIORef 0.42
+      loop w checked color slider
 
       openGL2Shutdown
 
-loop :: Window -> IORef Bool -> IORef ImVec3 -> IO ()
-loop w checked color = do
+loop :: Window -> IORef Bool -> IORef ImVec3 -> IORef Float -> IO ()
+loop w checked color slider = do
   quit <- pollEvents
 
   openGL2NewFrame
@@ -73,6 +74,8 @@ loop w checked color = do
 
   separator
 
+  sliderFloat "Slider" slider 0.0 1.0
+
   progressBar 0.314 (Just "Pi")
 
   beginCombo "Label" "Preview" >>= whenTrue do
@@ -104,7 +107,7 @@ loop w checked color = do
 
   glSwapWindow w
 
-  if quit then return () else loop w checked color
+  if quit then return () else loop w checked color slider
 
   where
 
diff --git a/src/DearImGui.hs b/src/DearImGui.hs
index 80a1495..15fe1e6 100644
--- a/src/DearImGui.hs
+++ b/src/DearImGui.hs
@@ -59,6 +59,9 @@ module DearImGui
   , progressBar
   , bullet
 
+    -- ** Slider
+  , sliderFloat
+
     -- ** Combo Box
   , beginCombo
   , endCombo
@@ -390,6 +393,22 @@ colorPicker3 desc ref = liftIO do
 
     return changed
 
+-- | Wraps @ImGui::SliderFloat()@
+sliderFloat :: (MonadIO m, HasSetter ref Float, HasGetter ref Float) => String -> ref -> Float -> Float -> m Bool
+sliderFloat desc ref minValue maxValue = liftIO do
+  currentValue <- get ref
+  with (realToFrac currentValue) \floatPtr -> do
+    changed <- withCString desc \descPtr ->
+      (1 ==) <$> [C.exp| bool { SliderFloat( $(char* descPtr), $(float *floatPtr), $(float min'), $(float max')) } |]
+
+    newValue <- peek floatPtr
+    ref $=! realToFrac newValue
+
+    return changed
+  where
+    min', max' :: CFloat
+    min' = realToFrac minValue
+    max' = realToFrac maxValue
 
 -- | Display a color square/button, hover for details, return true when pressed.
 --