From 24903ce76ff5bf756bc0d5cc2f5b6d23bc2035aa Mon Sep 17 00:00:00 2001
From: Ollie Charles <ollie@ocharles.org.uk>
Date: Thu, 28 Jan 2021 23:10:58 +0000
Subject: [PATCH] Implement ImGui::DragFloat{,2,3,4} (#23)

---
 Main.hs          |  2 +-
 src/DearImGui.hs | 82 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 83 insertions(+), 1 deletion(-)

diff --git a/Main.hs b/Main.hs
index 6c59c7c..35b6bd1 100644
--- a/Main.hs
+++ b/Main.hs
@@ -74,7 +74,7 @@ loop w checked color slider = do
 
   separator
 
-  sliderFloat3 "Slider" slider 0.0 1.0
+  dragFloat3 "Slider" slider 0.1 0.0 1.0
 
   progressBar 0.314 (Just "Pi")
 
diff --git a/src/DearImGui.hs b/src/DearImGui.hs
index b434f70..4f6bdc5 100644
--- a/src/DearImGui.hs
+++ b/src/DearImGui.hs
@@ -67,6 +67,12 @@ module DearImGui
   , beginCombo
   , endCombo
 
+    -- ** Drag Sliders
+  , dragFloat
+  , dragFloat2
+  , dragFloat3
+  , dragFloat4
+
     -- ** Slider
   , sliderFloat
   , sliderFloat2
@@ -400,6 +406,82 @@ endCombo = liftIO do
   [C.exp| void { EndCombo() } |]
 
 
+-- | 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
+  currentValue <- get ref
+  with (realToFrac currentValue) \floatPtr -> do
+    changed <- withCString desc \descPtr ->
+      (0 /=) <$> [C.exp| bool { DragFloat( $(char* descPtr), $(float *floatPtr), $(float speed'), $(float min'), $(float max')) } |]
+
+    newValue <- peek floatPtr
+    ref $=! realToFrac newValue
+
+    return changed
+  where
+    min', max', speed' :: CFloat
+    min'   = realToFrac minValue
+    max'   = realToFrac maxValue
+    speed' = realToFrac speed
+
+
+-- | Wraps @ImGui::DragFloat2()@
+dragFloat2 :: (MonadIO m, HasSetter ref (Float, Float), HasGetter ref (Float, Float)) => String -> ref -> Float -> Float -> Float -> m Bool
+dragFloat2 desc ref speed minValue maxValue = liftIO do
+  (x, y) <- get ref
+  withArray [ realToFrac x, realToFrac y ] \floatPtr -> do
+    changed <- withCString desc \descPtr ->
+      (0 /=) <$> [C.exp| bool { DragFloat2( $(char* descPtr), $(float *floatPtr), $(float speed'), $(float min'), $(float max')) } |]
+
+    [x', y'] <- peekArray 2 floatPtr
+    ref $=! (realToFrac x', realToFrac y')
+
+    return changed
+  where
+    min', max', speed' :: CFloat
+    min'   = realToFrac minValue
+    max'   = realToFrac maxValue
+    speed' = realToFrac speed
+
+
+-- | Wraps @ImGui::DragFloat3()@
+dragFloat3 :: (MonadIO m, HasSetter ref (Float, Float, Float), HasGetter ref (Float, Float, Float)) => String -> ref -> Float -> Float -> Float -> m Bool
+dragFloat3 desc ref speed minValue maxValue = liftIO do
+  (x, y, z) <- get ref
+  withArray [ realToFrac x, realToFrac y, realToFrac z ] \floatPtr -> do
+    changed <- withCString desc \descPtr ->
+      (0 /=) <$> [C.exp| bool { DragFloat3( $(char* descPtr), $(float *floatPtr), $(float speed'), $(float min'), $(float max')) } |]
+
+    [x', y', z'] <- peekArray 3 floatPtr
+    ref $=! (realToFrac x', realToFrac y', realToFrac z')
+
+    return changed
+  where
+    min', max', speed' :: CFloat
+    min'   = realToFrac minValue
+    max'   = realToFrac maxValue
+    speed' = realToFrac speed
+
+
+-- | Wraps @ImGui::DragFloat4()@
+dragFloat4 :: (MonadIO m, HasSetter ref (Float, Float, Float, Float), HasGetter ref (Float, Float, Float, Float)) => String -> ref -> Float -> Float -> Float -> m Bool
+dragFloat4 desc ref speed minValue maxValue = liftIO do
+  (x, y, z, u) <- get ref
+  withArray [ realToFrac x, realToFrac y, realToFrac z, realToFrac u ] \floatPtr -> do
+    changed <- withCString desc \descPtr ->
+      (0 /=) <$> [C.exp| bool { DragFloat4( $(char* descPtr), $(float *floatPtr), $(float speed'), $(float min'), $(float max')) } |]
+
+    [x', y', z', u'] <- peekArray 4 floatPtr
+    ref $=! (realToFrac x', realToFrac y', realToFrac z', realToFrac u')
+
+    return changed
+  where
+    min', max', speed' :: CFloat
+    min'   = realToFrac minValue
+    max'   = realToFrac maxValue
+    speed' = realToFrac speed
+
+
 -- | 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