From 24519778e694d40eed240f591ea662f2f8badc76 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Sun, 12 Sep 2021 11:43:44 +0300
Subject: [PATCH] Add inputTextMultiline, inputTextWithHint (#92)

- Experimental explicit encoding for CStrings.
- Fix potential buffer overruns in inputText.
---
 src/DearImGui.hs     | 70 +++++++++++++++++++++++++++++++++++++++-----
 src/DearImGui/Raw.hs | 49 +++++++++++++++++++++++++++++--
 2 files changed, 109 insertions(+), 10 deletions(-)

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()@.