diff --git a/ChangeLog.md b/ChangeLog.md index e467802..71498f8 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -3,6 +3,7 @@ ## [1.1.0] - `imgui` updated to 1.84.2. +- Added GLFW backend callbacks. ## [1.0.2] diff --git a/dear-imgui.cabal b/dear-imgui.cabal index d49f8d7..49b5650 100644 --- a/dear-imgui.cabal +++ b/dear-imgui.cabal @@ -181,7 +181,8 @@ library exposed-modules: DearImGui.GLFW build-depends: - GLFW-b + GLFW-b, + bindings-GLFW cxx-sources: imgui/backends/imgui_impl_glfw.cpp diff --git a/src/DearImGui/GLFW.hs b/src/DearImGui/GLFW.hs index ee43b3b..a476144 100644 --- a/src/DearImGui/GLFW.hs +++ b/src/DearImGui/GLFW.hs @@ -19,9 +19,33 @@ module DearImGui.GLFW ( -- ** GLFW glfwNewFrame , glfwShutdown + + -- $callbacks + , glfwWindowFocusCallback + , glfwCursorEnterCallback + , glfwMouseButtonCallback + , glfwScrollCallback + , glfwKeyCallback + , glfwCharCallback + , glfwMonitorCallback ) where +-- base +import Foreign + ( Ptr, castPtr ) +import Foreign.C.Types + ( CInt, CDouble, CUInt ) +import Unsafe.Coerce (unsafeCoerce) + +-- bindings-GLFW +import Bindings.GLFW + ( C'GLFWmonitor, C'GLFWwindow ) + +-- GLFW-b +import Graphics.UI.GLFW + ( Monitor, Window ) + -- inline-c import qualified Language.C.Inline as C @@ -44,8 +68,121 @@ glfwNewFrame :: MonadIO m => m () glfwNewFrame = liftIO do [C.exp| void { ImGui_ImplGlfw_NewFrame(); } |] +-- $callbacks +-- == GLFW callbacks +-- * When calling Init with @install_callbacks=true@: +-- GLFW callbacks will be installed for you. +-- They will call user's previously installed callbacks, if any. +-- * When calling Init with @install_callbacks=false@: +-- GLFW callbacks won't be installed. +-- You will need to call those function yourself from your own GLFW callbacks. -- | Wraps @ImGui_ImplGlfw_Shutdown@. glfwShutdown :: MonadIO m => m () glfwShutdown = liftIO do - [C.exp| void { ImGui_ImplGlfw_Shutdown(); } |] \ No newline at end of file + [C.exp| void { ImGui_ImplGlfw_Shutdown(); } |] + +glfwWindowFocusCallback :: MonadIO m => Window -> CInt -> m () +glfwWindowFocusCallback window focused = liftIO do + [C.exp| void { + ImGui_ImplGlfw_WindowFocusCallback( + static_cast( + $(void * windowPtr) + ), + $(int focused) + ); + } |] + where + windowPtr = castPtr $ unWindow window + +glfwCursorEnterCallback :: MonadIO m => Window -> CInt -> m () +glfwCursorEnterCallback window entered = liftIO do + [C.exp| void { + ImGui_ImplGlfw_CursorEnterCallback( + static_cast( + $(void * windowPtr) + ), + $(int entered) + ); + } |] + where + windowPtr = castPtr $ unWindow window + +glfwMouseButtonCallback :: MonadIO m => Window -> CInt -> CInt -> CInt -> m () +glfwMouseButtonCallback window button action mods = liftIO do + [C.exp| void { + ImGui_ImplGlfw_MouseButtonCallback( + static_cast( + $(void * windowPtr) + ), + $(int button), + $(int action), + $(int mods) + ); + } |] + where + windowPtr = castPtr $ unWindow window + +glfwScrollCallback :: MonadIO m => Window -> CDouble -> CDouble -> m () +glfwScrollCallback window xoffset yoffset = liftIO do + [C.exp| void { + ImGui_ImplGlfw_ScrollCallback( + static_cast( + $(void * windowPtr) + ), + $(double xoffset), + $(double yoffset) + ); + } |] + where + windowPtr = castPtr $ unWindow window + +glfwKeyCallback :: MonadIO m => Window -> CInt -> CInt -> CInt -> CInt -> m () +glfwKeyCallback window key scancode action mods = liftIO do + [C.exp| void { + ImGui_ImplGlfw_KeyCallback( + static_cast( + $(void * windowPtr) + ), + $(int key), + $(int scancode), + $(int action), + $(int mods) + ); + } |] + where + windowPtr = castPtr $ unWindow window + +glfwCharCallback :: MonadIO m => Window -> CUInt -> m () +glfwCharCallback window c = liftIO do + [C.exp| void { + ImGui_ImplGlfw_CharCallback( + static_cast( + $(void * windowPtr) + ), + $(unsigned int c) + ); + } |] + where + windowPtr = castPtr $ unWindow window + +glfwMonitorCallback :: MonadIO m => Monitor -> CInt -> m () +glfwMonitorCallback monitor event = liftIO do + [C.exp| void { + ImGui_ImplGlfw_MonitorCallback( + static_cast( + $(void * monitorPtr) + ), + $(int event) + ); + } |] + where + monitorPtr = castPtr $ unMonitor monitor + +-- | Strip the unpublished newtype wrapper. +unWindow :: Window -> Ptr C'GLFWwindow +unWindow = unsafeCoerce + +-- | Strip the unpublished newtype wrapper. +unMonitor :: Monitor -> Ptr C'GLFWmonitor +unMonitor = unsafeCoerce