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 |] ) ] }