From d7dc999e8b7fd219eb2eb520896fd9755fd53f78 Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Sat, 28 Aug 2021 18:52:04 +0300
Subject: [PATCH] Add withID (#75)

Raw versions are specialized to match overloaded C++ functions.
---
 src/DearImGui.hs     | 43 ++++++++++++++++++++++++++++++++++++++++++
 src/DearImGui/Raw.hs | 45 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 88 insertions(+)

diff --git a/src/DearImGui.hs b/src/DearImGui.hs
index 169ba8d..c117949 100644
--- a/src/DearImGui.hs
+++ b/src/DearImGui.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -87,6 +88,10 @@ module DearImGui
   , setCursorPos
   , Raw.alignTextToFramePadding
 
+    -- * ID stack
+  , withID
+  , ToID(..)
+
     -- * Widgets
     -- ** Text
   , text
@@ -1460,6 +1465,44 @@ setCursorPos posRef = liftIO do
   pos <- get posRef
   with pos Raw.setCursorPos
 
+-- | Add an element to a ID stack
+--
+-- Read the FAQ (http://dearimgui.org/faq) for more details
+-- about how ID are handled in dear imgui.
+--
+-- Those questions are answered and impacted by understanding of the ID stack system:
+-- * "Q: Why is my widget not reacting when I click on it?"
+-- * "Q: How can I have widgets with an empty label?"
+-- * "Q: How can I have multiple widgets with the same label?"
+--
+-- Wraps @ImGui::PushId@ and @ImGui::PopId@
+withID :: (MonadUnliftIO m, ToID id) => id -> m a -> m a
+withID i = bracket_ (liftIO $ pushID i) Raw.popID
+
+-- | A supplementary class to match overloaded functions in C++ the library.
+class ToID a where
+  pushID :: MonadIO m => a -> m ()
+
+instance ToID CInt where
+  pushID = Raw.pushIDInt
+
+instance ToID Int where
+  pushID = Raw.pushIDInt . fromIntegral
+
+instance ToID Integer where
+  pushID = Raw.pushIDInt . fromInteger
+
+instance {-# OVERLAPPABLE #-} ToID (Ptr a) where
+  pushID = Raw.pushIDPtr
+
+instance {-# OVERLAPPING #-} ToID (Ptr CChar) where
+  pushID = Raw.pushIDStr
+
+instance ToID (Ptr CChar, Int) where
+  pushID = Raw.pushIDStrLen
+
+instance ToID String where
+  pushID s = liftIO $ withCStringLen s pushID
 
 -- | Modify a style color by pushing to the shared stack. always use this if you modify the style after `newFrame`
 --
diff --git a/src/DearImGui/Raw.hs b/src/DearImGui/Raw.hs
index e12c288..c08a705 100644
--- a/src/DearImGui/Raw.hs
+++ b/src/DearImGui/Raw.hs
@@ -178,6 +178,13 @@ module DearImGui.Raw
   , openPopup
   , closeCurrentPopup
 
+    -- * ID stack/scopes
+  , pushIDInt
+  , pushIDPtr
+  , pushIDStr
+  , pushIDStrLen
+  , popID
+
     -- * Item/Widgets Utilities
   , isItemHovered
   , wantCaptureMouse
@@ -1261,6 +1268,44 @@ popStyleVar :: (MonadIO m) => CInt -> m ()
 popStyleVar n = liftIO do
   [C.exp| void { PopStyleVar($(int n)) } |]
 
+
+-- | Push integer into the ID stack (will hash int).
+--
+-- Wraps @ImGui::PushId@
+pushIDInt :: (MonadIO m) => CInt -> m ()
+pushIDInt intId = liftIO do
+  [C.exp| void { PushID($(int intId)) } |]
+
+-- | Push pointer into the ID stack (will hash pointer).
+--
+-- Wraps @ImGui::PushId@
+pushIDPtr :: (MonadIO m) => Ptr a -> m ()
+pushIDPtr ptr = liftIO do
+  [C.exp| void { PushID($(void * ptr_)) } |]
+  where
+    ptr_ = castPtr ptr
+
+-- | Push string into the ID stack (will hash string).
+--
+-- Wraps @ImGui::PushId@
+pushIDStr :: (MonadIO m) => CString -> m ()
+pushIDStr strId = liftIO do
+  [C.exp| void { PushID($(char * strId)) } |]
+
+-- | Push string into the ID stack (will hash string).
+--
+-- Wraps @ImGui::PushId@
+pushIDStrLen :: (MonadIO m) => CStringLen -> m ()
+pushIDStrLen (strBegin, strLen) = liftIO do
+  [C.exp| void { PushID($(char * strBegin), $(char * strEnd)) } |]
+  where
+    strEnd = plusPtr strBegin strLen
+
+popID :: (MonadIO m) => m ()
+popID = liftIO do
+  [C.exp| void { PopID() } |]
+
+
 wantCaptureMouse :: MonadIO m => m Bool
 wantCaptureMouse = liftIO do
   (0 /=) <$> [C.exp| bool { GetIO().WantCaptureMouse } |]