From 6ccee5234bbf1f255054e5cea1f4f9103dc0435f Mon Sep 17 00:00:00 2001
From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
Date: Fri, 4 Jun 2021 23:18:16 +0300
Subject: [PATCH] Add withFullscreen and related machinery (#55)

- `fullscreenFlags` available for those who want an alternative
  to `withFullscreen` without reinventing too much.
- Raw.begin got `open` and `flags` arguments.
- Added Raw.setNextWindowFullscreen combo block.
---
 src/DearImGui.hs     | 42 ++++++++++++++++++++++++++++++++++++++++--
 src/DearImGui/Raw.hs | 24 +++++++++++++++++++++---
 2 files changed, 61 insertions(+), 5 deletions(-)

diff --git a/src/DearImGui.hs b/src/DearImGui.hs
index 650b872..d2bb0bf 100644
--- a/src/DearImGui.hs
+++ b/src/DearImGui.hs
@@ -43,10 +43,14 @@ module DearImGui
     -- * Windows
   , withWindow
   , withWindowOpen
+  , withFullscreen
+  , fullscreenFlags
+
   , begin
   , Raw.end
   , setNextWindowPos
   , setNextWindowSize
+  , Raw.setNextWindowFullscreen
   , setNextWindowContentSize
   , setNextWindowSizeConstraints
   , setNextWindowCollapsed
@@ -200,6 +204,8 @@ module DearImGui
 import Control.Monad
   ( when )
 import Data.Bool
+import Data.Foldable
+  ( foldl' )
 import Foreign
 import Foreign.C
 
@@ -238,10 +244,11 @@ getVersion = liftIO do
 -- may early out and omit submitting anything to the window. Always call a
 -- matching 'end' for each 'begin' call, regardless of its return value!
 --
--- Wraps @ImGui::Begin()@.
+-- Wraps @ImGui::Begin()@ with default options.
 begin :: MonadIO m => String -> m Bool
 begin name = liftIO do
-  withCString name Raw.begin
+  withCString name \namePtr ->
+    Raw.begin namePtr nullPtr (ImGuiWindowFlags 0)
 
 -- | Append items to a window.
 --
@@ -260,6 +267,37 @@ withWindowOpen :: MonadUnliftIO m => String -> m () -> m ()
 withWindowOpen name action =
   withWindow name (`when` action)
 
+-- | Append items to a fullscreen window.
+--
+-- The action runs inside a window that is set to behave as a backdrop.
+-- It has no typical window decorations, ignores events and does not jump to front.
+--
+-- You may append multiple times to it during the same frame
+-- by calling 'withFullscreen' in multiple places.
+withFullscreen :: MonadUnliftIO m => m () -> m ()
+withFullscreen action = bracket open close (`when` action)
+  where
+    open = liftIO do
+      Raw.setNextWindowFullscreen
+      withCString "FullScreen" \namePtr ->
+        Raw.begin namePtr nullPtr fullscreenFlags
+
+    close = liftIO . const Raw.end
+
+fullscreenFlags :: ImGuiWindowFlags
+fullscreenFlags = foldl' (.|.) zeroBits
+  [ ImGuiWindowFlags_NoBackground
+  , ImGuiWindowFlags_NoBringToFrontOnFocus
+  , ImGuiWindowFlags_NoDecoration
+  , ImGuiWindowFlags_NoFocusOnAppearing
+  , ImGuiWindowFlags_NoMove
+  , ImGuiWindowFlags_NoResize
+  , ImGuiWindowFlags_NoSavedSettings
+  , ImGuiWindowFlags_NoScrollbar
+  , ImGuiWindowFlags_NoScrollWithMouse
+  , ImGuiWindowFlags_NoTitleBar
+  ]
+
 -- | Wraps @ImGui::BeginChild()@.
 beginChild :: MonadIO m => String -> m Bool
 beginChild name = liftIO do
diff --git a/src/DearImGui/Raw.hs b/src/DearImGui/Raw.hs
index 18c5113..a9871cb 100644
--- a/src/DearImGui/Raw.hs
+++ b/src/DearImGui/Raw.hs
@@ -45,6 +45,7 @@ module DearImGui.Raw
   , end
   , setNextWindowPos
   , setNextWindowSize
+  , setNextWindowFullscreen
   , setNextWindowContentSize
   , setNextWindowSizeConstraints
   , setNextWindowCollapsed
@@ -312,9 +313,12 @@ styleColorsClassic = liftIO do
 -- matching 'end' for each 'begin' call, regardless of its return value!
 --
 -- Wraps @ImGui::Begin()@.
-begin :: (MonadIO m) => CString -> m Bool
-begin namePtr = liftIO do
-  (0 /=) <$> [C.exp| bool { Begin($(char* namePtr)) } |]
+--
+-- Passing non-null @Ptr CBool@ shows a window-closing widget in the upper-right corner of the window,
+-- wich clicking will set the boolean to false when clicked.
+begin :: (MonadIO m) => CString -> Ptr CBool -> ImGuiWindowFlags -> m Bool
+begin namePtr openPtr flags = liftIO do
+  (0 /=) <$> [C.exp| bool { Begin($(char* namePtr), $(bool* openPtr), $(ImGuiWindowFlags flags)) } |]
 
 
 -- | Pop window from the stack.
@@ -721,6 +725,20 @@ setNextWindowSize sizePtr cond = liftIO do
   [C.exp| void { SetNextWindowSize(*$(ImVec2* sizePtr), $(ImGuiCond cond)) } |]
 
 
+-- | Set next window size and position to match current display size.
+--
+-- Call before `begin`.
+--
+-- Wraps @ImGui::SetNextWindowPos()@, @ImGui::SetNextWindowSize()@
+setNextWindowFullscreen :: (MonadIO m) => m ()
+setNextWindowFullscreen = liftIO
+  [C.block|
+    void {
+      SetNextWindowPos(ImVec2(0, 0));
+      SetNextWindowSize(GetIO().DisplaySize);
+    }
+  |]
+
 -- | Set next window content size (~ scrollable client area, which enforce the range of scrollbars). Not including window decorations (title bar, menu bar, etc.) nor WindowPadding. call before `begin`
 --
 -- Wraps @ImGui::SetNextWindowContentSize()@