Move everything to MonadIO

This commit is contained in:
Ollie Charles 2021-01-24 16:34:36 +00:00
parent aa681fb77d
commit 4f9a552a32

View File

@ -76,9 +76,10 @@ module DearImGui
) )
where where
import Control.Monad ( when )
import Control.Monad.IO.Class ( MonadIO, liftIO )
import Data.Bool import Data.Bool
import Data.StateVar import Data.StateVar
import Control.Monad ( when )
import Foreign import Foreign
import Foreign.C import Foreign.C
import qualified Language.C.Inline as C import qualified Language.C.Inline as C
@ -103,14 +104,14 @@ newtype Context = Context (Ptr ())
-- | Wraps @ImGui::CreateContext()@. -- | Wraps @ImGui::CreateContext()@.
createContext :: IO Context createContext :: MonadIO m => m Context
createContext = createContext = liftIO do
Context <$> [C.exp| void* { CreateContext() } |] Context <$> [C.exp| void* { CreateContext() } |]
-- | Wraps @ImGui::DestroyContext()@. -- | Wraps @ImGui::DestroyContext()@.
destroyContext :: Context -> IO () destroyContext :: MonadIO m => Context -> m ()
destroyContext (Context contextPtr) = destroyContext (Context contextPtr) = liftIO do
[C.exp| void { DestroyContext((ImGuiContext*)$(void* contextPtr)); } |] [C.exp| void { DestroyContext((ImGuiContext*)$(void* contextPtr)); } |]
@ -118,22 +119,25 @@ destroyContext (Context contextPtr) =
-- until 'render'/'endFrame'. -- until 'render'/'endFrame'.
-- --
-- Wraps @ImGui::NewFrame()@. -- Wraps @ImGui::NewFrame()@.
newFrame :: IO () newFrame :: MonadIO m => m ()
newFrame = [C.exp| void { ImGui::NewFrame(); } |] newFrame = liftIO do
[C.exp| void { ImGui::NewFrame(); } |]
-- | Ends the Dear ImGui frame. automatically called by 'render'. If you don't -- | Ends the Dear ImGui frame. automatically called by 'render'. If you don't
-- need to render data (skipping rendering) you may call 'endFrame' without -- need to render data (skipping rendering) you may call 'endFrame' without
-- 'render'... but you'll have wasted CPU already! If you don't need to render, -- 'render'... but you'll have wasted CPU already! If you don't need to render,
-- better to not create any windows and not call 'newFrame' at all! -- better to not create any windows and not call 'newFrame' at all!
endFrame :: IO () endFrame :: MonadIO m => m ()
endFrame = [C.exp| void { ImGui::EndFrame(); } |] endFrame = liftIO do
[C.exp| void { ImGui::EndFrame(); } |]
-- | Ends the Dear ImGui frame, finalize the draw data. You can then get call -- | Ends the Dear ImGui frame, finalize the draw data. You can then get call
-- 'getDrawData'. -- 'getDrawData'.
render :: IO () render :: MonadIO m => m ()
render = [C.exp| void { ImGui::Render(); } |] render = liftIO do
[C.exp| void { ImGui::Render(); } |]
-- | Wraps @ImDrawData*@. -- | Wraps @ImDrawData*@.
@ -142,19 +146,20 @@ newtype DrawData = DrawData (Ptr ())
-- | Valid after 'render' and until the next call to 'newFrame'. This is what -- | Valid after 'render' and until the next call to 'newFrame'. This is what
-- you have to render. -- you have to render.
getDrawData :: IO DrawData getDrawData :: MonadIO m => m DrawData
getDrawData = DrawData <$> [C.exp| void* { ImGui::GetDrawData() } |] getDrawData = liftIO do
DrawData <$> [C.exp| void* { ImGui::GetDrawData() } |]
-- | Wraps @IMGUI_CHECKVERSION()@ -- | Wraps @IMGUI_CHECKVERSION()@
checkVersion :: IO () checkVersion :: MonadIO m => m ()
checkVersion = checkVersion = liftIO do
[C.exp| void { IMGUI_CHECKVERSION(); } |] [C.exp| void { IMGUI_CHECKVERSION(); } |]
-- | Wraps @ImGui_ImplSDL2_InitForOpenGL@. -- | Wraps @ImGui_ImplSDL2_InitForOpenGL@.
sdl2InitForOpenGL :: Window -> GLContext -> IO () sdl2InitForOpenGL :: MonadIO m => Window -> GLContext -> m ()
sdl2InitForOpenGL (Window windowPtr) glContext = sdl2InitForOpenGL (Window windowPtr) glContext = liftIO do
[C.exp| void { ImGui_ImplSDL2_InitForOpenGL((SDL_Window*)$(void* windowPtr), $(void* glContextPtr)); } |] [C.exp| void { ImGui_ImplSDL2_InitForOpenGL((SDL_Window*)$(void* windowPtr), $(void* glContextPtr)); } |]
where where
glContextPtr :: Ptr () glContextPtr :: Ptr ()
@ -162,20 +167,22 @@ sdl2InitForOpenGL (Window windowPtr) glContext =
-- | Wraps @ImGui_ImplSDL2_NewFrame@. -- | Wraps @ImGui_ImplSDL2_NewFrame@.
sdl2NewFrame :: Window -> IO () sdl2NewFrame :: MonadIO m => Window -> m ()
sdl2NewFrame (Window windowPtr) = sdl2NewFrame (Window windowPtr) = liftIO do
[C.exp| void { ImGui_ImplSDL2_NewFrame((SDL_Window*)($(void* windowPtr))); } |] [C.exp| void { ImGui_ImplSDL2_NewFrame((SDL_Window*)($(void* windowPtr))); } |]
-- | Wraps @ImGui_ImplSDL2_Shutdown@. -- | Wraps @ImGui_ImplSDL2_Shutdown@.
sdl2Shutdown :: IO () sdl2Shutdown :: MonadIO m => m ()
sdl2Shutdown = [C.exp| void { ImGui_ImplSDL2_Shutdown(); } |] sdl2Shutdown = liftIO do
[C.exp| void { ImGui_ImplSDL2_Shutdown(); } |]
-- | Call the SDL2 'pollEvent' function, while also dispatching the event to -- | Call the SDL2 'pollEvent' function, while also dispatching the event to
-- Dear ImGui. You should use this in your application instead of 'pollEvent'. -- Dear ImGui. You should use this in your application instead of 'pollEvent'.
pollEventWithImGui :: IO (Maybe Event) pollEventWithImGui :: MonadIO m => m (Maybe Event)
pollEventWithImGui = alloca \evPtr -> do pollEventWithImGui = liftIO do
alloca \evPtr -> do
pumpEvents pumpEvents
-- We use NULL first to check if there's an event. -- We use NULL first to check if there's an event.
@ -189,74 +196,86 @@ pollEventWithImGui = alloca \evPtr -> do
-- | Wraps @ImGui_ImplOpenGL2_Init@. -- | Wraps @ImGui_ImplOpenGL2_Init@.
openGL2Init :: IO () openGL2Init :: MonadIO m => m ()
openGL2Init = [C.exp| void { ImGui_ImplOpenGL2_Init(); } |] openGL2Init = liftIO do
[C.exp| void { ImGui_ImplOpenGL2_Init(); } |]
-- | Wraps @ImGui_ImplOpenGL2_Shutdown@. -- | Wraps @ImGui_ImplOpenGL2_Shutdown@.
openGL2Shutdown :: IO () openGL2Shutdown :: MonadIO m => m ()
openGL2Shutdown = [C.exp| void { ImGui_ImplOpenGL2_Shutdown(); } |] openGL2Shutdown = liftIO do
[C.exp| void { ImGui_ImplOpenGL2_Shutdown(); } |]
-- | Wraps @ImGui_ImplOpenGL2_NewFrame@. -- | Wraps @ImGui_ImplOpenGL2_NewFrame@.
openGL2NewFrame :: IO () openGL2NewFrame :: MonadIO m => m ()
openGL2NewFrame = [C.exp| void { ImGui_ImplOpenGL2_NewFrame(); } |] openGL2NewFrame = liftIO do
[C.exp| void { ImGui_ImplOpenGL2_NewFrame(); } |]
-- | Wraps @ImGui_ImplOpenGL2_RenderDrawData@. -- | Wraps @ImGui_ImplOpenGL2_RenderDrawData@.
openGL2RenderDrawData :: DrawData -> IO () openGL2RenderDrawData :: MonadIO m => DrawData -> m ()
openGL2RenderDrawData (DrawData ptr) = [C.exp| void { ImGui_ImplOpenGL2_RenderDrawData((ImDrawData*) $( void* ptr )) } |] openGL2RenderDrawData (DrawData ptr) = liftIO do
[C.exp| void { ImGui_ImplOpenGL2_RenderDrawData((ImDrawData*) $( void* ptr )) } |]
-- | Create demo window. Demonstrate most ImGui features. Call this to learn -- | Create demo window. Demonstrate most ImGui features. Call this to learn
-- about the library! Try to make it always available in your application! -- about the library! Try to make it always available in your application!
showDemoWindow :: IO () showDemoWindow :: MonadIO m => m ()
showDemoWindow = [C.exp| void { ImGui::ShowDemoWindow(); } |] showDemoWindow = liftIO do
[C.exp| void { ImGui::ShowDemoWindow(); } |]
-- | Create Metrics/Debugger window. Display Dear ImGui internals: windows, draw -- | Create Metrics/Debugger window. Display Dear ImGui internals: windows, draw
-- commands, various internal state, etc. -- commands, various internal state, etc.
showMetricsWindow :: IO () showMetricsWindow :: MonadIO m => m ()
showMetricsWindow = [C.exp| void { ImGui::ShowMetricsWindow(); } |] showMetricsWindow = liftIO do
[C.exp| void { ImGui::ShowMetricsWindow(); } |]
-- | Create About window. display Dear ImGui version, credits and build/system -- | Create About window. display Dear ImGui version, credits and build/system
-- information. -- information.
showAboutWindow :: IO () showAboutWindow :: MonadIO m => m ()
showAboutWindow = [C.exp| void { ShowAboutWindow(); } |] showAboutWindow = liftIO do
[C.exp| void { ShowAboutWindow(); } |]
-- | Add basic help/info block (not a window): how to manipulate ImGui as a -- | Add basic help/info block (not a window): how to manipulate ImGui as a
-- end-user (mouse/keyboard controls). -- end-user (mouse/keyboard controls).
showUserGuide :: IO () showUserGuide :: MonadIO m => m ()
showUserGuide = [C.exp| void { ShowUserGuide() } |] showUserGuide = liftIO do
[C.exp| void { ShowUserGuide() } |]
-- | Get the compiled version string e.g. "1.80 WIP" (essentially the value for -- | Get the compiled version string e.g. "1.80 WIP" (essentially the value for
-- @IMGUI_VERSION@ from the compiled version of @imgui.cpp@). -- @IMGUI_VERSION@ from the compiled version of @imgui.cpp@).
getVersion :: IO String getVersion :: MonadIO m => m String
getVersion = peekCString =<< [C.exp| const char* { GetVersion() } |] getVersion = liftIO do
peekCString =<< [C.exp| const char* { GetVersion() } |]
-- | New, recommended style (default). -- | New, recommended style (default).
-- --
-- Wraps @ImGui::StyleColorsDark()@. -- Wraps @ImGui::StyleColorsDark()@.
styleColorsDark :: IO () styleColorsDark :: MonadIO m => m ()
styleColorsDark = [C.exp| void { StyleColorsDark(); } |] styleColorsDark = liftIO do
[C.exp| void { StyleColorsDark(); } |]
-- | Best used with borders and a custom, thicker font. -- | Best used with borders and a custom, thicker font.
-- --
-- Wraps @ImGui::StyleColorsLight()@. -- Wraps @ImGui::StyleColorsLight()@.
styleColorsLight :: IO () styleColorsLight :: MonadIO m => m ()
styleColorsLight = [C.exp| void { StyleColorsLight(); } |] styleColorsLight = liftIO do
[C.exp| void { StyleColorsLight(); } |]
-- | Classic ImGui style. -- | Classic ImGui style.
-- --
-- Wraps @ImGui::StyleColorsClasic()@. -- Wraps @ImGui::StyleColorsClasic()@.
styleColorsClassic :: IO () styleColorsClassic :: MonadIO m => m ()
styleColorsClassic = [C.exp| void { StyleColorsClassic(); } |] styleColorsClassic = liftIO do
[C.exp| void { StyleColorsClassic(); } |]
-- | Push window to the stack and start appending to it. -- | Push window to the stack and start appending to it.
@ -266,53 +285,59 @@ styleColorsClassic = [C.exp| void { StyleColorsClassic(); } |]
-- matching 'end' for each 'begin' call, regardless of its return value! -- matching 'end' for each 'begin' call, regardless of its return value!
-- --
-- Wraps @ImGui::Begin()@. -- Wraps @ImGui::Begin()@.
begin :: String -> IO Bool begin :: MonadIO m => String -> m Bool
begin name = withCString name \namePtr -> begin name = liftIO do
withCString name \namePtr ->
(1 ==) <$> [C.exp| bool { ImGui::Begin($(char* namePtr)) } |] (1 ==) <$> [C.exp| bool { ImGui::Begin($(char* namePtr)) } |]
-- | Pop window from the stack. -- | Pop window from the stack.
-- --
-- Wraps @ImGui::End()@. -- Wraps @ImGui::End()@.
end :: IO () end :: MonadIO m => m ()
end = [C.exp| void { ImGui::End(); } |] end = liftIO do
[C.exp| void { ImGui::End(); } |]
-- | Formatted text. -- | Formatted text.
-- --
-- Wraps @ImGui::Text()@. -- Wraps @ImGui::Text()@.
text :: String -> IO () text :: MonadIO m => String -> m ()
text t = withCString t \textPtr -> text t = liftIO do
withCString t \textPtr ->
[C.exp| void { Text($(char* textPtr)) } |] [C.exp| void { Text($(char* textPtr)) } |]
-- | A button. Returns 'True' when clicked. -- | A button. Returns 'True' when clicked.
-- --
-- Wraps @ImGui::Button()@. -- Wraps @ImGui::Button()@.
button :: String -> IO Bool button :: MonadIO m => String -> m Bool
button label = withCString label \labelPtr -> button label = liftIO do
withCString label \labelPtr ->
(1 ==) <$> [C.exp| bool { Button($(char* labelPtr)) } |] (1 ==) <$> [C.exp| bool { Button($(char* labelPtr)) } |]
-- | Button with @FramePadding=(0,0)@ to easily embed within text. -- | Button with @FramePadding=(0,0)@ to easily embed within text.
-- --
-- Wraps @ImGui::SmallButton()@. -- Wraps @ImGui::SmallButton()@.
smallButton :: String -> IO Bool smallButton :: MonadIO m => String -> m Bool
smallButton label = withCString label \labelPtr -> smallButton label = liftIO do
withCString label \labelPtr ->
(1 ==) <$> [C.exp| bool { SmallButton($(char* labelPtr)) } |] (1 ==) <$> [C.exp| bool { SmallButton($(char* labelPtr)) } |]
-- | Square button with an arrow shape. -- | Square button with an arrow shape.
-- --
-- Wraps @ImGui::ArrowButton()@. -- Wraps @ImGui::ArrowButton()@.
arrowButton :: String -> ImGuiDir -> IO Bool arrowButton :: MonadIO m => String -> ImGuiDir -> m Bool
arrowButton strId (ImGuiDir dir) = withCString strId \strIdPtr -> arrowButton strId (ImGuiDir dir) = liftIO do
withCString strId \strIdPtr ->
(1 ==) <$> [C.exp| bool { ArrowButton($(char* strIdPtr), $(int dir)) } |] (1 ==) <$> [C.exp| bool { ArrowButton($(char* strIdPtr), $(int dir)) } |]
-- | Wraps @ImGui::Checkbox()@. -- | Wraps @ImGui::Checkbox()@.
checkbox :: (HasSetter ref Bool, HasGetter ref Bool) => String -> ref -> IO Bool checkbox :: (HasSetter ref Bool, HasGetter ref Bool, MonadIO m) => String -> ref -> m Bool
checkbox label ref = do checkbox label ref = liftIO do
currentValue <- get ref currentValue <- get ref
with (bool 0 1 currentValue :: CBool) \boolPtr -> do with (bool 0 1 currentValue :: CBool) \boolPtr -> do
changed <- withCString label \labelPtr -> changed <- withCString label \labelPtr ->
@ -324,8 +349,9 @@ checkbox label ref = do
return changed return changed
progressBar :: Float -> Maybe String -> IO () progressBar :: MonadIO m => Float -> Maybe String -> m ()
progressBar progress overlay = withCStringOrNull overlay \overlayPtr -> progressBar progress overlay = liftIO do
withCStringOrNull overlay \overlayPtr ->
[C.exp| void { ProgressBar($(float c'progress), ImVec2(-FLT_MIN, 0), $(char* overlayPtr)) } |] [C.exp| void { ProgressBar($(float c'progress), ImVec2(-FLT_MIN, 0), $(char* overlayPtr)) } |]
where where
c'progress :: CFloat c'progress :: CFloat
@ -334,8 +360,9 @@ progressBar progress overlay = withCStringOrNull overlay \overlayPtr ->
-- | Draw a small circle + keep the cursor on the same line. Advance cursor x -- | Draw a small circle + keep the cursor on the same line. Advance cursor x
-- position by 'getTreeNodeToLabelSpacing', same distance that 'treeNode' uses. -- position by 'getTreeNodeToLabelSpacing', same distance that 'treeNode' uses.
bullet :: IO () bullet :: MonadIO m => m ()
bullet = [C.exp| void { Bullet() } |] bullet = liftIO do
[C.exp| void { Bullet() } |]
-- | Begin creating a combo box with a given label and preview value. -- | Begin creating a combo box with a given label and preview value.
@ -344,8 +371,8 @@ bullet = [C.exp| void { Bullet() } |]
-- the contents of the combo box - for example, by calling 'selectable'. -- the contents of the combo box - for example, by calling 'selectable'.
-- --
-- Wraps @ImGui::BeginCombo()@. -- Wraps @ImGui::BeginCombo()@.
beginCombo :: String -> String -> IO Bool beginCombo :: MonadIO m => String -> String -> m Bool
beginCombo label previewValue = beginCombo label previewValue = liftIO $
withCString label \labelPtr -> withCString label \labelPtr ->
withCString previewValue \previewValuePtr -> withCString previewValue \previewValuePtr ->
(1 ==) <$> [C.exp| bool { BeginCombo($(char* labelPtr), $(char* previewValuePtr)) } |] (1 ==) <$> [C.exp| bool { BeginCombo($(char* labelPtr), $(char* previewValuePtr)) } |]
@ -354,13 +381,15 @@ beginCombo label previewValue =
-- | Only call 'endCombo' if 'beginCombon' returns 'True'! -- | Only call 'endCombo' if 'beginCombon' returns 'True'!
-- --
-- Wraps @ImGui::EndCombo()@. -- Wraps @ImGui::EndCombo()@.
endCombo :: IO () endCombo :: MonadIO m => m ()
endCombo = [C.exp| void { EndCombo() } |] endCombo = liftIO do
[C.exp| void { EndCombo() } |]
-- | Wraps @ImGui::Selectable()@. -- | Wraps @ImGui::Selectable()@.
selectable :: String -> IO Bool selectable :: MonadIO m => String -> m Bool
selectable label = withCString label \labelPtr -> selectable label = liftIO do
withCString label \labelPtr ->
(1 == ) <$> [C.exp| bool { Selectable($(char* labelPtr)) } |] (1 == ) <$> [C.exp| bool { Selectable($(char* labelPtr)) } |]