reflex-sdl2 0.2.0.0 → 0.3.0.0
raw patch · 7 files changed
+504/−477 lines, 7 filesdep ~asyncdep ~containersdep ~mtl
Dependency ranges changed: async, containers, mtl, sdl2, stm
Files
- README.md +12/−14
- app/Main.hs +58/−32
- reflex-sdl2.cabal +12/−7
- src/Reflex/SDL2.hs +121/−418
- src/Reflex/SDL2/Base.hs +145/−0
- src/Reflex/SDL2/Class.hs +149/−0
- src/Reflex/SDL2/Internal.hs +7/−6
README.md view
@@ -1,23 +1,16 @@ # reflex-sdl2 ++ This is a [reflex][2] host for [sdl2][0]. Writing and running [sdl2][0] apps requires version 2 of the awesome [SDL][1]-library. If you have [nix][4] then the build process will install SDL2 for you.+library. ## building -### with stack & nix--Using [stack][3] and [nix][4] together is the path of enlightenment. [nix][4]-handles installing SDL2 while [stack][3] builds the haskell deps.-- stack --nix build--### without nix--Without [nix][4] you'll have to install SDL2 yourself.+The first step is to install SDL. ### macOS @@ -34,7 +27,14 @@ otherwise please visit the org page above and install via their README. +### building with stack +After installing SDL, we can build with stack.++Using [stack][3] is the path of least resistance.++ stack build+ ## examples After building you can view an example using the built-in 2d renderer in@@ -42,12 +42,10 @@ To run the example do: - stack --nix exec reflex-sdl2-exe+ stack exec reflex-sdl2-exe [0]: http://hackage.haskell.org/package/sdl2 "sdl2 haskell bindings" [1]: http://libsdl.org "Simple Direct Media Layer" [2]: https://github.com/reflex-frp/reflex "reflex frp" [3]: https://docs.haskellstack.org/en/stable/README/ "the haskell tool stack"-[4]: https://nixos.org "Nix"-[5]: https://github.com/reflex-frp/reflex-platform "the reflex platform"
app/Main.hs view
@@ -7,10 +7,11 @@ {-# LANGUAGE UndecidableInstances #-} module Main where -import Control.Concurrent (threadDelay)-import Control.Monad (forM_, guard, void)+import Control.Concurrent (threadDelay)+import Control.Monad (forM_, guard, void)+import Control.Monad.Reader (MonadReader (..), runReaderT)+import Reflex import Reflex.SDL2-import System.Exit (exitSuccess) --------------------------------------------------------------------------------@@ -48,14 +49,14 @@ ---------------------------------------------------------------------- -- | Commit a layer stack that changes over time.-commitLayers :: (ReflexSDL2 r t m, MonadDynamicWriter t [Layer m] m)+commitLayers :: (ReflexSDL2 t m, MonadDynamicWriter t [Layer m] m) => Dynamic t [Layer m] -> m () commitLayers = tellDyn ---------------------------------------------------------------------- -- | Commit one layer that changes over time.-commitLayer :: (ReflexSDL2 r t m, MonadDynamicWriter t [Layer m] m)+commitLayer :: (ReflexSDL2 t m, MonadDynamicWriter t [Layer m] m) => Dynamic t (Layer m) -> m () commitLayer = tellDyn . fmap pure @@ -81,10 +82,10 @@ | otherwise = ButtonStateOver -button :: (ReflexSDL2 r t m, MonadDynamicWriter t [Layer m] m)- => Renderer- -> m (Event t ButtonState)-button r = do+button+ :: (ReflexSDL2 t m, MonadDynamicWriter t [Layer m] m, MonadReader Renderer m)+ => m (Event t ButtonState)+button = do evMotionData <- getMouseMotionEvent let position = V2 100 100 size = V2 100 100@@ -104,6 +105,7 @@ dButtonState <- holdDyn ButtonStateUp $ leftmost [ updated dButtonStatePre , ButtonStateUp <$ evPB ]+ r <- ask commitLayer $ ffor dButtonState $ \st -> do let color = case st of ButtonStateUp -> V4 192 192 192 255@@ -116,19 +118,23 @@ guest- :: (ReflexSDL2 r t m, MonadDynamicWriter t [Layer m] m)- => Renderer- -> m ()-guest r = do+ :: (ReflexSDL2 t m, MonadDynamicWriter t [Layer m] m, MonadReader Renderer m)+ => m ()+guest = do -- Print some stuff after the network is built. evPB <- getPostBuild performEvent_ $ ffor evPB $ \() -> liftIO $ putStrLn "starting up..."+ ------------------------------------------------------------------------------+ -- Get a handle on our renderer+ ------------------------------------------------------------------------------+ r <- ask+ ------------------------------------------------------------------------------ -- Test async events. -- This will wait three seconds before coloring the background black. ------------------------------------------------------------------------------- evDelay <- getAsyncEventWithEventCode 0xBEEF $ threadDelay 3000000+ evDelay <- getAsyncEvent $ threadDelay 3000000 dDelay <- holdDyn False $ True <$ evDelay commitLayers $ ffor dDelay $ \case False -> pure $ do@@ -141,7 +147,7 @@ ------------------------------------------------------------------------------ -- A button! ------------------------------------------------------------------------------- evBtnState <- button r+ evBtnState <- button let evBtnPressed = fmapMaybe (guard . (== ButtonStateDown)) evBtnState performEvent_ $ ffor evBtnPressed $ const $ liftIO $ putStrLn "Button pressed!" @@ -181,7 +187,7 @@ ------------------------------------------------------------------------------ evKey <- getKeyboardEvent let evKeyNoRepeat = fmapMaybe (\k -> k <$ guard (not $ keyboardEventRepeat k)) evKey- dPressed <- holdDyn False $ ((== Pressed) . keyboardEventKeyMotion) <$> evKeyNoRepeat+ dPressed <- holdDyn False $ (== Pressed) . keyboardEventKeyMotion <$> evKeyNoRepeat void $ holdView (return ()) $ ffor (updated dPressed) $ \case False -> return () True -> do@@ -201,23 +207,44 @@ -- Test our recurring timer events ------------------------------------------------------------------------------ let performDeltaSecondTimer n = do- evEverySecond <- getRecurringTimerEventWithEventCode n $ fromIntegral n * 1000- dSeconds <- foldDyn (+) (0 :: Int) $ 1 <$ evEverySecond- evSecondsDelta <- performEventDelta $ updated dSeconds- dSecondsDelta <- holdDyn 0 evSecondsDelta- putDebugLnE (updated $ zipDynWith (,) dSeconds dSecondsDelta) $ (show n ++) . (": " ++) . show+ evDelta <- performEventDelta =<< tickLossyFromPostBuildTime n+ dTicks <- foldDyn (+) 0 $ (1 :: Int) <$ evDelta+ dDelta <- holdDyn 0 evDelta+ dElapsed <- foldDyn (+) 0 evDelta+ flip putDebugLnE id $ updated $ do+ tickz <- dTicks+ lapse <- dElapsed+ delta <- dDelta+ return $ unwords [ show n+ , "timer -"+ , show tickz+ , "ticks -"+ , show lapse+ , "lapsed -"+ , show delta+ , "delta since last tick"+ ] performDeltaSecondTimer 1- performDeltaSecondTimer 2 ------------------------------------------------------------------------------ -- Quit on a quit event ------------------------------------------------------------------------------ evQuit <- getQuitEvent- performEvent_ $ ffor evQuit $ \() -> liftIO $ do- putStrLn "bye!"- exitSuccess+ performEvent_ $ liftIO (putStrLn "bye!") <$ evQuit+ shutdownOn =<< delay 0 evQuit +app :: (ReflexSDL2 t m, MonadReader Renderer m) => m ()+app = do+ (_, dynLayers) <- runDynamicWriterT guest+ r <- ask+ performEvent_ $ ffor (updated dynLayers) $ \layers -> do+ rendererDrawColor r $= V4 0 0 0 255+ clear r+ sequence_ layers+ present r++ main :: IO () main = do initializeAll@@ -233,10 +260,9 @@ putStrLn "creating renderer..." r <- createRenderer window (-1) defaultRenderer rendererDrawBlendMode r $= BlendAlphaBlend- host () $ do- (_, dynLayers) <- runDynamicWriterT $ guest r- performEvent_ $ ffor (updated dynLayers) $ \layers -> do- rendererDrawColor r $= V4 0 0 0 255- clear r- sequence_ layers- present r+ -- Host the network with an example of how to embed your own effects.+ -- In this case it's a simple reader.+ host $ runReaderT app r+ destroyRenderer r+ destroyWindow window+ quit
reflex-sdl2.cabal view
@@ -1,5 +1,5 @@ name: reflex-sdl2-version: 0.2.0.0+version: 0.3.0.0 synopsis: SDL2 and reflex FRP description: A minimal host for sdl2 based reflex apps. homepage: https://github.com/schell/reflex-sdl2#readme@@ -7,7 +7,7 @@ license-file: LICENSE author: Schell Scivally maintainer: schell@takt.com-copyright: Copyright: (c) 2017 Schell Scivally+copyright: Copyright: (c) 2017 - 2019 Schell Scivally category: Game build-type: Simple extra-source-files: README.md@@ -18,17 +18,20 @@ ghc-options: -Wall exposed-modules: Reflex.SDL2 , Reflex.SDL2.Internal- build-depends: async >= 2.1 && < 2.2+ , Reflex.SDL2.Class+ , Reflex.SDL2.Base+ build-depends: async >= 2.1 && < 2.3 , base >= 4.7 && < 5- , containers >= 0.5 && < 0.6+ , containers >= 0.5 && < 0.7 , dependent-sum >= 0.4 && < 0.5 , exception-transformers >= 0.4 && < 0.5+ , ref-tf >= 0.4 && < 0.5 , mtl >= 2.2 && < 2.3 , primitive >= 0.6 && < 0.7 , reflex >= 0.5 && < 0.6- , ref-tf >= 0.4 && < 0.5- , sdl2 >= 2.3 && < 2.4- , stm >= 2.4 && < 2.5+ , sdl2 >= 2.3 && < 2.5+ , stm >= 2.4 && < 2.6+ default-language: Haskell2010 executable reflex-sdl2-exe@@ -36,6 +39,8 @@ main-is: Main.hs ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: base+ , mtl+ , reflex >= 0.5 && < 0.6 , reflex-sdl2 default-language: Haskell2010
src/Reflex/SDL2.hs view
@@ -1,14 +1,13 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- | This module contains a minimum yet convenient API needed to get started@@ -17,85 +16,46 @@ -- For an example see -- [app/Main.hs](https://github.com/schell/reflex-sdl2/blob/master/app/Main.hs) module Reflex.SDL2- (-- * Running an app+ ( -- * Running an app host- -- * The reflex-sdl2 base type and constraints- , ReflexSDL2++ -- * Gracefully shutting down an app+ , shutdownOn++ -- * The reflex-sdl2 class+ , HasSDL2Events (..)+ -- * Base transformer , ReflexSDL2T+ -- * Common constraints (most powerful but convenient)+ , ReflexSDL2+ -- * Concrete stack , ConcreteReflexSDL2+ -- * Higher order switching , holdView , dynView- , -- * Time delta events- getDeltaTickEvent++ -- * Time and recurring timer events+ , TickInfo(..)+ , getDeltaTickEvent , performEventDelta- -- * *WithEventCode events- -- $witheventcode- , getRecurringTimerEventWithEventCode- , getAsyncEventWithEventCode- , delayEventWithEventCode - -- * User data- , userLocal+ -- * Async events+ , getAsyncEvent -- * Debugging , putDebugLnE - -- * SDL2 events- , 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- -- * Re-exports- , 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.Concurrent (newChan, newEmptyMVar, putMVar,+ readChan, takeMVar)+import Control.Concurrent.Async (async, cancel)+import Control.Monad (forM_, unless, void) import Control.Monad.Fix (MonadFix) import Control.Monad.Identity (Identity (..)) import Control.Monad.IO.Class (MonadIO, liftIO)@@ -103,156 +63,32 @@ 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 GHC.Conc (atomically, newTVar, readTVar,+ readTVarIO, writeTVar) import Reflex hiding (Additive) import Reflex.Host.Class-import SDL hiding (Event)+import SDL hiding (Event, delay) +import Reflex.SDL2.Base+import Reflex.SDL2.Class import Reflex.SDL2.Internal ------------------------------------------------------------------------------ -- | A collection of constraints that represent the default reflex-sdl2 network.-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- )------------------------------------------------------------------------------------ | Run a @('Reader' 'SystemEvents' r t)@ computation with a modified--- 'sysUserData' @r@.-userLocal :: MonadReader (SystemEvents r t) m => (r -> r) -> m a -> m a-userLocal f = local (\se -> se{sysUserData = f $ sysUserData se})------------------------------------------------------------------------------------ | Provides a basic implementation of 'ReflexSDL2' constraints.-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)------------------------------------------------------------------------------------ | 'ReflexSDL2T' is an instance of 'PostBuild'.-instance (Reflex t, PostBuild t m, ReflexHost t, Monad m) => PostBuild t (ReflexSDL2T r t m) where- getPostBuild = lift getPostBuild------------------------------------------------------------------------------------ | 'ReflexSDL2T' is an instance of 'PerformEvent'.-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------------------------------------------------------------------------------------ | 'ReflexSDL2T' is an instance of 'MonadAdjust'.-instance ( Reflex t- , ReflexHost t- , MonadAdjust t m- , Monad m- --, PrimMonad (HostFrame t)- ) => 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------------------------------------------------------------------------------------ | 'ReflexSDL2T' is an instance of 'MonadHold'.-instance ( ReflexHost t- , Applicative m- , Monad m- , MonadSample t m- ) => MonadSample t (ReflexSDL2T r t m) where- sample = lift . sample------------------------------------------------------------------------------------ | 'ReflexSDL2T' is an instance of 'MonadHold'.-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 }-------------------------------------------------------------------------------------- $witheventcode--- The *WithEventCode flavor of events use sdl2's user events system. Each--- function evaluates on the current thread, returning an 'Event' that will fire--- on the main thread and can be used to drive GL updates. It uses sdl2's--- user event machinery, requiring a special single use event code to identify--- the event on the other side of sdl2's FFI. This is a great use case for a--- @Fresh@ effect in your app.------------------------------------------------------------------------------------- | Retrieves an event that fires every 'n' milliseconds.-getRecurringTimerEventWithEventCode- :: ReflexSDL2 r t m- => Int32- -- ^ Single use event code.- -> Int- -- ^ Number of milliseconds.- -> m (Event t ())-getRecurringTimerEventWithEventCode eventCode n = do- -- Register the timer event as a user event so it will wake `waitEvent` when- -- pushed into the queue.- 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- -- Filter the user event to only fire when the incoming code matches.- evUser <- getUserEvent- return $ fmapMaybe (guard . (eventCode ==) . userEventCode) evUser+type ReflexSDL2 t m = ( Reflex t+ , MonadHold t m+ , MonadSample t m+ , Adjustable t m+ , PostBuild t m+ , PerformEvent t m+ , TriggerEvent t m+ , MonadFix m+ , MonadIO m+ , MonadIO (Performable m)+ , HasSDL2Events t m+ ) --------------------------------------------------------------------------------@@ -260,233 +96,56 @@ -- since the last frame. -- Be aware that subscribing to this 'Event' (by using it in a monadic action) -- will result in your app running sdl2's event loop every frame.-getDeltaTickEvent :: ReflexSDL2 r t m => m (Event t Word32)+getDeltaTickEvent+ :: (MonadHold t m, MonadFix m, HasSDL2Events t m) => m (Event t Word32) getDeltaTickEvent = do let f (lastTick, _) thisTick = (thisTick, thisTick - lastTick)- evTickAndDel <- accum f (0, 0) =<< asks sysTicksEvent+ evTickAndDel <- accum f (0, 0) =<< getTicksEvent return $ snd <$> evTickAndDel -- | Populate the event value with the time in milliseconds since the last time -- the event fired.-performEventDelta :: ReflexSDL2 r t m => Event t a -> m (Event t Word32)+performEventDelta :: ReflexSDL2 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-- ----------------------------------------------------------------------------------- | Executes the given IO action in a separate thread asynchronously and--- returns an 'Event' that fires on the main thread with the result value--- of that action. This uses sdl2's user events system, which requires that--- the action result have an instance of 'Storable'.------ Your 'a' type gets marshalled to C FFI and back, hence the--- 'Storable' requirement.-getAsyncEventWithEventCode- :: (ReflexSDL2 r t m, Storable a) => Int32 -> IO a -> m (Event t a)-getAsyncEventWithEventCode eventCode action = do- registerAndPushAsync eventCode action- getStorableUserEventWithEventCode eventCode+getAsyncEvent :: ReflexSDL2 t m => IO a -> m (Event t a)+getAsyncEvent f = do+ (ev, g) <- newTriggerEvent+ void $ liftIO $ async $ f >>= g+ return ev ----------------------------------------------------------------------------------- | Delays the given event by the given number of milliseconds.-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------------------------------------------------------------------------------------- SDL2 Events----------------------------------------------------------------------------------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+-- $grace+-- | Will exit the main reflex-sdl2 loop when the given Event fires. This allows+-- the programmer to shut down the network before shutting down SDL.+shutdownOn+ :: (PerformEvent t m, MonadIO (Performable m), HasSDL2Events t m)+ => Event t ()+ -> m ()+shutdownOn ev = do+ var <- getQuitVar+ performEvent_ $ liftIO (putMVar var ()) <$ ev ----------------------------------------------------------------------------------- | The concrete/specialized type used to run reflex-sdl2 apps.-type ConcreteReflexSDL2 r =- ReflexSDL2T r Spider (PostBuildT Spider (PerformEventT Spider (SpiderHost Global)))----deriving instance MonadReader (SystemEvents r Spider) (ConcreteReflexSDL2 r)+-- | The monomorphic type used to run reflex-sdl2 apps.+type ConcreteReflexSDL2 = ReflexSDL2T Spider (TriggerEventT Spider (PostBuildT Spider (PerformEventT Spider (SpiderHost Global)))) --------------------------------------------------------------------------------- | Host a reflex-sdl2 app. This function is your application's main loop and--- will not terminate.+-- | Host a reflex-sdl2 app. host- :: r- -- ^ A user data value of type 'r'.- -- Use 'getUserData' to access this value within your app network.- -> ConcreteReflexSDL2 r ()+ :: ConcreteReflexSDL2 () -- ^ A concrete reflex-sdl2 network to run.- -> IO void-host sysUserData app = runSpiderHost $ do+ -> IO ()+host app = runSpiderHost $ do -- Get events and trigger refs for all things that can happen. (sysPostBuildEvent, trPostBuildRef) <- newEventWithTriggerRef (sysAnySDLEvent, trAnySDLRef) <- newEventWithTriggerRef@@ -532,11 +191,43 @@ (sysClipboardUpdateEvent, trClipboardUpdateRef) <- newEventWithTriggerRef (sysUnknownEvent, trUnknownRef) <- newEventWithTriggerRef - -- Build the network and get our firing command to trigger the post build event.+ -- Build the network and get our firing command to trigger the post build event,+ -- then loop forever in another thread, dequeueing triggers from our chan and+ -- placing them into a TVar. Push a new user event into the SDL event queue that+ -- will set off a read of the TVar and the firing of the triggers within the+ -- main loop.+ -- Also - create som quit vars to communicate when our loops should absolutely end.+ chan <- liftIO newChan+ triggersVar <- liftIO $ atomically $ newTVar []+ sysQuitVar <- liftIO newEmptyMVar+ mainQuitVar <- liftIO $ atomically $ newTVar False+ let reservedTriggerCode = 31337+ isJustTriggerData dat _ =+ return $ guard $ registeredEventCode dat == reservedTriggerCode+ fromData () = return emptyRegisteredEvent{ registeredEventCode = reservedTriggerCode }+ pushTrig <- registerEvent isJustTriggerData fromData >>= \case+ Nothing -> error "Could not register an sdl event for TriggerEvent."+ Just (RegisteredEventType pushTrig _) -> return pushTrig+ asyncTrigger <- liftIO $ async $ fix $ \loop -> do+ trigs <- readChan chan+ atomically $ do+ prevTrigs <- readTVar triggersVar+ writeTVar triggersVar $ prevTrigs ++ trigs+ pushTrig () >>= \case+ EventPushSuccess -> return ()+ EventPushFiltered -> putStrLn "trigger push filtered"+ EventPushFailure t -> print t+ loop+ void $ liftIO $ async $ do+ takeMVar sysQuitVar+ atomically $ writeTVar mainQuitVar True+ void $ pushTrig ()+ cancel asyncTrigger+ ((), FireCommand fire) <-- hostPerformEventT $- runPostBuildT (runReaderT (runReflexSDL2T app) SystemEvents{..})- sysPostBuildEvent+ hostPerformEventT $ flip runPostBuildT sysPostBuildEvent+ $ flip runTriggerEventT chan+ $ runReflexSDL2T app SystemEvents{..} -- Trigger the post build event. (readRef trPostBuildRef >>=) . mapM_ $ \tr ->@@ -544,14 +235,14 @@ -- Loop forever doing all of our main loop stuff. fix $ \loop -> do- -- Fire any tick events, if anyone is listening.+ -- Fire any tick events if anyone is listening. -- If someone _is_ listening, we need to fire an -- event every frame - otherwise we can wait around -- for an sdl event to update the network.- t <- ticks shouldWait <- readRef trTicksRef >>= \case Nothing -> return True Just tr -> do+ t <- ticks void $ fire [tr :=> Identity t] $ return () return False @@ -623,8 +314,19 @@ 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 ()+ UserEvent dat ->+ -- We've found some triggered reflex events, read them and fire them.+ if userEventCode dat == reservedTriggerCode+ then do+ triggers <- liftIO $ atomically $ do+ trigs <- readTVar triggersVar+ writeTVar triggersVar []+ return trigs+ forM_ triggers $ \(EventTriggerRef ref :=> TriggerInvocation a _cb) ->+ (readRef ref >>=) . mapM_ $ \tr -> fire [tr :=> Identity a] $ return ()+ -- Run the callbacks of those triggered events.+ forM_ triggers $ \(_ :=> TriggerInvocation _a cb) -> liftIO cb+ else (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 ->@@ -647,7 +349,8 @@ forM_ payloads $ \payload -> fire [tr :=> Identity payload] $ return () - loop+ shouldQuit <- liftIO $ readTVarIO mainQuitVar+ unless shouldQuit loop ------------------------------------------------------------------------------@@ -667,7 +370,7 @@ -- with the network of the 'Event's value. This process is repeated each time -- the 'Event' fires a new network. Returns a 'Dynamic' of the inner network's -- result that updates any time the 'Event' fires.-holdView :: ReflexSDL2 r t m => m a -> Event t (m a) -> m (Dynamic t a)+holdView :: ReflexSDL2 t m => m a -> Event t (m a) -> m (Dynamic t a) holdView child0 newChild = do (result0, newResult) <- runWithReplace child0 newChild holdDyn result0 newResult@@ -677,7 +380,7 @@ -- | Run a 'Dynamic'ally changing network, replacing the current one with the -- new one every time the 'Dynamic' updates. Returns an 'Event' of the inner -- network's result value that fires every time the 'Dynamic' changes.-dynView :: ReflexSDL2 r t m => Dynamic t (m a) -> m (Event t a)+dynView :: ReflexSDL2 t m => Dynamic t (m a) -> m (Event t a) dynView child = do evPB <- getPostBuild let newChild = leftmost [updated child, tagCheap (current child) evPB]
+ src/Reflex/SDL2/Base.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+module Reflex.SDL2.Base+ ( ReflexSDL2T (..)+ , runReflexSDL2T+ ) where+++import Control.Monad.Exception (MonadException)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Reader+import Reflex hiding (Additive)+import Reflex.Host.Class++import Reflex.SDL2.Class+import Reflex.SDL2.Internal+++------------------------------------------------------------------------------+-- | Provides an implementation of the 'HasSDL2Events' type class.+newtype ReflexSDL2T t (m :: * -> *) a =+ ReflexSDL2T { unReflexSDL2T :: ReaderT (SystemEvents t) m a }+++runReflexSDL2T :: ReflexSDL2T t m a -> SystemEvents t -> m a+runReflexSDL2T = runReaderT . unReflexSDL2T+++deriving instance (ReflexHost t, Functor m) => Functor (ReflexSDL2T t m)+deriving instance (ReflexHost t, Applicative m) => Applicative (ReflexSDL2T t m)+deriving instance (ReflexHost t, Monad m) => Monad (ReflexSDL2T t m)+deriving instance (ReflexHost t, MonadFix m) => MonadFix (ReflexSDL2T t m)+deriving instance (ReflexHost t, MonadIO m) => MonadIO (ReflexSDL2T t m)+deriving instance ReflexHost t => MonadTrans (ReflexSDL2T t)+deriving instance (ReflexHost t, MonadException m) => MonadException (ReflexSDL2T t m)+deriving instance (ReflexHost t, TriggerEvent t m) => TriggerEvent t (ReflexSDL2T t m)+++askSys :: Monad m => (SystemEvents t -> a) -> ReflexSDL2T t m a+askSys = ReflexSDL2T . asks+++instance (ReflexHost t, Monad m) => HasSDL2Events t (ReflexSDL2T t m) where+ getTicksEvent = askSys sysTicksEvent+ getAnySDLEvent = askSys sysAnySDLEvent+ getWindowShownEvent = askSys sysWindowShownEvent+ getWindowHiddenEvent = askSys sysWindowHiddenEvent+ getWindowExposedEvent = askSys sysWindowExposedEvent+ getWindowMovedEvent = askSys sysWindowMovedEvent+ getWindowResizedEvent = askSys sysWindowResizedEvent+ getWindowSizeChangedEvent = askSys sysWindowSizeChangedEvent+ getWindowMinimizedEvent = askSys sysWindowMinimizedEvent+ getWindowMaximizedEvent = askSys sysWindowMaximizedEvent+ getWindowRestoredEvent = askSys sysWindowRestoredEvent+ getWindowGainedMouseFocusEvent = askSys sysWindowGainedMouseFocusEvent+ getWindowLostMouseFocusEvent = askSys sysWindowLostMouseFocusEvent+ getWindowGainedKeyboardFocusEvent = askSys sysWindowGainedKeyboardFocusEvent+ getWindowLostKeyboardFocusEvent = askSys sysWindowLostKeyboardFocusEvent+ getWindowClosedEvent = askSys sysWindowClosedEvent+ getKeyboardEvent = askSys sysKeyboardEvent+ getTextEditingEvent = askSys sysTextEditingEvent+ getTextInputEvent = askSys sysTextInputEvent+ getKeymapChangedEvent = askSys sysKeymapChangedEvent+ getMouseMotionEvent = askSys sysMouseMotionEvent+ getMouseButtonEvent = askSys sysMouseButtonEvent+ getMouseWheelEvent = askSys sysMouseWheelEvent+ getJoyAxisEvent = askSys sysJoyAxisEvent+ getJoyBallEvent = askSys sysJoyBallEvent+ getJoyHatEvent = askSys sysJoyHatEvent+ getJoyButtonEvent = askSys sysJoyButtonEvent+ getJoyDeviceEvent = askSys sysJoyDeviceEvent+ getControllerAxisEvent = askSys sysControllerAxisEvent+ getControllerButtonEvent = askSys sysControllerButtonEvent+ getControllerDeviceEvent = askSys sysControllerDeviceEvent+ getAudioDeviceEvent = askSys sysAudioDeviceEvent+ getQuitEvent = askSys sysQuitEvent+ getUserEvent = askSys sysUserEvent+ getSysWMEvent = askSys sysSysWMEvent+ getTouchFingerEvent = askSys sysTouchFingerEvent+ getMultiGestureEvent = askSys sysMultiGestureEvent+ getDollarGestureEvent = askSys sysDollarGestureEvent+ getDropEvent = askSys sysDropEvent+ getClipboardUpdateEvent = askSys sysClipboardUpdateEvent+ getUnknownEvent = askSys sysUnknownEvent+ getQuitVar = askSys sysQuitVar+++------------------------------------------------------------------------------+-- | 'ReflexSDL2T' is an instance of 'PostBuild'.+instance (Reflex t, PostBuild t m, ReflexHost t, Monad m) => PostBuild t (ReflexSDL2T t m) where+ getPostBuild = lift getPostBuild+++------------------------------------------------------------------------------+-- | 'ReflexSDL2T' is an instance of 'PerformEvent'.+instance (ReflexHost t, PerformEvent t m) => PerformEvent t (ReflexSDL2T t m) where+ type Performable (ReflexSDL2T t m) = ReflexSDL2T t (Performable m)+ performEvent_ = ReflexSDL2T . performEvent_ . fmap unReflexSDL2T+ performEvent = ReflexSDL2T . performEvent . fmap unReflexSDL2T+++------------------------------------------------------------------------------+-- | 'ReflexSDL2T' is an instance of 'Adjustable'.+instance ( Reflex t+ , ReflexHost t+ , Adjustable t m+ , Monad m+ ) => Adjustable t (ReflexSDL2T t m) where+ runWithReplace ma evmb =+ ReflexSDL2T $ runWithReplace (unReflexSDL2T ma) (unReflexSDL2T <$> evmb)+ traverseDMapWithKeyWithAdjust kvma dMapKV = ReflexSDL2T .+ traverseDMapWithKeyWithAdjust (\ka -> unReflexSDL2T . kvma ka) dMapKV+ traverseDMapWithKeyWithAdjustWithMove kvma dMapKV = ReflexSDL2T .+ traverseDMapWithKeyWithAdjustWithMove (\ka -> unReflexSDL2T . kvma ka) dMapKV+ traverseIntMapWithKeyWithAdjust f im = ReflexSDL2T .+ traverseIntMapWithKeyWithAdjust (\ka -> unReflexSDL2T . f ka) im+++------------------------------------------------------------------------------+-- | 'ReflexSDL2T' is an instance of 'MonadHold'.+instance ( ReflexHost t+ , Applicative m+ , Monad m+ , MonadSample t m+ ) => MonadSample t (ReflexSDL2T t m) where+ sample = lift . sample+++------------------------------------------------------------------------------+-- | 'ReflexSDL2T' is an instance of 'MonadHold'.+instance (ReflexHost t, MonadHold t m) => MonadHold t (ReflexSDL2T t m) where+ hold a = lift . hold a+ holdDyn a = lift . holdDyn a+ holdIncremental p = lift . holdIncremental p+ buildDynamic ma = lift . buildDynamic ma+ headE = lift . headE
+ src/Reflex/SDL2/Class.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+module Reflex.SDL2.Class where+++import Control.Concurrent (MVar)+import Control.Monad.Reader (ReaderT)+import Control.Monad.Trans (lift)+import Data.Word (Word32)+import Reflex (Event, Reflex)+import Reflex.DynamicWriter.Base (DynamicWriterT)+import SDL hiding (Event)+++class (Reflex t, Monad m) => HasSDL2Events t m | m -> t where+ getTicksEvent :: m (Event t Word32)+ getAnySDLEvent :: m (Event t EventPayload)+ getWindowShownEvent :: m (Event t WindowShownEventData)+ getWindowHiddenEvent :: m (Event t WindowHiddenEventData)+ getWindowExposedEvent :: m (Event t WindowExposedEventData)+ getWindowMovedEvent :: m (Event t WindowMovedEventData)+ getWindowResizedEvent :: m (Event t WindowResizedEventData)+ getWindowSizeChangedEvent :: m (Event t WindowSizeChangedEventData)+ getWindowMinimizedEvent :: m (Event t WindowMinimizedEventData)+ getWindowMaximizedEvent :: m (Event t WindowMaximizedEventData)+ getWindowRestoredEvent :: m (Event t WindowRestoredEventData)+ getWindowGainedMouseFocusEvent :: m (Event t WindowGainedMouseFocusEventData)+ getWindowLostMouseFocusEvent :: m (Event t WindowLostMouseFocusEventData)+ getWindowGainedKeyboardFocusEvent :: m (Event t WindowGainedKeyboardFocusEventData)+ getWindowLostKeyboardFocusEvent :: m (Event t WindowLostKeyboardFocusEventData)+ getWindowClosedEvent :: m (Event t WindowClosedEventData)+ getKeyboardEvent :: m (Event t KeyboardEventData)+ getTextEditingEvent :: m (Event t TextEditingEventData)+ getTextInputEvent :: m (Event t TextInputEventData)+ getKeymapChangedEvent :: m (Event t ())+ getMouseMotionEvent :: m (Event t MouseMotionEventData)+ getMouseButtonEvent :: m (Event t MouseButtonEventData)+ getMouseWheelEvent :: m (Event t MouseWheelEventData)+ getJoyAxisEvent :: m (Event t JoyAxisEventData)+ getJoyBallEvent :: m (Event t JoyBallEventData)+ getJoyHatEvent :: m (Event t JoyHatEventData)+ getJoyButtonEvent :: m (Event t JoyButtonEventData)+ getJoyDeviceEvent :: m (Event t JoyDeviceEventData)+ getControllerAxisEvent :: m (Event t ControllerAxisEventData)+ getControllerButtonEvent :: m (Event t ControllerButtonEventData)+ getControllerDeviceEvent :: m (Event t ControllerDeviceEventData)+ getAudioDeviceEvent :: m (Event t AudioDeviceEventData)+ getQuitEvent :: m (Event t ())+ getUserEvent :: m (Event t UserEventData)+ getSysWMEvent :: m (Event t SysWMEventData)+ getTouchFingerEvent :: m (Event t TouchFingerEventData)+ getMultiGestureEvent :: m (Event t MultiGestureEventData)+ getDollarGestureEvent :: m (Event t DollarGestureEventData)+ getDropEvent :: m (Event t DropEventData)+ getClipboardUpdateEvent :: m (Event t ())+ getUnknownEvent :: m (Event t UnknownEventData)+ getQuitVar :: m (MVar ())+++instance HasSDL2Events t m => HasSDL2Events t (ReaderT r m) where+ getTicksEvent = lift getTicksEvent+ getAnySDLEvent = lift getAnySDLEvent+ getWindowShownEvent = lift getWindowShownEvent+ getWindowHiddenEvent = lift getWindowHiddenEvent+ getWindowExposedEvent = lift getWindowExposedEvent+ getWindowMovedEvent = lift getWindowMovedEvent+ getWindowResizedEvent = lift getWindowResizedEvent+ getWindowSizeChangedEvent = lift getWindowSizeChangedEvent+ getWindowMinimizedEvent = lift getWindowMinimizedEvent+ getWindowMaximizedEvent = lift getWindowMaximizedEvent+ getWindowRestoredEvent = lift getWindowRestoredEvent+ getWindowGainedMouseFocusEvent = lift getWindowGainedMouseFocusEvent+ getWindowLostMouseFocusEvent = lift getWindowLostMouseFocusEvent+ getWindowGainedKeyboardFocusEvent = lift getWindowGainedKeyboardFocusEvent+ getWindowLostKeyboardFocusEvent = lift getWindowLostKeyboardFocusEvent+ getWindowClosedEvent = lift getWindowClosedEvent+ getKeyboardEvent = lift getKeyboardEvent+ getTextEditingEvent = lift getTextEditingEvent+ getTextInputEvent = lift getTextInputEvent+ getKeymapChangedEvent = lift getKeymapChangedEvent+ getMouseMotionEvent = lift getMouseMotionEvent+ getMouseButtonEvent = lift getMouseButtonEvent+ getMouseWheelEvent = lift getMouseWheelEvent+ getJoyAxisEvent = lift getJoyAxisEvent+ getJoyBallEvent = lift getJoyBallEvent+ getJoyHatEvent = lift getJoyHatEvent+ getJoyButtonEvent = lift getJoyButtonEvent+ getJoyDeviceEvent = lift getJoyDeviceEvent+ getControllerAxisEvent = lift getControllerAxisEvent+ getControllerButtonEvent = lift getControllerButtonEvent+ getControllerDeviceEvent = lift getControllerDeviceEvent+ getAudioDeviceEvent = lift getAudioDeviceEvent+ getQuitEvent = lift getQuitEvent+ getUserEvent = lift getUserEvent+ getSysWMEvent = lift getSysWMEvent+ getTouchFingerEvent = lift getTouchFingerEvent+ getMultiGestureEvent = lift getMultiGestureEvent+ getDollarGestureEvent = lift getDollarGestureEvent+ getDropEvent = lift getDropEvent+ getClipboardUpdateEvent = lift getClipboardUpdateEvent+ getUnknownEvent = lift getUnknownEvent+ getQuitVar = lift getQuitVar+++instance HasSDL2Events t m => HasSDL2Events t (DynamicWriterT t w m) where+ getTicksEvent = lift getTicksEvent+ getAnySDLEvent = lift getAnySDLEvent+ getWindowShownEvent = lift getWindowShownEvent+ getWindowHiddenEvent = lift getWindowHiddenEvent+ getWindowExposedEvent = lift getWindowExposedEvent+ getWindowMovedEvent = lift getWindowMovedEvent+ getWindowResizedEvent = lift getWindowResizedEvent+ getWindowSizeChangedEvent = lift getWindowSizeChangedEvent+ getWindowMinimizedEvent = lift getWindowMinimizedEvent+ getWindowMaximizedEvent = lift getWindowMaximizedEvent+ getWindowRestoredEvent = lift getWindowRestoredEvent+ getWindowGainedMouseFocusEvent = lift getWindowGainedMouseFocusEvent+ getWindowLostMouseFocusEvent = lift getWindowLostMouseFocusEvent+ getWindowGainedKeyboardFocusEvent = lift getWindowGainedKeyboardFocusEvent+ getWindowLostKeyboardFocusEvent = lift getWindowLostKeyboardFocusEvent+ getWindowClosedEvent = lift getWindowClosedEvent+ getKeyboardEvent = lift getKeyboardEvent+ getTextEditingEvent = lift getTextEditingEvent+ getTextInputEvent = lift getTextInputEvent+ getKeymapChangedEvent = lift getKeymapChangedEvent+ getMouseMotionEvent = lift getMouseMotionEvent+ getMouseButtonEvent = lift getMouseButtonEvent+ getMouseWheelEvent = lift getMouseWheelEvent+ getJoyAxisEvent = lift getJoyAxisEvent+ getJoyBallEvent = lift getJoyBallEvent+ getJoyHatEvent = lift getJoyHatEvent+ getJoyButtonEvent = lift getJoyButtonEvent+ getJoyDeviceEvent = lift getJoyDeviceEvent+ getControllerAxisEvent = lift getControllerAxisEvent+ getControllerButtonEvent = lift getControllerButtonEvent+ getControllerDeviceEvent = lift getControllerDeviceEvent+ getAudioDeviceEvent = lift getAudioDeviceEvent+ getQuitEvent = lift getQuitEvent+ getUserEvent = lift getUserEvent+ getSysWMEvent = lift getSysWMEvent+ getTouchFingerEvent = lift getTouchFingerEvent+ getMultiGestureEvent = lift getMultiGestureEvent+ getDollarGestureEvent = lift getDollarGestureEvent+ getDropEvent = lift getDropEvent+ getClipboardUpdateEvent = lift getClipboardUpdateEvent+ getUnknownEvent = lift getUnknownEvent+ getQuitVar = lift getQuitVar
src/Reflex/SDL2/Internal.hs view
@@ -4,9 +4,10 @@ -- need them :) module Reflex.SDL2.Internal where -import Data.Word (Word32)-import Reflex (Event)-import SDL hiding (Event)+import Control.Concurrent (MVar)+import Data.Word (Word32)+import Reflex (Event)+import SDL hiding (Event) ------------------------------------------------------------------------------ -- | Holds a slot of 'Event' for each kind of SDL2 event plus a couple extras:@@ -16,7 +17,7 @@ -- An event for reflex's post network build event. -- -- An event for each frame tick.-data SystemEvents r t = SystemEvents+data SystemEvents t = SystemEvents { sysPostBuildEvent :: Event t () -- ^ Fired just after the FRP network is built. , sysTicksEvent :: Event t Word32@@ -64,6 +65,6 @@ , sysDropEvent :: Event t DropEventData , sysClipboardUpdateEvent :: Event t () , sysUnknownEvent :: Event t UnknownEventData- , sysUserData :: r- -- ^ A slot to hold any custom user data.+ , sysQuitVar :: MVar ()+ -- ^ A var to sync quitting. }