{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module DearImGui.SDL (
sdl2NewFrame
, sdl2Shutdown
, pollEventWithImGui
, pollEventsWithImGui
, dispatchRawEvent
)
where
import Control.Monad
( void, when )
import Foreign.Marshal.Alloc
( alloca )
import Foreign.Ptr
( Ptr, castPtr )
import qualified Language.C.Inline as C
import qualified Language.C.Inline.Cpp as Cpp
import SDL
import SDL.Raw.Enum as Raw
import qualified SDL.Raw.Event as Raw
import qualified SDL.Raw.Types as Raw
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"
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(); } |]
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(); } |]
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
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
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')) } |]
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