mirror of
https://github.com/Drezil/dear-imgui.hs.git
synced 2024-11-26 02:27:00 +00:00
Wrap ImGui::Checkbox()
This commit is contained in:
parent
0fb690d832
commit
90d96ad938
15
Main.hs
15
Main.hs
@ -5,6 +5,7 @@
|
|||||||
|
|
||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
|
import Data.IORef
|
||||||
import DearImGui
|
import DearImGui
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Graphics.GL
|
import Graphics.GL
|
||||||
@ -23,12 +24,12 @@ main = do
|
|||||||
styleColorsLight
|
styleColorsLight
|
||||||
openGL2Init
|
openGL2Init
|
||||||
|
|
||||||
loop w
|
newIORef False >>= loop w
|
||||||
|
|
||||||
openGL2Shutdown
|
openGL2Shutdown
|
||||||
|
|
||||||
loop :: Window -> IO ()
|
loop :: Window -> IORef Bool -> IO ()
|
||||||
loop w = do
|
loop w checked = do
|
||||||
ev <- pollEventWithImGui
|
ev <- pollEventWithImGui
|
||||||
|
|
||||||
openGL2NewFrame
|
openGL2NewFrame
|
||||||
@ -53,6 +54,10 @@ loop w = do
|
|||||||
|
|
||||||
arrowButton "Arrow" ImGuiDirUp
|
arrowButton "Arrow" ImGuiDirUp
|
||||||
|
|
||||||
|
checkbox "Check!" checked >>= \case
|
||||||
|
True -> readIORef checked >>= print
|
||||||
|
False -> return ()
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
render
|
render
|
||||||
@ -63,7 +68,7 @@ loop w = do
|
|||||||
glSwapWindow w
|
glSwapWindow w
|
||||||
|
|
||||||
case ev of
|
case ev of
|
||||||
Nothing -> loop w
|
Nothing -> loop w checked
|
||||||
Just Event{ eventPayload } -> case eventPayload of
|
Just Event{ eventPayload } -> case eventPayload of
|
||||||
QuitEvent -> return ()
|
QuitEvent -> return ()
|
||||||
_ -> loop w
|
_ -> loop w checked
|
||||||
|
@ -20,7 +20,7 @@ library
|
|||||||
extra-libraries: stdc++
|
extra-libraries: stdc++
|
||||||
pkgconfig-depends: sdl2
|
pkgconfig-depends: sdl2
|
||||||
include-dirs: imgui
|
include-dirs: imgui
|
||||||
build-depends: base, inline-c, inline-c-cpp, sdl2
|
build-depends: base, inline-c, inline-c-cpp, sdl2, StateVar
|
||||||
extra-libraries: GL
|
extra-libraries: GL
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,4 +1,5 @@
|
|||||||
{-# LANGUAGE BlockArguments #-}
|
{-# LANGUAGE BlockArguments #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE PatternSynonyms #-}
|
{-# LANGUAGE PatternSynonyms #-}
|
||||||
@ -55,6 +56,7 @@ module DearImGui
|
|||||||
, button
|
, button
|
||||||
, smallButton
|
, smallButton
|
||||||
, arrowButton
|
, arrowButton
|
||||||
|
, checkbox
|
||||||
|
|
||||||
-- * Types
|
-- * Types
|
||||||
, ImGuiDir
|
, ImGuiDir
|
||||||
@ -65,9 +67,11 @@ module DearImGui
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
import Data.Bool
|
||||||
|
import Data.StateVar
|
||||||
import Control.Monad ( when )
|
import Control.Monad ( when )
|
||||||
import Foreign
|
import Foreign
|
||||||
import Foreign.C.String
|
import Foreign.C
|
||||||
import qualified Language.C.Inline as C
|
import qualified Language.C.Inline as C
|
||||||
import qualified Language.C.Inline.Cpp as Cpp
|
import qualified Language.C.Inline.Cpp as Cpp
|
||||||
import SDL
|
import SDL
|
||||||
@ -297,6 +301,20 @@ arrowButton strId (ImGuiDir dir) = withCString strId \strIdPtr ->
|
|||||||
(1 ==) <$> [C.exp| bool { ArrowButton($(char* strIdPtr), $(int dir)) } |]
|
(1 ==) <$> [C.exp| bool { ArrowButton($(char* strIdPtr), $(int dir)) } |]
|
||||||
|
|
||||||
|
|
||||||
|
-- | Wraps @ImGui::Checkbox()@.
|
||||||
|
checkbox :: (HasSetter ref Bool, HasGetter ref Bool) => String -> ref -> IO Bool
|
||||||
|
checkbox label ref = do
|
||||||
|
currentValue <- get ref
|
||||||
|
with (bool 0 1 currentValue :: CBool) \boolPtr -> do
|
||||||
|
changed <- withCString label \labelPtr ->
|
||||||
|
(1 ==) <$> [C.exp| bool { Checkbox($(char* labelPtr), $(bool* boolPtr)) } |]
|
||||||
|
|
||||||
|
newValue <- peek boolPtr
|
||||||
|
ref $=! (newValue == 1)
|
||||||
|
|
||||||
|
return changed
|
||||||
|
|
||||||
|
|
||||||
-- | A cardinal direction.
|
-- | A cardinal direction.
|
||||||
newtype ImGuiDir = ImGuiDir CInt
|
newtype ImGuiDir = ImGuiDir CInt
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user