{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Reflex.SDL2
(
host
, ReflexSDL2
, ReflexSDL2T
, ConcreteReflexSDL2
, holdView
, dynView
,
getDeltaTickEvent
, performEventDelta
, getRecurringTimerEventWithEventCode
, getAsyncEventWithEventCode
, delayEventWithEventCode
, userLocal
, putDebugLnE
, getTicksEvent
, getAnySDLEvent
, getWindowShownEvent
, getWindowHiddenEvent
, getWindowExposedEvent
, getWindowMovedEvent
, getWindowResizedEvent
, getWindowSizeChangedEvent
, getWindowMinimizedEvent
, getWindowMaximizedEvent
, getWindowRestoredEvent
, getWindowGainedMouseFocusEvent
, getWindowLostMouseFocusEvent
, getWindowGainedKeyboardFocusEvent
, getWindowLostKeyboardFocusEvent
, getWindowClosedEvent
, getKeyboardEvent
, getTextEditingEvent
, getTextInputEvent
, getKeymapChangedEvent
, getMouseMotionEvent
, getMouseButtonEvent
, getMouseWheelEvent
, getJoyAxisEvent
, getJoyBallEvent
, getJoyHatEvent
, getJoyButtonEvent
, getJoyDeviceEvent
, getControllerAxisEvent
, getControllerButtonEvent
, getControllerDeviceEvent
, getAudioDeviceEvent
, getQuitEvent
, getUserEvent
, getSysWMEvent
, getTouchFingerEvent
, getMultiGestureEvent
, getDollarGestureEvent
, getDropEvent
, getClipboardUpdateEvent
, getUnknownEvent
, getUserData
, module Reflex
, module SDL
, MonadIO
, liftIO
) where
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (async)
import Control.Monad (forM_, void)
import Control.Monad.Exception (MonadException)
import Control.Monad.Fix (MonadFix)
import Control.Monad.Identity (Identity (..))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Reader
import Control.Monad.Ref (readRef)
import Data.Dependent.Sum (DSum ((:=>)))
import Data.Function (fix)
import Data.Int (Int32)
import Data.Word (Word32)
import Foreign.Marshal.Alloc (malloc, free)
import Foreign.Ptr (castPtr, Ptr)
import Foreign.Storable (Storable (..))
import Reflex hiding (Additive)
import Reflex.Host.Class
import SDL hiding (Event)
import Reflex.SDL2.Internal
type ReflexSDL2 r t m =
( Reflex t
, MonadHold t m
, MonadSample t m
, MonadAdjust t m
, PostBuild t m
, PerformEvent t m
, MonadFix m
, MonadIO m
, MonadIO (Performable m)
, MonadReader (SystemEvents r t) m
)
userLocal :: MonadReader (SystemEvents r t) m => (r -> r) -> m a -> m a
userLocal f = local (\se -> se{sysUserData = f $ sysUserData se})
newtype ReflexSDL2T r t (m :: * -> *) a =
ReflexSDL2T { runReflexSDL2T :: ReaderT (SystemEvents r t) m a }
deriving instance (ReflexHost t, Functor m) => Functor (ReflexSDL2T r t m)
deriving instance (ReflexHost t, Applicative m) => Applicative (ReflexSDL2T r t m)
deriving instance (ReflexHost t, Monad m) => Monad (ReflexSDL2T r t m)
deriving instance (ReflexHost t, MonadFix m) => MonadFix (ReflexSDL2T r t m)
deriving instance (ReflexHost t, Monad m) => MonadReader (SystemEvents r t) (ReflexSDL2T r t m)
deriving instance (ReflexHost t, MonadIO m) => MonadIO (ReflexSDL2T r t m)
deriving instance ReflexHost t => MonadTrans (ReflexSDL2T r t)
deriving instance (ReflexHost t, MonadException m) => MonadException (ReflexSDL2T r t m)
instance (Reflex t, PostBuild t m, ReflexHost t, Monad m) => PostBuild t (ReflexSDL2T r t m) where
getPostBuild = lift getPostBuild
instance (ReflexHost t, PerformEvent t m) => PerformEvent t (ReflexSDL2T r t m) where
type Performable (ReflexSDL2T r t m) = ReflexSDL2T r t (Performable m)
performEvent_ = ReflexSDL2T . performEvent_ . fmap runReflexSDL2T
performEvent = ReflexSDL2T . performEvent . fmap runReflexSDL2T
instance ( Reflex t
, ReflexHost t
, MonadAdjust t m
, Monad m
) => MonadAdjust t (ReflexSDL2T r t m) where
runWithReplace ma evmb =
ReflexSDL2T $ runWithReplace (runReflexSDL2T ma) (runReflexSDL2T <$> evmb)
traverseDMapWithKeyWithAdjust kvma dMapKV = ReflexSDL2T .
traverseDMapWithKeyWithAdjust (\ka -> runReflexSDL2T . kvma ka) dMapKV
traverseDMapWithKeyWithAdjustWithMove kvma dMapKV = ReflexSDL2T .
traverseDMapWithKeyWithAdjustWithMove (\ka -> runReflexSDL2T . kvma ka) dMapKV
instance ( ReflexHost t
, Applicative m
, Monad m
, MonadSample t m
) => MonadSample t (ReflexSDL2T r t m) where
sample = lift . sample
instance (ReflexHost t, MonadHold t m) => MonadHold t (ReflexSDL2T r t m) where
hold a = lift . hold a
holdDyn a = lift . holdDyn a
holdIncremental p = lift . holdIncremental p
buildDynamic ma = lift . buildDynamic ma
data TimerData = TimerData Int32 Timestamp
toTimerData :: Int32 -> RegisteredEventData -> Timestamp -> IO (Maybe TimerData)
toTimerData eventCode rdat ts
| eventCode == registeredEventCode rdat =
return $ Just $ TimerData eventCode ts
| otherwise = return Nothing
fromTimerData :: TimerData -> IO RegisteredEventData
fromTimerData (TimerData code _) =
return $ emptyRegisteredEvent{ registeredEventCode = code }
getRecurringTimerEventWithEventCode
:: ReflexSDL2 r t m
=> Int32
-> Int
-> m (Event t ())
getRecurringTimerEventWithEventCode eventCode n = do
let toData = toTimerData eventCode
registerEvent toData fromTimerData >>= \case
Nothing -> return ()
Just (RegisteredEventType pushIt _) -> liftIO $ void $ async $ fix $ \loop -> do
threadDelay $ n * 1000
ts <- ticks
pushIt (TimerData eventCode ts) >>= \case
EventPushSuccess -> return ()
EventPushFiltered -> putStrLn "timer push filtered"
EventPushFailure t -> print t
loop
evUser <- getUserEvent
return $ fmapMaybe (guard . (eventCode ==) . userEventCode) evUser
getDeltaTickEvent :: ReflexSDL2 r t m => m (Event t Word32)
getDeltaTickEvent = do
let f (lastTick, _) thisTick = (thisTick, thisTick - lastTick)
evTickAndDel <- accum f (0, 0) =<< asks sysTicksEvent
return $ snd <$> evTickAndDel
performEventDelta :: ReflexSDL2 r t m => Event t a -> m (Event t Word32)
performEventDelta ev = do
tnow <- ticks
evTicks <- performEvent $ ticks <$ ev
fmap fst <$> accum (\(_, prev) now -> (now - prev, now)) (0, tnow) evTicks
readAndFreePtr :: Storable a => Ptr () -> IO a
readAndFreePtr ptr = do
a <- peek $ castPtr ptr
free ptr
return a
registerAndPushAsync :: (MonadIO m, Storable a) => Int32 -> IO a -> m ()
registerAndPushAsync eventCode action = do
let toData rdat _
| eventCode == registeredEventCode rdat =
Just <$> readAndFreePtr (registeredEventData1 rdat)
| otherwise = return Nothing
fromData a = do
ptr <- malloc
poke ptr a
return $ emptyRegisteredEvent{ registeredEventCode = eventCode
, registeredEventData1 = castPtr ptr
}
registerEvent toData fromData >>= \case
Nothing -> return ()
Just (RegisteredEventType pushIt _) -> liftIO $ void $ async $ do
a <- action
pushIt a >>= \case
EventPushSuccess -> return ()
EventPushFiltered -> putStrLn "async push filtered"
EventPushFailure t -> print t
getStorableUserEventWithEventCode
:: (ReflexSDL2 r t m, Storable a) => Int32 -> m (Event t a)
getStorableUserEventWithEventCode code = do
evUser <- getUserEvent
let evUserFilt = fmapMaybe (\udat -> udat <$ guard (code == userEventCode udat))
evUser
performEvent $ liftIO . readAndFreePtr . userEventData1 <$> evUserFilt
getAsyncEventWithEventCode
:: (ReflexSDL2 r t m, Storable a) => Int32 -> IO a -> m (Event t a)
getAsyncEventWithEventCode eventCode action = do
registerAndPushAsync eventCode action
getStorableUserEventWithEventCode eventCode
delayEventWithEventCode
:: (ReflexSDL2 r t m, Storable a) => Int32 -> Int -> Event t a -> m (Event t a)
delayEventWithEventCode code millis ev = do
performEvent_ $ ffor ev $ \a ->
registerAndPushAsync code $ threadDelay (millis * 1000) >> return a
getStorableUserEventWithEventCode code
getTicksEvent :: ReflexSDL2 r t m => m (Event t Word32)
getTicksEvent = asks sysTicksEvent
getAnySDLEvent :: ReflexSDL2 r t m => m (Event t EventPayload)
getAnySDLEvent = asks sysAnySDLEvent
getWindowShownEvent :: ReflexSDL2 r t m => m (Event t WindowShownEventData)
getWindowShownEvent = asks sysWindowShownEvent
getWindowHiddenEvent :: ReflexSDL2 r t m => m (Event t WindowHiddenEventData)
getWindowHiddenEvent = asks sysWindowHiddenEvent
getWindowExposedEvent :: ReflexSDL2 r t m => m (Event t WindowExposedEventData)
getWindowExposedEvent = asks sysWindowExposedEvent
getWindowMovedEvent :: ReflexSDL2 r t m => m (Event t WindowMovedEventData)
getWindowMovedEvent = asks sysWindowMovedEvent
getWindowResizedEvent :: ReflexSDL2 r t m => m (Event t WindowResizedEventData)
getWindowResizedEvent = asks sysWindowResizedEvent
getWindowSizeChangedEvent :: ReflexSDL2 r t m => m (Event t WindowSizeChangedEventData)
getWindowSizeChangedEvent = asks sysWindowSizeChangedEvent
getWindowMinimizedEvent :: ReflexSDL2 r t m => m (Event t WindowMinimizedEventData)
getWindowMinimizedEvent = asks sysWindowMinimizedEvent
getWindowMaximizedEvent :: ReflexSDL2 r t m => m (Event t WindowMaximizedEventData)
getWindowMaximizedEvent = asks sysWindowMaximizedEvent
getWindowRestoredEvent :: ReflexSDL2 r t m => m (Event t WindowRestoredEventData)
getWindowRestoredEvent = asks sysWindowRestoredEvent
getWindowGainedMouseFocusEvent :: ReflexSDL2 r t m => m (Event t WindowGainedMouseFocusEventData)
getWindowGainedMouseFocusEvent = asks sysWindowGainedMouseFocusEvent
getWindowLostMouseFocusEvent :: ReflexSDL2 r t m => m (Event t WindowLostMouseFocusEventData)
getWindowLostMouseFocusEvent = asks sysWindowLostMouseFocusEvent
getWindowGainedKeyboardFocusEvent :: ReflexSDL2 r t m => m (Event t WindowGainedKeyboardFocusEventData)
getWindowGainedKeyboardFocusEvent = asks sysWindowGainedKeyboardFocusEvent
getWindowLostKeyboardFocusEvent :: ReflexSDL2 r t m => m (Event t WindowLostKeyboardFocusEventData)
getWindowLostKeyboardFocusEvent = asks sysWindowLostKeyboardFocusEvent
getWindowClosedEvent :: ReflexSDL2 r t m => m (Event t WindowClosedEventData)
getWindowClosedEvent = asks sysWindowClosedEvent
getKeyboardEvent :: ReflexSDL2 r t m => m (Event t KeyboardEventData)
getKeyboardEvent = asks sysKeyboardEvent
getTextEditingEvent :: ReflexSDL2 r t m => m (Event t TextEditingEventData)
getTextEditingEvent = asks sysTextEditingEvent
getTextInputEvent :: ReflexSDL2 r t m => m (Event t TextInputEventData)
getTextInputEvent = asks sysTextInputEvent
getKeymapChangedEvent :: ReflexSDL2 r t m => m (Event t ())
getKeymapChangedEvent = asks sysKeymapChangedEvent
getMouseMotionEvent :: ReflexSDL2 r t m => m (Event t MouseMotionEventData)
getMouseMotionEvent = asks sysMouseMotionEvent
getMouseButtonEvent :: ReflexSDL2 r t m => m (Event t MouseButtonEventData)
getMouseButtonEvent = asks sysMouseButtonEvent
getMouseWheelEvent :: ReflexSDL2 r t m => m (Event t MouseWheelEventData)
getMouseWheelEvent = asks sysMouseWheelEvent
getJoyAxisEvent :: ReflexSDL2 r t m => m (Event t JoyAxisEventData)
getJoyAxisEvent = asks sysJoyAxisEvent
getJoyBallEvent :: ReflexSDL2 r t m => m (Event t JoyBallEventData)
getJoyBallEvent = asks sysJoyBallEvent
getJoyHatEvent :: ReflexSDL2 r t m => m (Event t JoyHatEventData)
getJoyHatEvent = asks sysJoyHatEvent
getJoyButtonEvent :: ReflexSDL2 r t m => m (Event t JoyButtonEventData)
getJoyButtonEvent = asks sysJoyButtonEvent
getJoyDeviceEvent :: ReflexSDL2 r t m => m (Event t JoyDeviceEventData)
getJoyDeviceEvent = asks sysJoyDeviceEvent
getControllerAxisEvent :: ReflexSDL2 r t m => m (Event t ControllerAxisEventData)
getControllerAxisEvent = asks sysControllerAxisEvent
getControllerButtonEvent :: ReflexSDL2 r t m => m (Event t ControllerButtonEventData)
getControllerButtonEvent = asks sysControllerButtonEvent
getControllerDeviceEvent :: ReflexSDL2 r t m => m (Event t ControllerDeviceEventData)
getControllerDeviceEvent = asks sysControllerDeviceEvent
getAudioDeviceEvent :: ReflexSDL2 r t m => m (Event t AudioDeviceEventData)
getAudioDeviceEvent = asks sysAudioDeviceEvent
getQuitEvent :: ReflexSDL2 r t m => m (Event t ())
getQuitEvent = asks sysQuitEvent
getUserEvent :: ReflexSDL2 r t m => m (Event t UserEventData)
getUserEvent = asks sysUserEvent
getSysWMEvent :: ReflexSDL2 r t m => m (Event t SysWMEventData)
getSysWMEvent = asks sysSysWMEvent
getTouchFingerEvent :: ReflexSDL2 r t m => m (Event t TouchFingerEventData)
getTouchFingerEvent = asks sysTouchFingerEvent
getMultiGestureEvent :: ReflexSDL2 r t m => m (Event t MultiGestureEventData)
getMultiGestureEvent = asks sysMultiGestureEvent
getDollarGestureEvent :: ReflexSDL2 r t m => m (Event t DollarGestureEventData)
getDollarGestureEvent = asks sysDollarGestureEvent
getDropEvent :: ReflexSDL2 r t m => m (Event t DropEventData)
getDropEvent = asks sysDropEvent
getClipboardUpdateEvent :: ReflexSDL2 r t m => m (Event t ())
getClipboardUpdateEvent = asks sysClipboardUpdateEvent
getUnknownEvent :: ReflexSDL2 r t m => m (Event t UnknownEventData)
getUnknownEvent = asks sysUnknownEvent
getUserData :: ReflexSDL2 r t m => m r
getUserData = asks sysUserData
type ConcreteReflexSDL2 r =
ReflexSDL2T r Spider (PostBuildT Spider (PerformEventT Spider (SpiderHost Global)))
host
:: r
-> ConcreteReflexSDL2 r ()
-> IO void
host sysUserData app = runSpiderHost $ do
(sysPostBuildEvent, trPostBuildRef) <- newEventWithTriggerRef
(sysAnySDLEvent, trAnySDLRef) <- newEventWithTriggerRef
(sysTicksEvent, trTicksRef) <- newEventWithTriggerRef
(sysWindowShownEvent, trWindowShownRef) <- newEventWithTriggerRef
(sysWindowHiddenEvent, trWindowHiddenRef) <- newEventWithTriggerRef
(sysWindowExposedEvent, trWindowExposedRef) <- newEventWithTriggerRef
(sysWindowMovedEvent, trWindowMovedRef) <- newEventWithTriggerRef
(sysWindowResizedEvent, trWindowResizedRef) <- newEventWithTriggerRef
(sysWindowSizeChangedEvent, trWindowSizeChangedRef) <- newEventWithTriggerRef
(sysWindowMinimizedEvent, trWindowMinimizedRef) <- newEventWithTriggerRef
(sysWindowMaximizedEvent, trWindowMaximizedRef) <- newEventWithTriggerRef
(sysWindowRestoredEvent, trWindowRestoredRef) <- newEventWithTriggerRef
(sysWindowGainedMouseFocusEvent, trWindowGainedMouseFocusRef) <- newEventWithTriggerRef
(sysWindowLostMouseFocusEvent, trWindowLostMouseFocusRef) <- newEventWithTriggerRef
(sysWindowGainedKeyboardFocusEvent, trWindowGainedKeyboardFocusRef) <- newEventWithTriggerRef
(sysWindowLostKeyboardFocusEvent, trWindowLostKeyboardFocusRef) <- newEventWithTriggerRef
(sysWindowClosedEvent, trWindowClosedRef) <- newEventWithTriggerRef
(sysKeyboardEvent, trKeyboardRef) <- newEventWithTriggerRef
(sysTextEditingEvent, trTextEditingRef) <- newEventWithTriggerRef
(sysTextInputEvent, trTextInputRef) <- newEventWithTriggerRef
(sysKeymapChangedEvent, trKeymapChangedRef) <- newEventWithTriggerRef
(sysMouseMotionEvent, trMouseMotionRef) <- newEventWithTriggerRef
(sysMouseButtonEvent, trMouseButtonRef) <- newEventWithTriggerRef
(sysMouseWheelEvent, trMouseWheelRef) <- newEventWithTriggerRef
(sysJoyAxisEvent, trJoyAxisRef) <- newEventWithTriggerRef
(sysJoyBallEvent, trJoyBallRef) <- newEventWithTriggerRef
(sysJoyHatEvent, trJoyHatRef) <- newEventWithTriggerRef
(sysJoyButtonEvent, trJoyButtonRef) <- newEventWithTriggerRef
(sysJoyDeviceEvent, trJoyDeviceRef) <- newEventWithTriggerRef
(sysControllerAxisEvent, trControllerAxisRef) <- newEventWithTriggerRef
(sysControllerButtonEvent, trControllerButtonRef) <- newEventWithTriggerRef
(sysControllerDeviceEvent, trControllerDeviceRef) <- newEventWithTriggerRef
(sysAudioDeviceEvent, trAudioDeviceRef) <- newEventWithTriggerRef
(sysQuitEvent, trQuitRef) <- newEventWithTriggerRef
(sysUserEvent, trUserRef) <- newEventWithTriggerRef
(sysSysWMEvent, trSysWMRef) <- newEventWithTriggerRef
(sysTouchFingerEvent, trTouchFingerRef) <- newEventWithTriggerRef
(sysTouchFingerMotionEvent, trTouchFingerMotionRef) <- newEventWithTriggerRef
(sysMultiGestureEvent, trMultiGestureRef) <- newEventWithTriggerRef
(sysDollarGestureEvent, trDollarGestureRef) <- newEventWithTriggerRef
(sysDropEvent, trDropRef) <- newEventWithTriggerRef
(sysClipboardUpdateEvent, trClipboardUpdateRef) <- newEventWithTriggerRef
(sysUnknownEvent, trUnknownRef) <- newEventWithTriggerRef
((), FireCommand fire) <-
hostPerformEventT $
runPostBuildT (runReaderT (runReflexSDL2T app) SystemEvents{..})
sysPostBuildEvent
(readRef trPostBuildRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity ()] $ return ()
fix $ \loop -> do
t <- ticks
shouldWait <- readRef trTicksRef >>= \case
Nothing -> return True
Just tr -> do
void $ fire [tr :=> Identity t] $ return ()
return False
payloads <- map eventPayload <$> if shouldWait
then (:) <$> waitEvent
<*> pollEvents
else pollEvents
forM_ payloads $ \case
WindowShownEvent dat -> (readRef trWindowShownRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
WindowHiddenEvent dat -> (readRef trWindowHiddenRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
WindowExposedEvent dat -> (readRef trWindowExposedRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
WindowMovedEvent dat -> (readRef trWindowMovedRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
WindowResizedEvent dat -> (readRef trWindowResizedRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
WindowSizeChangedEvent dat -> (readRef trWindowSizeChangedRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
WindowMinimizedEvent dat -> (readRef trWindowMinimizedRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
WindowMaximizedEvent dat -> (readRef trWindowMaximizedRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
WindowRestoredEvent dat -> (readRef trWindowRestoredRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
WindowGainedMouseFocusEvent dat -> (readRef trWindowGainedMouseFocusRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
WindowLostMouseFocusEvent dat -> (readRef trWindowLostMouseFocusRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
WindowGainedKeyboardFocusEvent dat -> (readRef trWindowGainedKeyboardFocusRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
WindowLostKeyboardFocusEvent dat -> (readRef trWindowLostKeyboardFocusRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
WindowClosedEvent dat -> (readRef trWindowClosedRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
KeyboardEvent dat -> (readRef trKeyboardRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
TextEditingEvent dat -> (readRef trTextEditingRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
TextInputEvent dat -> (readRef trTextInputRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
KeymapChangedEvent -> (readRef trKeymapChangedRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity ()] $ return ()
MouseMotionEvent dat -> (readRef trMouseMotionRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
MouseButtonEvent dat -> (readRef trMouseButtonRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
MouseWheelEvent dat -> (readRef trMouseWheelRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
JoyAxisEvent dat -> (readRef trJoyAxisRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
JoyBallEvent dat -> (readRef trJoyBallRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
JoyHatEvent dat -> (readRef trJoyHatRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
JoyButtonEvent dat -> (readRef trJoyButtonRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
JoyDeviceEvent dat -> (readRef trJoyDeviceRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
ControllerAxisEvent dat -> (readRef trControllerAxisRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
ControllerButtonEvent dat -> (readRef trControllerButtonRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
ControllerDeviceEvent dat -> (readRef trControllerDeviceRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
AudioDeviceEvent dat -> (readRef trAudioDeviceRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
QuitEvent -> (readRef trQuitRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity ()] $ return ()
UserEvent dat -> (readRef trUserRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
SysWMEvent dat -> (readRef trSysWMRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
TouchFingerEvent dat -> (readRef trTouchFingerRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
TouchFingerMotionEvent dat -> (readRef trTouchFingerMotionRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
MultiGestureEvent dat -> (readRef trMultiGestureRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
DollarGestureEvent dat -> (readRef trDollarGestureRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
DropEvent dat -> (readRef trDropRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
ClipboardUpdateEvent -> (readRef trClipboardUpdateRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity ()] $ return ()
UnknownEvent dat -> (readRef trUnknownRef >>=) . mapM_ $ \tr ->
fire [tr :=> Identity dat] $ return ()
(readRef trAnySDLRef >>=) . mapM_ $ \tr ->
forM_ payloads $ \payload ->
fire [tr :=> Identity payload] $ return ()
loop
putDebugLnE
:: (PerformEvent t m, Reflex t, MonadIO (Performable m))
=> Event t a
-> (a -> String)
-> m ()
putDebugLnE ev showf = performEvent_ $ liftIO . putStrLn . showf <$> ev
holdView :: ReflexSDL2 r t m => m a -> Event t (m a) -> m (Dynamic t a)
holdView child0 newChild = do
(result0, newResult) <- runWithReplace child0 newChild
holdDyn result0 newResult
dynView :: ReflexSDL2 r t m => Dynamic t (m a) -> m (Event t a)
dynView child = do
evPB <- getPostBuild
let newChild = leftmost [updated child, tagCheap (current child) evPB]
snd <$> runWithReplace (return ()) newChild