{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

{-|
Module: DearImGui.SDL

SDL2 specific functions backend for Dear ImGui.

Modules for initialising a backend with SDL2 can be found under the corresponding backend,
e.g. "DearImGui.SDL.OpenGL".
-}

module DearImGui.SDL (
    -- ** SDL2
    sdl2NewFrame
  , sdl2Shutdown
  , pollEventWithImGui
  , pollEventsWithImGui
    -- *** Raw
  , dispatchRawEvent
  )
  where

-- base
import Control.Monad
  ( void, when )
import Foreign.Marshal.Alloc
  ( alloca )
import Foreign.Ptr
  ( Ptr, castPtr )

-- inline-c
import qualified Language.C.Inline as C

-- inline-c-cpp
import qualified Language.C.Inline.Cpp as Cpp

-- sdl2
import SDL
import SDL.Raw.Enum as Raw
import qualified SDL.Raw.Event as Raw
import qualified SDL.Raw.Types as Raw

-- transformers
import Control.Monad.IO.Class
  ( MonadIO, liftIO )


C.context (Cpp.cppCtx <> C.bsCtx)
C.include "imgui.h"
C.include "backends/imgui_impl_sdl2.h"
C.include "SDL.h"
Cpp.using "namespace ImGui"


-- | Wraps @ImGui_ImplSDL2_NewFrame@.
sdl2NewFrame :: MonadIO m => m ()
sdl2NewFrame :: forall (m :: * -> *). MonadIO m => m ()
sdl2NewFrame = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  IO ()
[C.exp| void { ImGui_ImplSDL2_NewFrame(); } |]


-- | Wraps @ImGui_ImplSDL2_Shutdown@.
sdl2Shutdown :: MonadIO m => m ()
sdl2Shutdown :: forall (m :: * -> *). MonadIO m => m ()
sdl2Shutdown = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  IO ()
[C.exp| void { ImGui_ImplSDL2_Shutdown(); } |]

-- | Call the SDL2 'pollEvent' function, while also dispatching the event to
-- Dear ImGui. You should use this in your application instead of 'pollEvent'.
pollEventWithImGui :: MonadIO m => m (Maybe Event)
pollEventWithImGui :: forall (m :: * -> *). MonadIO m => m (Maybe Event)
pollEventWithImGui = IO (Maybe Event) -> m (Maybe Event)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  (Ptr Event -> IO (Maybe Event)) -> IO (Maybe Event)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr Event
evPtr -> do
    IO ()
forall (m :: * -> *). MonadIO m => m ()
pumpEvents

    -- We use NULL first to check if there's an event.
    CInt
nEvents <- Ptr Event -> CInt -> Word32 -> Word32 -> Word32 -> IO CInt
forall (m :: * -> *).
MonadIO m =>
Ptr Event -> CInt -> Word32 -> Word32 -> Word32 -> m CInt
Raw.peepEvents Ptr Event
evPtr CInt
1 Word32
Raw.SDL_PEEKEVENT Word32
forall {a}. (Eq a, Num a) => a
Raw.SDL_FIRSTEVENT Word32
forall {a}. (Eq a, Num a) => a
Raw.SDL_LASTEVENT

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
nEvents CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0) do
      IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Event -> IO Bool
forall (m :: * -> *). MonadIO m => Ptr Event -> m Bool
dispatchRawEvent Ptr Event
evPtr

    IO (Maybe Event)
forall (m :: * -> *). MonadIO m => m (Maybe Event)
pollEvent

-- | Dispatch a raw 'Raw.Event' value to Dear ImGui.
--
-- You may want this function instead of 'pollEventWithImGui' if you do not use
-- @sdl2@'s higher-level 'Event' type (e.g. your application has its own polling
-- mechanism).
--
-- __It is your application's responsibility to both manage the input__
-- __pointer's memory and to fill the memory location with a raw 'Raw.Event'__
-- __value.__
dispatchRawEvent :: MonadIO m => Ptr Raw.Event -> m Bool
dispatchRawEvent :: forall (m :: * -> *). MonadIO m => Ptr Event -> m Bool
dispatchRawEvent Ptr Event
evPtr = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  let evPtr' :: Ptr ()
evPtr' = Ptr Event -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Event
evPtr :: Ptr ()
  (CBool
0 CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
/=) (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [C.exp| bool { ImGui_ImplSDL2_ProcessEvent((const SDL_Event*) $(void* evPtr')) } |]

-- | Like the SDL2 'pollEvents' function, while also dispatching the events to
-- Dear ImGui. See 'pollEventWithImGui'.
pollEventsWithImGui :: MonadIO m => m [Event]
pollEventsWithImGui :: forall (m :: * -> *). MonadIO m => m [Event]
pollEventsWithImGui = do
  Maybe Event
e <- m (Maybe Event)
forall (m :: * -> *). MonadIO m => m (Maybe Event)
pollEventWithImGui
  case Maybe Event
e of
    Maybe Event
Nothing -> [Event] -> m [Event]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just Event
e' -> ( Event
e' Event -> [Event] -> [Event]
forall a. a -> [a] -> [a]
: ) ([Event] -> [Event]) -> m [Event] -> m [Event]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Event]
forall (m :: * -> *). MonadIO m => m [Event]
pollEventsWithImGui