diff --git a/src/DearImGui.hs b/src/DearImGui.hs index 6d40aa9..79722fe 100644 --- a/src/DearImGui.hs +++ b/src/DearImGui.hs @@ -165,6 +165,8 @@ module DearImGui -- ** Text Input , inputText + , inputTextMultiline + , inputTextWithHint -- * Color Editor/Picker , colorPicker3 @@ -253,6 +255,9 @@ import Data.Foldable ( foldl' ) import Foreign import Foreign.C +import qualified GHC.Foreign as Foreign +import System.IO + ( utf8 ) -- dear-imgui import DearImGui.Enums @@ -1088,18 +1093,69 @@ vSliderScalar label size dataType ref refMin refMax format flags = liftIO do -- | Wraps @ImGui::InputText()@. inputText :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> ref -> Int -> m Bool -inputText desc ref refSize = liftIO do +inputText label ref bufSize = + withInputString ref bufSize \bufPtrLen -> + Foreign.withCString utf8 label \labelPtr -> + Raw.inputText + labelPtr + bufPtrLen + ImGuiInputTextFlags_None + + +-- | Wraps @ImGui::InputTextMultiline()@. +inputTextMultiline :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> ref -> Int -> ImVec2 -> m Bool +inputTextMultiline label ref bufSize size = + withInputString ref bufSize \bufPtrLen -> + Foreign.withCString utf8 label \labelPtr -> + with size \sizePtr -> + Raw.inputTextMultiline + labelPtr + bufPtrLen + sizePtr + ImGuiInputTextFlags_None + + +-- | Wraps @ImGui::InputTextWithHint()@. +inputTextWithHint :: (MonadIO m, HasSetter ref String, HasGetter ref String) => String -> String -> ref -> Int -> m Bool +inputTextWithHint label hint ref bufSize = + withInputString ref bufSize \bufPtrLen -> + Foreign.withCString utf8 label \labelPtr -> + Foreign.withCString utf8 hint \hintPtr -> + Raw.inputTextWithHint + labelPtr + hintPtr + bufPtrLen + ImGuiInputTextFlags_None + + +-- | Internal helper to prepare appropriately sized and encoded input buffer. +withInputString + :: (MonadIO m, HasSetter ref String, HasGetter ref String) + => ref + -> Int + -> (CStringLen -> IO Bool) + -> m Bool +withInputString ref bufSize action = liftIO do input <- get ref - withCString input \ refPtr -> do - withCString desc \ descPtr -> do - let refSize' :: CInt - refSize' = fromIntegral refSize - changed <- Raw.inputText descPtr refPtr refSize' + Foreign.withCStringLen utf8 input \(refPtr, refSize) -> + -- XXX: Allocate and zero buffer to receive imgui updates. + bracket (mkBuf refSize) free \bufPtr -> do + -- XXX: Copy the original input. + copyBytes bufPtr refPtr refSize + + changed <- action (bufPtr, bufSize) when changed do - peekCString refPtr >>= ($=!) ref + -- XXX: Assuming Imgui wouldn't write over the bump stop so peekCString would finish. + newValue <- Foreign.peekCString utf8 bufPtr + ref $=! newValue return changed + where + mkBuf refSize = + callocBytes $ + max refSize bufSize + + 5 -- XXX: max size of UTF8 code point + NUL terminator -- | Wraps @ImGui::ColorPicker3()@. diff --git a/src/DearImGui/Raw.hs b/src/DearImGui/Raw.hs index 91227a6..4db28be 100644 --- a/src/DearImGui/Raw.hs +++ b/src/DearImGui/Raw.hs @@ -7,6 +7,7 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} {-| Module: DearImGui @@ -142,6 +143,8 @@ module DearImGui.Raw -- ** Text Input , inputText + , inputTextMultiline + , inputTextWithHint -- * Color Editor/Picker , colorPicker3 @@ -892,10 +895,50 @@ vSliderScalar labelPtr sizePtr dataType dataPtr minPtr maxPtr formatPtr flags = minPtr_ = castPtr minPtr maxPtr_ = castPtr maxPtr + -- | Wraps @ImGui::InputText()@. -inputText :: (MonadIO m) => CString -> CString -> CInt -> m Bool -inputText descPtr refPtr refSize = liftIO do - (0 /= ) <$> [C.exp| bool { InputText( $(char* descPtr), $(char* refPtr), $(int refSize) ) } |] +inputText :: (MonadIO m) => CString -> CStringLen -> ImGuiInputTextFlags -> m Bool +inputText labelPtr (bufPtr, fromIntegral -> bufSize) flags = liftIO do + (0 /= ) <$> [C.exp| + bool { + InputText( + $(char* labelPtr), + $(char* bufPtr), + $(int bufSize), + $(ImGuiInputTextFlags flags) + ) + } + |] + +-- | Wraps @ImGui::InputTextMultiline()@. +inputTextMultiline :: (MonadIO m) => CString -> CStringLen -> Ptr ImVec2 -> ImGuiInputTextFlags -> m Bool +inputTextMultiline labelPtr (bufPtr, fromIntegral -> bufSize) sizePtr flags = liftIO do + (0 /= ) <$> [C.exp| + bool { + InputTextMultiline( + $(char* labelPtr), + $(char* bufPtr), + $(size_t bufSize), + *$(ImVec2* sizePtr), + $(ImGuiInputTextFlags flags) + ) + } + |] + +-- | Wraps @ImGui::InputTextWithHint()@. +inputTextWithHint :: (MonadIO m) => CString -> CString -> CStringLen -> ImGuiInputTextFlags -> m Bool +inputTextWithHint labelPtr hintPtr (bufPtr, fromIntegral -> bufSize) flags = liftIO do + (0 /= ) <$> [C.exp| + bool { + InputTextWithHint( + $(char* labelPtr), + $(char* hintPtr), + $(char* bufPtr), + $(int bufSize), + $(ImGuiInputTextFlags flags) + ) + } + |] -- | Wraps @ImGui::ColorPicker3()@.