reactive-banana-sdl2 0.1.0.0 → 0.1.1.0
raw patch · 4 files changed
+111/−85 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Reactive.Banana.SDL2: runCappedSDLPump :: Word16 -> SDLEventSource -> IO ()
Files
- reactive-banana-sdl2.cabal +4/−4
- src/Reactive/Banana/SDL2.hs +39/−30
- src/Reactive/Banana/SDL2/Types.hs +13/−5
- src/Reactive/Banana/SDL2/Util.hs +55/−46
reactive-banana-sdl2.cabal view
@@ -1,5 +1,5 @@ name: reactive-banana-sdl2-version: 0.1.0.0+version: 0.1.1.0 synopsis: Reactive Banana integration with SDL2 description: Provides bindings and convenience functions for using Reactive Banana with SDL2. Please see README.md@@ -19,9 +19,9 @@ exposed-modules: Reactive.Banana.SDL2 , Reactive.Banana.SDL2.Types , Reactive.Banana.SDL2.Util- build-depends: base >= 4.7 && < 5- , reactive-banana >= 1.1.0 && < 1.2.0- , sdl2 >= 2.1.0 && < 2.2.0+ build-depends: base >= 4.7 && < 5+ , reactive-banana >= 1.1.0 && < 1.2.0+ , sdl2 >= 2.1.0 && < 2.2.0 default-language: Haskell2010
src/Reactive/Banana/SDL2.hs view
@@ -1,50 +1,59 @@-module Reactive.Banana.SDL2 ( module Reactive.Banana.SDL2.Types- , module Reactive.Banana.SDL2.Util- , getSDLEventSource, runSDLPump- )where+module Reactive.Banana.SDL2 (+ module Reactive.Banana.SDL2.Types+ , module Reactive.Banana.SDL2.Util+ , getSDLEventSource+ , runSDLPump+ , runCappedSDLPump+ ) where import Control.Monad import Data.Word import Reactive.Banana as R import Reactive.Banana.Frameworks (newAddHandler)+import qualified SDL as SDL+import qualified SDL.Raw as SDLR+ import Reactive.Banana.SDL2.Types import Reactive.Banana.SDL2.Util-import SDL-import SDL.Time-import qualified SDL.Raw as SDLR getSDLEventSource :: IO SDLEventSource getSDLEventSource = SDLEventSource <$> newAddHandler <*> newAddHandler --- | one step in the main event loop, returning False when it needs to stop-+-- | One step in the main event loop, returning False when it needs to stop. mainSDLPump :: SDLEventSource -> IO Bool-mainSDLPump es= do- let esdl = getSDLEvent es- etick = getTickEvent es- tick <- SDL.ticks- me <- collectEvents-- case me of- Nothing -> return False- Just e -> do- mapM (fire esdl) e- fire etick tick- return True+mainSDLPump sdlEventSource = do+ let esdl = getSDLEvent sdlEventSource+ etick = getTickEvent sdlEventSource+ tick <- SDL.ticks+ mEvents <- collectEvents+ case mEvents of Nothing -> return False+ Just events -> do mapM (fire esdl) events+ fire etick tick+ return True --- | collect SDL events--- return Nothing on quit, otherwise the last event+-- | Collect SDL events.+-- Evaluate to Nothing on quit, otherwise evaluates to the last event. collectEvents :: IO (Maybe [SDL.EventPayload]) collectEvents = do- e <- SDL.pollEvent- case fmap eventPayload e of- Just SDL.QuitEvent -> return Nothing- Nothing -> return (Just [])- Just ev -> liftM (liftM (ev:)) collectEvents+ e <- SDL.pollEvent+ case fmap SDL.eventPayload e of+ Just SDL.QuitEvent -> return Nothing+ Nothing -> return (Just [])+ Just event -> liftM (liftM (event:)) collectEvents +-- | The main event loop. runSDLPump :: SDLEventSource -> IO ()-runSDLPump es = whileM (mainSDLPump es)+runSDLPump sdlEventSource = whileM $ mainSDLPump sdlEventSource -runCappedSDLPump = undefined+-- | The main event loop, capped at a given FPS.+runCappedSDLPump :: Word16 -> SDLEventSource -> IO ()+runCappedSDLPump fpsCap sdlEventSource = do+ startTick <- SDL.ticks+ shouldContinue <- mainSDLPump sdlEventSource+ endTick <- SDL.ticks+ let ticks = fromIntegral $ endTick - startTick+ secsPerFrame = fromIntegral $ 1000 `div` fpsCap+ when (ticks < secsPerFrame) $ SDL.delay (secsPerFrame - ticks)+ when shouldContinue $ runCappedSDLPump fpsCap sdlEventSource
src/Reactive/Banana/SDL2/Types.hs view
@@ -1,18 +1,26 @@ -- | Types used for events-module Reactive.Banana.SDL2.Types ( EventSource, SDLEventSource (..), WrappedEvent- , TickEvent ) where+module Reactive.Banana.SDL2.Types (+ EventSource+ , SDLEventSource (..)+ , WrappedEvent+ , TickEvent+ ) where import Data.Word import Reactive.Banana as R import Reactive.Banana.Frameworks (AddHandler)-import SDL+import qualified SDL as SDL + -- | Generic Event Source type EventSource a = (AddHandler a, a -> IO ())--- | an event containing a list of SDL event++-- | An event containing a list of SDL event type WrappedEvent = R.Event SDL.EventPayload+ -- | SDL Tick event-type TickEvent = R.Event Word32+type TickEvent = R.Event Word32+ -- | SDL Event Source data SDLEventSource = SDLEventSource { getSDLEvent :: EventSource SDL.EventPayload , getTickEvent :: EventSource Word32 }
src/Reactive/Banana/SDL2/Util.hs view
@@ -1,11 +1,20 @@ {-# LANGUAGE RecursiveDo #-} -- | Functions on events-module Reactive.Banana.SDL2.Util ( addHandler, fire, sdlEvent, tickEvent- , keyEvent, keyDownEvent, keyUpEvent, mouseEvent, mouseButtonEvent- , keyFilter, keyUpFilter- , mouseEventWithin, tickDiffEvent- , whileM, successive ) where+module Reactive.Banana.SDL2.Util (+ addHandler, fire, sdlEvent, tickEvent+ , keyEvent+ , keyDownEvent+ , keyUpEvent+ , mouseEvent+ , mouseButtonEvent+ , keyFilter+ , keyUpFilter+ , mouseEventWithin+ , tickDiffEvent+ , whileM+ , successive+ ) where import Control.Monad (liftM, when) import Reactive.Banana as R@@ -14,15 +23,16 @@ import SDL import SDL.Raw as SDLR --- | run while the given computation returns True++-- | Run while the given computation returns True whileM :: IO Bool -> IO () whileM f = f >>= (\x -> when x $ whileM f) --- | get the AddHandler from a EventSource+-- | Get the AddHandler from a EventSource addHandler :: EventSource a -> AddHandler a addHandler = fst --- | fire the event from an Event Source+-- | Fire the event from an Event Source fire :: EventSource a -> a -> IO () fire = snd @@ -34,13 +44,14 @@ tickEvent :: SDLEventSource -> MomentIO TickEvent tickEvent = fromAddHandler . addHandler . getTickEvent --- | event carrying the difference between the last two SDL ticks+-- | Event carrying the difference between the last two SDL ticks. tickDiffEvent :: SDLEventSource -> MomentIO TickEvent tickDiffEvent source = mdo te <- tickEvent source- s <- (successive (\a b-> if b > a then Just (b - a) else Nothing)) te+ s <- (successive (\a b -> if b > a then Just (b - a) else Nothing)) te return s +-- | Filter and aggregate an event stream based on a function. successive :: (a -> a -> Maybe b) -> R.Event a -> MomentIO (R.Event b) successive f e = (\b -> filterJust (b <@> e)) <$> stepper (const Nothing) (f <$> e) -- Below same as about but with mdo; easier to debug (at least to me)@@ -51,63 +62,61 @@ -- stepperB :: (a -> a -> Maybe b) -> R.Event a -> MomentIO (Behavior (a -> Maybe b )) -- stepperB f e = stepper (const Nothing) (f <$> e) ---- | filter any key events+-- | Filter any key events keyEvent :: WrappedEvent -> WrappedEvent-keyEvent = filterE isKey- where- isKey e = case e of- SDL.KeyboardEvent _ -> True- otherwise -> False+keyEvent = filterE isKey+ where+ isKey e = case e of+ SDL.KeyboardEvent _ -> True+ otherwise -> False --- | event carrying the key pressed down+-- | Event carrying the key pressed down keyDownEvent :: WrappedEvent -> R.Event SDL.Keysym-keyDownEvent= filterJust . (isDown <$>) . keyEvent- where isDown (SDL.KeyboardEvent (KeyboardEventData _ Pressed _ k)) = Just k- isDown _ = Nothing+keyDownEvent = filterJust . (isDown <$>) . keyEvent+ where isDown (SDL.KeyboardEvent (KeyboardEventData _ Pressed _ k)) = Just k+ isDown _ = Nothing --- | event carrying the key pressed up+-- | Event carrying the key pressed up keyUpEvent :: WrappedEvent -> R.Event SDL.Keysym keyUpEvent = filterJust . (isDown <$>) . keyEvent- where isDown (SDL.KeyboardEvent (KeyboardEventData _ Released _ k)) = Just k- isDown _ = Nothing+ where isDown (SDL.KeyboardEvent (KeyboardEventData _ Released _ k)) = Just k+ isDown _ = Nothing --- | filter any mouse event (button or move)+-- | Filter any mouse event (button or move) mouseEvent :: WrappedEvent -> WrappedEvent mouseEvent esdl = unionWith f mouseMotion (mouseButtonEvent esdl)- where- f e1 e2 = e2- mouseMotion = filterE isMotion $ esdl- isMotion e = case e of- SDL.MouseMotionEvent MouseMotionEventData {} -> True- otherwise -> False+ where+ f e1 e2 = e2+ mouseMotion = filterE isMotion $ esdl+ isMotion e = case e of+ SDL.MouseMotionEvent MouseMotionEventData {} -> True+ otherwise -> False --- | mouse button event+-- | Mouse button event mouseButtonEvent :: WrappedEvent -> WrappedEvent mouseButtonEvent = filterE isButton- where- isButton e = case e of- SDL.MouseButtonEvent MouseButtonEventData{} -> True- otherwise -> False+ where+ isButton e = case e of+ SDL.MouseButtonEvent MouseButtonEventData{} -> True+ otherwise -> False --- | mouse event occuring inside a given area+-- | Mouse event occuring inside a given area mouseEventWithin :: Rect -> WrappedEvent -> WrappedEvent mouseEventWithin ~(Rect x y w h) = filterE isWithin- where- within pos = undefined- isWithin e = case e of- SDL.MouseMotionEvent (MouseMotionEventData _ _ _ pos _) -> within pos- SDL.MouseButtonEvent (MouseButtonEventData _ _ _ _ _ pos) -> within pos- otherwise -> False-+ where+ within pos = undefined+ isWithin e = case e of+ SDL.MouseMotionEvent (MouseMotionEventData _ _ _ pos _) -> within pos+ SDL.MouseButtonEvent (MouseButtonEventData _ _ _ _ _ pos) -> within pos+ otherwise -> False --- | filter an event on a particular key being held down+-- | Filter an event on a particular key being held down keyFilter :: SDL.Keycode-> SDL.EventPayload -> Bool keyFilter k (SDL.KeyboardEvent (KeyboardEventData _ Pressed _ (SDL.Keysym _ k' _ ))) | k == k' = True keyFilter _ _ = False --- | filter an event on a particular key being released+-- | Filter an event on a particular key being released keyUpFilter :: SDL.Keycode -> SDL.EventPayload -> Bool keyUpFilter k (SDL.KeyboardEvent (KeyboardEventData _ Released _ (SDL.Keysym _ k' _ ))) | k == k' = True