From 4586f30eb2e4e2856504e6376b6b472c499ee903 Mon Sep 17 00:00:00 2001
From: Oliver Charles <ollie@ocharles.org.uk>
Date: Mon, 25 Jan 2021 09:11:46 +0000
Subject: [PATCH] Wrap @ImGui::ColorPicker3()@

---
 Main.hs                  | 13 +++++++------
 src/DearImGui.hs         | 17 +++++++++++++++++
 src/DearImGui/Context.hs | 24 +++++++++++++++++++++++-
 3 files changed, 47 insertions(+), 7 deletions(-)

diff --git a/Main.hs b/Main.hs
index 5495317..d02ad6d 100644
--- a/Main.hs
+++ b/Main.hs
@@ -26,12 +26,14 @@ main = do
       checkVersion
       styleColorsLight
 
-      newIORef False >>= loop w
+      checked <- newIORef False
+      color <- newIORef $ ImVec3 1 0 0
+      loop w checked color
 
       openGL2Shutdown
 
-loop :: Window -> IORef Bool -> IO ()
-loop w checked = do
+loop :: Window -> IORef Bool -> IORef ImVec3 -> IO ()
+loop w checked color = do
   quit <- pollEvents
 
   openGL2NewFrame
@@ -80,8 +82,7 @@ loop w checked = do
 
   plotHistogram "A histogram" [ 10, 10, 20, 30, 90 ]
 
-  ref <- newIORef $ ImVec4 1 0 0 1
-  colorButton "Test" ref
+  colorPicker3 "Test" color
 
   beginMainMenuBar >>= whenTrue do
     beginMenu "Hello" >>= whenTrue do
@@ -103,7 +104,7 @@ loop w checked = do
 
   glSwapWindow w
 
-  if quit then return () else loop w checked
+  if quit then return () else loop w checked color
 
   where
 
diff --git a/src/DearImGui.hs b/src/DearImGui.hs
index b8945c3..b71fe37 100644
--- a/src/DearImGui.hs
+++ b/src/DearImGui.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -63,6 +64,7 @@ module DearImGui
   , endCombo
 
     -- * Color Editor/Picker
+  , colorPicker3
   , colorButton
 
     -- ** Selectables
@@ -100,6 +102,7 @@ module DearImGui
   , pattern ImGuiDirRight
   , pattern ImGuiDirUp
   , pattern ImGuiDirDown
+  , ImVec3(..)
   , ImVec4(..)
   )
   where
@@ -374,6 +377,20 @@ endCombo = liftIO do
   [C.exp| void { EndCombo() } |]
 
 
+-- | Wraps @ImGui::ColorPicker3()@.
+colorPicker3 :: (MonadIO m, HasSetter ref ImVec3, HasGetter ref ImVec3) => String -> ref -> m Bool
+colorPicker3 desc ref = liftIO do
+  ImVec3{x, y, z} <- get ref
+  withArray (realToFrac <$> [x, y, z]) \refPtr -> do
+    changed <- withCString desc \descPtr ->
+      (1 == ) <$> [C.exp| bool { ColorPicker3( $(char* descPtr), $(float *refPtr) ) } |]
+
+    [x', y', z'] <- peekArray 3 refPtr
+    ref $=! ImVec3 (realToFrac x') (realToFrac y') (realToFrac z')
+
+    return changed
+
+
 -- | Display a color square/button, hover for details, return true when pressed.
 --
 -- | Wraps @ImGui::ColorButton()@.
diff --git a/src/DearImGui/Context.hs b/src/DearImGui/Context.hs
index 01efaad..3220ae3 100644
--- a/src/DearImGui/Context.hs
+++ b/src/DearImGui/Context.hs
@@ -1,3 +1,4 @@
+{-# language DuplicateRecordFields #-}
 {-# language NamedFieldPuns #-}
 {-# language OverloadedStrings #-}
 {-# language TemplateHaskell #-}
@@ -10,6 +11,26 @@ import qualified Data.Map.Strict as Map
 import Foreign
 
 
+data ImVec3 = ImVec3 { x, y, z :: {-# unpack #-} !Float }
+
+
+instance Storable ImVec3 where
+  sizeOf ~ImVec3{x, y, z} = sizeOf x + sizeOf y + sizeOf z
+
+  alignment _ = 0
+
+  poke ptr ImVec3{ x, y, z } = do
+    poke (castPtr ptr `plusPtr` (sizeOf x * 0)) x
+    poke (castPtr ptr `plusPtr` (sizeOf x * 1)) y
+    poke (castPtr ptr `plusPtr` (sizeOf x * 2)) z
+
+  peek ptr = do
+    x <- peek (castPtr ptr                         )
+    y <- peek (castPtr ptr `plusPtr` (sizeOf x * 1))
+    z <- peek (castPtr ptr `plusPtr` (sizeOf x * 2))
+    return ImVec3{ x, y, z }
+
+
 data ImVec4 = ImVec4 { x, y, z, w :: {-# unpack #-} !Float }
 
 
@@ -35,6 +56,7 @@ instance Storable ImVec4 where
 imguiContext :: Context
 imguiContext = mempty
   { ctxTypesTable = Map.fromList
-      [ ( TypeName "ImVec4", [t| ImVec4 |] )
+      [ ( TypeName "ImVec3", [t| ImVec3 |] )
+      , ( TypeName "ImVec4", [t| ImVec4 |] )
       ]
   }