helm 0.5.0 → 0.6.0
raw patch · 14 files changed
+1039/−772 lines, 14 filesdep +ghc-primdep +sdl2dep +transformersdep −SDL
Dependencies added: ghc-prim, sdl2, transformers
Dependencies removed: SDL
Files
- LICENSE +1/−1
- README.md +16/−23
- helm.cabal +14/−12
- src/FRP/Helm.hs +156/−146
- src/FRP/Helm/Animation.hs +30/−31
- src/FRP/Helm/Automaton.hs +0/−73
- src/FRP/Helm/Color.hs +7/−2
- src/FRP/Helm/Joystick.hs +0/−105
- src/FRP/Helm/Keyboard.hs +755/−344
- src/FRP/Helm/Mouse.hs +27/−7
- src/FRP/Helm/Time.hs +4/−4
- src/FRP/Helm/Transition.hs +14/−12
- src/FRP/Helm/Window.hs +15/−8
- tests/Main.hs +0/−4
LICENSE view
@@ -1,4 +1,4 @@-Copyright (C) 2013, Zack Corr+Copyright (C) 2013-2014, Zack Corr Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to
README.md view
@@ -1,5 +1,8 @@ <p align="center">- <a href="http://helm-engine.org" title="Homepage"><img src="http://helm-engine.org/img/logo-alt.png"/></a>+ <a href="http://helm-engine.org" title="Homepage"><img src="http://helm-engine.org/img/logo-alt.png" /></a>+ <br>+ <br>+ <a href="https://travis-ci.org/switchface/helm" title="Travis CI"><img src="https://travis-ci.org/switchface/helm.svg" /></a> </p> ## Introduction@@ -37,17 +40,10 @@ and readily make the most basic of games. * `FRP.Helm.Animation` contains a simple implementation of animations. Each animation is made up of a list of frames which render a form at a specific time.- * `FRP.Helm.Automaton` contains the `Automaton` data structure and functions- for composing, creating and calculating them. Automatons are a useful- abstraction of a dynamic process that is fed input from a signal- and feeds output through a signal. This is really useful for things- like animation systems, accumulating network packets and other- stateful but input dependent things. * `FRP.Helm.Color` contains the `Color` data structure, functions for composing colors and a few pre-defined colors that are usually used in games. * `FRP.Helm.Graphics` contains all the graphics data structures, functions for composing these structures and other general graphical utilities.- * `FRP.Helm.Joystick` contains signals for working with joystick state. * `FRP.Helm.Keyboard` contains signals for working with keyboard state. * `FRP.Helm.Mouse` contains signals for working with mouse state. * `FRP.Helm.Text` contains functions for composing text, formatting it@@ -70,11 +66,14 @@ render (w, h) = collage w h [move (100, 100) $ filled red $ square 64] main :: IO ()-main = run defaultConfig $ render <~ Window.dimensions+main = do+ engine <- startup defaultConfig++ run engine $ render <~ Window.dimensions engine ``` It renders a red square at the position `(100, 100)` with a side length of `64`. - + The next example is the barebones of a game that depends on input. It shows how to create an accumulated state that depends on the values sampled from signals (e.g. mouse input). You should see a white square on the screen and pressing the arrow keys allows you to move it.@@ -95,7 +94,11 @@ centeredCollage w h [move (mx, my) $ filled white $ square 100] main :: IO ()-main = run defaultConfig $ render <~ Window.dimensions ~~ stepper+main = do+ engine <- startup defaultConfig++ run engine $ render <~ Window.dimensions engine ~~ stepper+ where state = State { mx = 0, my = 0 } stepper = foldp step state Keyboard.arrows@@ -141,15 +144,5 @@ and after commas, etc. Please also confirm that the code passes under HLint. -The following is a list of major issues that need to be tackled in the future:--* Improve the API. See [issue #4](https://github.com/z0w0/helm/issues/4).-* Backend wise, it would be nice to use GLFW/OpenGL instead of SDL/Cairo (at the very least SDL/OpenGL).- See [issue #1](https://github.com/z0w0/helm/issues/1).-* Optimizations and testing. This is a early release of the engine so- obviously little testing or optimizations have been done.- See [issue #2](https://github.com/z0w0/helm/issues/2). Preferably, upgrade to SDL2.-* Port and support multiple platforms. I've only been testing it on- Linux, but there's really no reason that it wouldn't work out of the box- on Windows or OSX after setting up the dependencies.- See [issue #3](https://github.com/z0w0/helm/issues/3).+There are a number of issues [tagged with the bounty tag](https://github.com/switchface/helm/issues?labels=bounty&state=open),+meaning they have associated bounties on [Bountysource](https://www.bountysource.com/trackers/290443-helm).
helm.cabal view
@@ -1,24 +1,24 @@ name: helm-version: 0.5.0+version: 0.6.0 synopsis: A functionally reactive game engine. description: A functionally reactive game engine, with headgear to protect you from the headache of game development provided.-homepage: http://github.com/z0w0/helm-bug-reports: http://github.com/z0w0/helm/issues+homepage: http://github.com/switchface/helm+bug-reports: http://github.com/switchface/helm/issues license: MIT license-file: LICENSE tested-with: GHC == 7.6.3 extra-source-files: LICENSE, README.md author: Zack Corr maintainer: Zack Corr <zack@z0w0.me>-copyright: (c) 2013, Zack Corr+copyright: (c) 2013-2014, Zack Corr category: Game Engine, FRP build-type: Simple cabal-version: >=1.10 source-repository head type: git- location: git://github.com/z0w0/helm.git+ location: git://github.com/switchface/helm.git library hs-source-dirs: src@@ -28,11 +28,9 @@ exposed-modules: FRP.Helm- FRP.Helm.Automaton FRP.Helm.Color FRP.Helm.Graphics FRP.Helm.Animation- FRP.Helm.Joystick FRP.Helm.Keyboard FRP.Helm.Mouse FRP.Helm.Text@@ -40,7 +38,7 @@ FRP.Helm.Utilities FRP.Helm.Window FRP.Helm.Transition- + build-depends: base >= 4 && < 5, cairo >= 0.12 && < 1,@@ -48,10 +46,14 @@ containers >= 0.5 && < 1, elerea >= 2.7 && < 3, filepath >= 1.3 && < 2,- SDL >= 0.6 && < 1,+ sdl2 >= 1.1 && < 2, random >= 1.0.1.1 && < 1.2,- mtl >= 2.1 && < 2.2+ mtl >= 2.1 && < 2.2,+ transformers >= 0.3.0.0 + if impl(ghc < 7.6)+ build-depends: ghc-prim+ test-suite helm-tests type: exitcode-stdio-1.0 x-uses-tf: true@@ -59,7 +61,7 @@ hs-source-dirs: tests, src default-language: Haskell2010 main-is: Main.hs- + build-depends: base >= 4 && < 5, HUnit >= 1.2 && < 2,@@ -67,4 +69,4 @@ test-framework-hunit >= 0.3 && < 1, test-framework-quickcheck2 >= 0.3 && < 1, elerea >= 2.7 && < 3,- SDL >= 0.6 && < 1+ sdl2 >= 1.1 && < 2
src/FRP/Helm.hs view
@@ -3,25 +3,36 @@ module FRP.Helm ( -- * Types Time,+ Engine(..), EngineConfig(..), -- * Engine+ startup, run, defaultConfig, -- * Prelude module Color, module Graphics, module Utilities,+ FRP.Helm.Utilities.lift ) where +import Control.Applicative import Control.Exception import Control.Monad (when)+import Control.Monad.IO.Class+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State+import Data.Bits import Data.Foldable (forM_)-import Data.IORef-import Foreign.Ptr (castPtr)+import Foreign.C.String+import Foreign.Marshal.Alloc+import Foreign.Ptr+import Foreign.Storable import FRP.Elerea.Simple import FRP.Helm.Color as Color import FRP.Helm.Graphics as Graphics-import FRP.Helm.Utilities as Utilities+import FRP.Helm.Utilities as Utilities hiding (lift)+import qualified FRP.Helm.Utilities (lift) import FRP.Helm.Time (Time) import System.FilePath import qualified Data.Map as Map@@ -29,19 +40,7 @@ import qualified Graphics.Rendering.Cairo as Cairo import qualified Graphics.Rendering.Pango as Pango -{-| Attempt to change the window dimensions (and initialize the video mode if not already).- Will try to get a hardware accelerated window and then fallback to a software one.- Throws an exception if the software mode can't be used as a fallback. -}-requestDimensions :: Int -> Int -> Bool -> IO SDL.Surface-requestDimensions w h resizable = do- mayhaps <- SDL.trySetVideoMode w h 32 $ [SDL.HWSurface, SDL.DoubleBuf] ++ flags-- case mayhaps of- Just screen -> return screen- Nothing -> SDL.setVideoMode w h 32 $ SDL.SWSurface : flags-- where- flags = [SDL.Resizable | resizable]+type Helm a = StateT Engine Cairo.Render a {-| A data structure describing miscellaneous initial configurations of the game window and engine. -} data EngineConfig = EngineConfig {@@ -60,26 +59,28 @@ windowTitle = "" } -{-| A data structure describing the current engine state.- This may be in userland in the future, for setting- window dimensions, title, etc. -}-data EngineState = EngineState {- smp :: IO Element,- {- FIXME: we need this mutable state (unfortunately)- because Cairo forces us to liftIO and can't return anything- in the render function, where the lazy image loading takes place.- There may be a way to do this nicely, I'm just not experienced- enough with Haskell to know how. -}- cache :: IORef (Map.Map FilePath Cairo.Surface)+{-| A data structure describing the current engine state. -}+data Engine = Engine {+ window :: SDL.Window,+ renderer :: SDL.Renderer,+ cache :: Map.Map FilePath Cairo.Surface } -{-| Creates a new engine state, spawning an empty cache spawned in an IORef. -}-newEngineState :: IO Element -> IO EngineState-newEngineState smp = do- cache <- newIORef Map.empty+{-| Creates a new engine that can be run later using 'run'. -}+startup :: EngineConfig -> IO Engine+startup (EngineConfig { .. }) = withCAString windowTitle $ \title -> do+ window <- SDL.createWindow title 0 0 (fromIntegral w) (fromIntegral h) wflags+ renderer <- SDL.createRenderer window (-1) rflags - return EngineState { smp = smp, cache = cache }+ return Engine { window = window, renderer = renderer, cache = Map.empty } + where+ (w, h) = windowDimensions+ wflags = foldl (.|.) 0 $ [SDL.windowFlagShown] +++ [SDL.windowFlagResizable | windowIsResizable] +++ [SDL.windowFlagFullscreen | windowIsFullscreen]+ rflags = (.|.) (SDL.rendererFlagPresentVSync) (SDL.rendererFlagAccelerated)+ {-| Initializes and runs the game engine. The supplied signal generator is constantly sampled for an element to render until the user quits. @@ -92,125 +93,131 @@ > main :: IO () > main = run defaultConfig $ lift render Window.dimensions -}-run :: EngineConfig -> SignalGen (Signal Element) -> IO ()-run (EngineConfig { .. }) gen = finally SDL.quit $ do- SDL.init [SDL.InitVideo, SDL.InitJoystick]- SDL.rawSetCaption (Just windowTitle) Nothing- when windowIsFullscreen $ SDL.getVideoSurface >>= SDL.toggleFullscreen- uncurry requestDimensions windowDimensions windowIsResizable- start gen >>= newEngineState >>= run'+run :: Engine -> SignalGen (Signal Element) -> IO ()+run engine gen = finally (start gen >>= run' engine) SDL.quit {-| A utility function called by 'run' that samples the element or quits the entire engine if SDL events say to do so. -}-run' :: EngineState -> IO ()-run' state = do+run' :: Engine -> IO Element -> IO ()+run' engine smp = do continue <- run'' - when continue $ smp state >>= render state >> run' state+ when continue $ do+ smp >>= render engine+ run' engine smp {-| A utility function called by 'run\'' that polls all SDL events off the stack, returning true if the game should keep running, false otherwise. -} run'' :: IO Bool-run'' = do- event <- SDL.pollEvent+run'' = alloca $ \eventptr -> do+ status <- SDL.pollEvent eventptr - case event of- SDL.NoEvent -> return True- SDL.Quit -> return False- SDL.VideoResize w h -> requestDimensions w h True >> run''- _ -> run''+ if status == 1 then do+ event <- peek eventptr + case event of+ SDL.QuitEvent _ _ -> return False+ _ -> run''+ else+ return True+ {-| A utility function that renders a previously sampled element using an engine state. -}-render :: EngineState -> Element -> IO ()-render state element = do- videoSurface <- SDL.getVideoSurface- let- w = SDL.surfaceGetWidth videoSurface- h = SDL.surfaceGetHeight videoSurface- cairoSurface <- SDL.createRGBSurface [SDL.HWSurface] w h 32 0x00ff0000 0x0000ff00 0x000000ff 0xff000000- render' state element videoSurface cairoSurface+render :: Engine -> Element -> IO ()+render engine@(Engine { .. }) element = alloca $ \wptr ->+ alloca $ \hptr ->+ alloca $ \pixelsptr ->+ alloca $ \pitchptr -> do+ SDL.getWindowSize window wptr hptr -{-| A utility function called by 'render\'' that does- the actual heavy lifting. -}-render' :: EngineState -> Element -> SDL.Surface -> SDL.Surface -> IO ()-render' state element videoSurface cairoSurface = do- pixels <- SDL.surfaceGetPixels cairoSurface+ w <- fromIntegral <$> peek wptr+ h <- fromIntegral <$> peek hptr - Cairo.withImageSurfaceForData (castPtr pixels) Cairo.FormatARGB32 w h (w * 4) $ \surface ->- Cairo.renderWith surface (render'' w h state element)+ -- We have to use a temporary constant here because the low-level SDL2 bindings+ -- don't seem to expose pixel format constants+ texture <- SDL.createTexture renderer 372645892 SDL.textureAccessStreaming (fromIntegral w) (fromIntegral h) - SDL.blitSurface cairoSurface Nothing videoSurface Nothing- SDL.flip videoSurface+ SDL.lockTexture texture nullPtr pixelsptr pitchptr - where- w = SDL.surfaceGetWidth videoSurface- h = SDL.surfaceGetHeight videoSurface+ pixels <- peek pixelsptr+ pitch <- fromIntegral <$> peek pitchptr -{-| A utility function called by 'render\'\'' that is called by Cairo+ Cairo.withImageSurfaceForData (castPtr pixels) Cairo.FormatARGB32 w h pitch $ \surface ->+ Cairo.renderWith surface (evalStateT (render' w h element) engine)++ SDL.unlockTexture texture++ SDL.renderClear renderer+ SDL.renderCopy renderer texture nullPtr nullPtr+ SDL.renderPresent renderer+++{-| A utility function called by 'render' that is called by Cairo when it's ready to do rendering. -}-render'' :: Int -> Int -> EngineState -> Element -> Cairo.Render ()-render'' w h state element = do- Cairo.setSourceRGB 0 0 0- Cairo.rectangle 0 0 (fromIntegral w) (fromIntegral h)- Cairo.fill+render' :: Int -> Int -> Element -> Helm ()+render' w h element = do+ lift $ do Cairo.setSourceRGB 0 0 0+ Cairo.rectangle 0 0 (fromIntegral w) (fromIntegral h)+ Cairo.fill - renderElement state element+ renderElement element {-| A utility function that lazily grabs an image surface from the cache, i.e. creating it if it's not already stored in it. -}-getSurface :: EngineState -> FilePath -> IO (Cairo.Surface, Int, Int)-getSurface (EngineState { cache }) src = do- cached <- Cairo.liftIO (readIORef cache)+getSurface :: FilePath -> Helm (Cairo.Surface, Int, Int)+getSurface src = do+ Engine _ _ cache <- get - case Map.lookup src cached of+ case Map.lookup src cache of Just surface -> do w <- Cairo.imageSurfaceGetWidth surface h <- Cairo.imageSurfaceGetHeight surface return (surface, w, h)+ Nothing -> do -- TODO: Use SDL_image to support more formats. I gave up after it was painful -- to convert between the two surface types safely. -- FIXME: Does this throw an error?- surface <- Cairo.imageSurfaceCreateFromPNG src- w <- Cairo.imageSurfaceGetWidth surface- h <- Cairo.imageSurfaceGetHeight surface+ surface <- liftIO $ Cairo.imageSurfaceCreateFromPNG src+ w <- liftIO $ Cairo.imageSurfaceGetWidth surface+ h <- liftIO $ Cairo.imageSurfaceGetHeight surface - writeIORef cache (Map.insert src surface cached) >> return (surface, w, h)+ modify (\engine -> engine{cache=Map.insert src surface cache})+ return (surface, w, h) {-| A utility function for rendering a specific element. -}-renderElement :: EngineState -> Element -> Cairo.Render ()-renderElement state (CollageElement w h center forms) = do- Cairo.save- Cairo.rectangle 0 0 (fromIntegral w) (fromIntegral h)- Cairo.clip- forM_ center $ uncurry Cairo.translate- mapM_ (renderForm state) forms- Cairo.restore+renderElement :: Element -> Helm ()+renderElement (CollageElement w h center forms) = do+ lift $ do Cairo.save+ Cairo.rectangle 0 0 (fromIntegral w) (fromIntegral h)+ Cairo.clip+ forM_ center $ uncurry Cairo.translate+ mapM_ renderForm forms+ lift $ Cairo.restore -renderElement state (ImageElement (sx, sy) sw sh src stretch) = do- (surface, w, h) <- Cairo.liftIO $ getSurface state (normalise src)+renderElement (ImageElement (sx, sy) sw sh src stretch) = do+ (surface, w, h) <- getSurface (normalise src) - Cairo.save- Cairo.translate (-fromIntegral sx) (-fromIntegral sy)+ lift $ do Cairo.save+ Cairo.translate (-fromIntegral sx) (-fromIntegral sy) - if stretch then- Cairo.scale (fromIntegral sw / fromIntegral w) (fromIntegral sh / fromIntegral h)- else- Cairo.scale 1 1+ if stretch then+ Cairo.scale (fromIntegral sw / fromIntegral w) (fromIntegral sh / fromIntegral h)+ else+ Cairo.scale 1 1 - Cairo.setSourceSurface surface 0 0- Cairo.translate (fromIntegral sx) (fromIntegral sy)- Cairo.rectangle 0 0 (fromIntegral sw) (fromIntegral sh)- Cairo.fill- Cairo.restore+ Cairo.setSourceSurface surface 0 0+ Cairo.translate (fromIntegral sx) (fromIntegral sy)+ Cairo.rectangle 0 0 (fromIntegral sw) (fromIntegral sh)+ Cairo.fill+ Cairo.restore -renderElement _ (TextElement (Text { textColor = (Color r g b a), .. })) = do- Cairo.save+renderElement (TextElement (Text { textColor = (Color r g b a), .. })) = do+ lift $ Cairo.save - layout <- Pango.createLayout textUTF8+ layout <- lift $ Pango.createLayout textUTF8 Cairo.liftIO $ Pango.layoutSetAttributes layout [Pango.AttrFamily { paStart = i, paEnd = j, paFamily = textTypeface }, Pango.AttrWeight { paStart = i, paEnd = j, paWeight = mapFontWeight textWeight },@@ -219,10 +226,10 @@ Pango.PangoRectangle x y w h <- fmap snd $ Cairo.liftIO $ Pango.layoutGetExtents layout - Cairo.translate ((-w / 2) -x) ((-h / 2) - y)- Cairo.setSourceRGBA r g b a- Pango.showLayout layout- Cairo.restore+ lift $ do Cairo.translate ((-w / 2) -x) ((-h / 2) - y)+ Cairo.setSourceRGBA r g b a+ Pango.showLayout layout+ Cairo.restore where i = 0@@ -243,8 +250,11 @@ ItalicStyle -> Pango.StyleItalic {-| A utility function that goes into a state of transformation and then pops it when finished. -}-withTransform :: Double -> Double -> Double -> Double -> Cairo.Render () -> Cairo.Render ()-withTransform s t x y f = Cairo.save >> Cairo.scale s s >> Cairo.translate x y >> Cairo.rotate t >> f >> Cairo.restore+withTransform :: Double -> Double -> Double -> Double -> Helm () -> Helm ()+withTransform s t x y f = do+ lift $ Cairo.save >> Cairo.scale s s >> Cairo.translate x y >> Cairo.rotate t+ f+ lift $ Cairo.restore {-| A utility function that sets the Cairo line cap based off of our version. -} setLineCap :: LineCap -> Cairo.Render ()@@ -275,22 +285,22 @@ {-| A utility function that sets up all the necessary settings with Cairo to render with a fill style and then fills afterwards. Assumes that all drawing paths have already been setup before being called. -}-setFillStyle :: EngineState -> FillStyle -> Cairo.Render ()-setFillStyle _ (Solid (Color r g b a)) = do- Cairo.setSourceRGBA r g b a- Cairo.fill+setFillStyle :: FillStyle -> Helm ()+setFillStyle (Solid (Color r g b a)) = do+ lift $ do Cairo.setSourceRGBA r g b a+ Cairo.fill -setFillStyle state (Texture src) = do- (surface, _, _) <- Cairo.liftIO $ getSurface state (normalise src)- Cairo.setSourceSurface surface 0 0- Cairo.getSource >>= flip Cairo.patternSetExtend Cairo.ExtendRepeat- Cairo.fill+setFillStyle (Texture src) = do+ (surface, _, _) <- getSurface (normalise src)+ lift $ do Cairo.setSourceSurface surface 0 0+ Cairo.getSource >>= flip Cairo.patternSetExtend Cairo.ExtendRepeat+ Cairo.fill -setFillStyle _ (Gradient (Linear (sx, sy) (ex, ey) points)) =- Cairo.withLinearPattern sx sy ex ey $ \pattern -> setFillStyle' pattern points+setFillStyle (Gradient (Linear (sx, sy) (ex, ey) points)) =+ lift $ Cairo.withLinearPattern sx sy ex ey $ \pattern -> setFillStyle' pattern points -setFillStyle _ (Gradient (Radial (sx, sy) sr (ex, ey) er points)) =- Cairo.withRadialPattern sx sy sr ex ey er $ \pattern -> setFillStyle' pattern points+setFillStyle (Gradient (Radial (sx, sy) sr (ex, ey) er points)) =+ lift $ Cairo.withRadialPattern sx sy sr ex ey er $ \pattern -> setFillStyle' pattern points {-| A utility function that adds color stops to a pattern and then fills it. -} setFillStyle' :: Cairo.Pattern -> [(Double, Color)] -> Cairo.Render ()@@ -300,35 +310,35 @@ Cairo.fill {-| A utility that renders a form. -}-renderForm :: EngineState -> Form -> Cairo.Render ()-renderForm state Form { .. } = withTransform formScale formTheta formX formY $+renderForm :: Form -> Helm ()+renderForm Form { .. } = withTransform formScale formTheta formX formY $ case formStyle of PathForm style ~ps @ ((hx, hy) : _) -> do- Cairo.newPath- Cairo.moveTo hx hy- mapM_ (uncurry Cairo.lineTo) ps- setLineStyle style+ lift $ do Cairo.newPath+ Cairo.moveTo hx hy+ mapM_ (uncurry Cairo.lineTo) ps+ setLineStyle style ShapeForm style shape -> do- Cairo.newPath+ lift $ Cairo.newPath case shape of PolygonShape ~ps @ ((hx, hy) : _) -> do- Cairo.moveTo hx hy- mapM_ (uncurry Cairo.lineTo) ps+ lift $ do Cairo.moveTo hx hy+ mapM_ (uncurry Cairo.lineTo) ps - RectangleShape (w, h) -> Cairo.rectangle (-w / 2) (-h / 2) w h+ RectangleShape (w, h) -> lift $ Cairo.rectangle (-w / 2) (-h / 2) w h ArcShape (cx, cy) a1 a2 r (sx, sy) -> do- Cairo.scale sx sy- Cairo.arc cx cy r a1 a2- Cairo.scale 1 1+ lift $ do Cairo.scale sx sy+ Cairo.arc cx cy r a1 a2+ Cairo.scale 1 1 - either setLineStyle (setFillStyle state) style+ either (lift . setLineStyle) setFillStyle style - ElementForm element -> renderElement state element+ ElementForm element -> renderElement element GroupForm mayhaps forms -> do- Cairo.save- forM_ mayhaps Cairo.setMatrix- mapM_ (renderForm state) forms- Cairo.restore+ lift $ do Cairo.save+ forM_ mayhaps Cairo.setMatrix+ mapM_ renderForm forms+ lift $ Cairo.restore
src/FRP/Helm/Animation.hs view
@@ -3,7 +3,7 @@ -- * Types Frame, Animation,- Status(..),+ AnimationStatus(..), -- * Creating absolute, relative,@@ -18,7 +18,7 @@ import FRP.Elerea.Simple import Control.Applicative import FRP.Helm.Graphics (Form,blank)-import FRP.Helm.Time (Time)+import FRP.Helm.Time (Time, inMilliseconds) import Data.Maybe (fromJust) import Data.List (find) import qualified Data.List as List (length)@@ -28,23 +28,25 @@ actually looks when rendered. -} type Frame = (Time, Form) - {-| A type describing an animation consisting of a list of frames. -} type Animation = [Frame] -{-| This type tells of the state an animation is in.- Continue: A continued animation plays through its frames as specified in the Animation.- Pause: A paused animation does not change its current frame and time.- Stop: A stopped animation is set to its first frame and time 0.- Frame: The Frame constructor can be used to choose a specific frame of the animation- where time is set to the first millisecond of that chosen frame. (Indexing starts at 1. 'first frame', not 'zero frame')- Time: The Time constructor sets the current time (in milliseconds) in the animation to the specified value. -}-data Status = Continue | Pause | Stop | Frame Int | Time Time+{-| A data structure that can be used to manage the status of the animation. -}+data AnimationStatus+ -- | The animation continues to play through its frames.+ = Cycle+ -- | The animation is paused.+ | Pause+ -- | The animation is stopped, jumping back to the first frame and initial time.+ | Stop+ -- | The animation is set to a specific one-indexed frame.+ | SetFrame Int+ -- | The animation is set to a specific time and its related frame.+ | SetTime Time {-| Creates an animation from a list of frames. The time value in each frame is absolute to the entire animation, i.e. each time value is the time- at which the frame takes place relative to the starting time of the animation.- -}+ at which the frame takes place relative to the starting time of the animation. -} absolute :: [Frame] -> Animation absolute = id @@ -52,35 +54,32 @@ is relative to other frames, i.e. each time value is the difference in time from the last frame. - > relative [(100, picture1), (100, picture2), (300, picture3)] == absolute [(100, picture1), (200, picture2), (500, picture3)]+ > relative [(100 * millisecond, picture1), (100 * millisecond, picture2)] == absolute [(100 * millisecond, picture1), (200 * millisecond, picture2)] -} relative :: [Frame] -> Animation relative = scanl1 (\acc x -> (fst acc + fst x, snd x)) -{-| Creates a signal contained in a generator that returns the current form in the animation when sampled from- a specific animation. The second argument is a signal generator containing a signal that- returns the time to setup the animation forward when sampled. The third argument is a- signal generator containing a signal that returns true to continue animating- or false to stop animating when sampled. -}-animate :: Animation -> SignalGen (Signal Time) -> SignalGen (Signal Status) -> SignalGen (Signal Form)+{-| Creates a signal that returns the current form in the animation when sampled from+ a specific animation. The second argument is a signal that returns the time to+ setup the animation forward when sampled. The third argument is a signal that returns+ the status of the animation, allowing you to control it. -}+animate :: Animation -> SignalGen (Signal Time) -> SignalGen (Signal AnimationStatus) -> SignalGen (Signal Form) animate [] _ _ = return $ return blank animate anim dt status = do dt1 <- dt status1 <- status- progress <- transfer2 0 (timestep anim) status1 dt1+ progress <- transfer2 0 (timestep anim) status1 $ inMilliseconds <$> dt1 return $ fromJust <$> formAt anim <$> progress -{-| Makes a step in the Animation of size dt, but also takes care to:- start over if the end was reached.- behave in accordance to the possible statuses,- handle erroneous input gently (this may do more bad than good since it may be unexpected, please dispute!) -}-timestep :: Animation -> Status -> Time -> Time -> Time-timestep anim Continue dt t = cycleTime anim (dt + t)-timestep _ Pause _ t = t-timestep _ Stop _ _ = 0-timestep anim (Time sT) _ _ = cycleTime anim sT-timestep anim (Frame f) _ _ = gentleIndex anim f+{-| Steps the animation but also cycles if the end is reached, handles any statuses and+ tries to pickup any issues and handle them silently. -}+timestep :: Animation -> AnimationStatus -> Time -> Time -> Time+timestep anim Cycle dt t = cycleTime anim (dt + t)+timestep _ Pause _ t = t+timestep _ Stop _ _ = 0+timestep anim (SetTime sT) _ _ = cycleTime anim $ inMilliseconds sT+timestep anim (SetFrame f) _ _ = gentleIndex anim f where gentleIndex [] _ = 0 gentleIndex xs n = fst $ xs !! (cycleFrames anim n -1)
− src/FRP/Helm/Automaton.hs
@@ -1,73 +0,0 @@-{-| Contains all data structures and functions for composing, calculating and creating automatons. -}-module FRP.Helm.Automaton (- -- * Types- Automaton(..),- -- * Composing- pure,- stateful,- combine,- -- * Computing- step,- run,- counter-) where--import Control.Arrow-import Control.Category-import Prelude hiding (id, (.))-import FRP.Elerea.Simple (Signal, SignalGen, transfer)--{-| A data structure describing an automaton.- An automaton is essentially a high-level way to package piped behavior- between an input signal and an output signal. Automatons can also- be composed, allowing you to connect one automaton to another- and pipe data between them. Automatons are an easy and powerful way- to create composable dynamic behavior, like animation systems. -}-data Automaton a b = Step (a -> (Automaton a b, b))--instance Category Automaton where- id = Step (\a -> (id, a))- (Step f) . (Step g) = Step (\a -> let (g', b) = g a- (f', c) = f b in (f' . g', c))--instance Arrow Automaton where- arr = pure- first (Step f) = Step (\(b, d) -> let (f', c) = f b in (first f', (c, d)))--{-| Creates a pure automaton that has no accumulated state. It applies input to- a function at each step. -}-pure :: (a -> b) -> Automaton a b-pure f = Step (\x -> (pure f, f x))--{-| Creates an automaton that has an initial and accumulated state. It applies- input and the last state to a function at each step. -}-stateful :: b -> (a -> b -> b) -> Automaton a b-stateful state f = Step (\x -> let state' = f x state in (stateful state' f, state'))--{-| Steps an automaton forward, returning the next automaton to step- and output of the step in a tuple. -}-step :: a -> Automaton a b -> (Automaton a b, b)-step auto (Step f) = f auto--{-| Combines a list of automatons that take some input- and turns it into an automaton that takes- the same input and outputs a list of all outputs- from each separate automaton. -}-combine :: [Automaton a b] -> Automaton a [b]-combine autos =- Step (\a -> let (autos', bs) = unzip $ map (step a) autos- in (combine autos', bs))--{-| A useful automaton that outputs the amount of times it has been stepped,- discarding its input value. -}-counter :: Automaton a Int-counter = stateful 0 (\_ c -> c + 1)--{-| Runs an automaton with an initial output value and input signal generator- and creates an output signal generator that contains a signal that can be- sampled for the output value. -}-run :: Automaton a b -> b -> SignalGen (Signal a) -> SignalGen (Signal b)-run auto ini feeder = do- food <- feeder >>= transfer (auto, ini) (\a (Step f, _) -> f a)-- return $ fmap snd food
src/FRP/Helm/Color.hs view
@@ -42,11 +42,16 @@ {-| Creates an RGB color. -} rgb :: Double -> Double -> Double -> Color-rgb r g b = Color r g b 1+rgb r g b = rgba r g b 1 {-| Creates an RGB color, with transparency. -} rgba :: Double -> Double -> Double -> Double -> Color-rgba = Color+rgba r g b a+ | r < 0 || r > 1 ||+ g < 0 || g > 1 ||+ b < 0 || b > 1 ||+ a < 0 || a > 1 = error "FRP.Helm.Color.rgba: color components must be between 0 and 1"+ | otherwise = Color r g b a {-| A bright red color. -} red :: Color
− src/FRP/Helm/Joystick.hs
@@ -1,105 +0,0 @@-{-| Contains signals that sample input from joysticks. -}-module FRP.Helm.Joystick (- -- * Types- Joystick,- -- * Probing- available,- name,- open,- index,- availableAxes,- availableBalls,- availableHats,- availableButtons,- -- * Joystick State- axis,- hat,- button,- ball-) where--import Control.Applicative-import Data.Int (Int16)-import FRP.Elerea.Simple-import qualified Graphics.UI.SDL as SDL--{-| A type describing a joystick. -}-type Joystick = SDL.Joystick--{-| The amount of joysticks available. -}-available :: SignalGen (Signal Int)-available = effectful SDL.countAvailable--{-| The name of a joystick. Can throw an exception when sampled if the joystick index is invalid. -}-name :: Int -> SignalGen (Signal String)-name i = effectful $ SDL.name i--{-| The joystick at a certain slot. Can throw an exception when sampled if the joystick index is invalid. -}-open :: Int -> SignalGen (Signal Joystick)-open i = effectful $ SDL.open i--{-| The index of a joystick. -}-index :: Joystick -> SignalGen (Signal Int)-index j = return $ return $ SDL.index j--{-| The amount of axes available for a joystick. -}-availableAxes :: Joystick -> SignalGen (Signal Int)-availableAxes j = return $ return $ SDL.axesAvailable j--{-| The amount of balls available for a joystick. -}-availableBalls :: Joystick -> SignalGen (Signal Int)-availableBalls j = return $ return $ SDL.ballsAvailable j--{-| The amount of hats available for a joystick. -}-availableHats :: Joystick -> SignalGen (Signal Int)-availableHats j = return $ return $ SDL.hatsAvailable j--{-| The amount of buttons available for a joystick. -}-availableButtons :: Joystick -> SignalGen (Signal Int)-availableButtons j = return $ return $ SDL.buttonsAvailable j--{-| The current state of the axis of the joystick. -}-axis :: Joystick -> Int -> SignalGen (Signal Int)-axis j i = effectful $ SDL.update >> fromIntegral <$> SDL.getAxis j (fromIntegral i)--{-| The current state of the hat of the joystick, returned- as a directional tuple. For example, up is /(0, -1)/,- left /(-1, 0)/, bottom-right is /(1, 1)/, etc. -}-hat :: Joystick -> Int -> SignalGen (Signal (Int, Int))-hat j i = effectful $ SDL.update >> hat' <$> SDL.getHat j (fromIntegral i)--{-| A utility function for mapping a list of hat states to an averaged directional tuple. -}-hat' :: [SDL.Hat] -> (Int, Int)-hat' hats = if l > 0 then (round $ fromIntegral hx / l, round $ fromIntegral hy / l) else (0, 0)- where- l = realToFrac $ length hats :: Double- (hx, hy) = foldl hat'' (0, 0) hats--{-| A utility function for accumulating the total directional tuple. -}-hat'' :: (Int, Int) -> SDL.Hat -> (Int, Int)-hat'' (x, y) h =- case h of- SDL.HatCentered -> (x, y)- SDL.HatUp -> (x, y - 1)- SDL.HatRight -> (x + 1, y)- SDL.HatDown -> (x, y + 1)- SDL.HatLeft -> (x - 1, y)- SDL.HatRightUp -> (x + 1, y - 1)- SDL.HatRightDown -> (x + 1, y + 1)- SDL.HatLeftUp -> (x - 1, x - 1)- SDL.HatLeftDown -> (x - 1, y + 1)--{-| The current state of the button of the joystick. -}-button :: Joystick -> Int -> SignalGen (Signal Bool)-button j i = effectful $ SDL.update >> SDL.getButton j (fromIntegral i)--{-| The current state of the ball of the joystick. -}-ball :: Joystick -> Int -> SignalGen (Signal (Int, Int))-ball j i = effectful $ SDL.update >> ball' <$> SDL.getBall j (fromIntegral i)--{-| A utility function for mapping the optional value to a null tuple or the actual tuple. -}-ball' :: Maybe (Int16, Int16) -> (Int, Int)-ball' mayhaps =- case mayhaps of- Just (x, y) -> (fromIntegral x, fromIntegral y)- Nothing -> (0, 0)
src/FRP/Helm/Keyboard.hs view
@@ -3,350 +3,761 @@ -- * Types Key(..), -- * Key State- shift, ctrl, enter,- space, isDown, keysDown,- -- * Directions- arrows, wasd-) where--import Control.Applicative-import Data.List-import Foreign hiding (shift)-import Foreign.C.Types-import FRP.Elerea.Simple-import qualified Graphics.UI.SDL as SDL--{-| The SDL bindings for Haskell don't wrap this, so we have to use the FFI ourselves. -}-foreign import ccall unsafe "SDL_GetKeyState" sdlGetKeyState :: Ptr CInt -> IO (Ptr Word8)--{-| A utility function for getting a list of SDL keys currently pressed.- Based on <http://coderepos.org/share/browser/lang/haskell/nario/Main.hs?rev=22646#L49>. -}-getKeyState :: IO [Int]-getKeyState = alloca $ \numkeysPtr -> do- keysPtr <- sdlGetKeyState numkeysPtr- numkeys <- peek numkeysPtr-- (map fromIntegral . elemIndices 1) <$> peekArray (fromIntegral numkeys) keysPtr--{-| A data structure describing a physical key on a keyboard. -}-data Key = BackspaceKey | TabKey | ClearKey | EnterKey | PauseKey | EscapeKey |- SpaceKey | ExclaimKey | QuotedBlKey | HashKey | DollarKey | AmpersandKey |- QuoteKey | LeftParenKey | RightParenKey | AsteriskKey | PlusKey | CommaKey |- MinusKey | PeriodKey | SlashKey | Num0Key | Num1Key | Num2Key |- Num3Key | Num4Key | Num5Key | Num6Key | Num7Key | Num8Key |- Num9Key | ColonKey | SemicolonKey | LessKey | EqualsKey | GreaterKey |- QuestionKey | AtKey | LeftBracketKey | BackslashKey | RightBracketKey | CaretKey |- UnderscoreKey | BackquoteKey | AKey | BKey | CKey | DKey |- EKey | FKey | GKey | HKey | IKey | JKey | KKey |- LKey | MKey | NKey | OKey | PKey | QKey |- RKey | SKey | TKey | UKey | VKey | WKey |- XKey | YKey | ZKey | DeleteKey | KeypadNum0Key | KeypadNum1Key |- KeypadNum2Key | KeypadNum3Key | KeypadNum4Key | KeypadNum5Key | KeypadNum6Key | KeypadNum7Key |- KeypadNum8Key | KeypadNum9Key | KeypadPeriodKey | KeypadDivideKey | KeypadMultiplyKey | KeypadMinusKey |- KeypadPlusKey | KeypadEnterKey | KeypadEqualsKey | UpKey | DownKey | RightKey |- LeftKey | InsertKey | HomeKey | EndKey | PageUpKey | PageDownKey |- F1Key | F2Key | F3Key | F4Key | F5Key | F6Key |- F7Key | F8Key | F9Key | F10Key | F11Key | F12Key |- F13Key | F14Key | F15Key | NumLockKey | CapsLockKey | ScrollLockKey |- RShiftKey | LShiftKey | RCtrlKey | LCtrlKey | RAltKey | LAltKey |- RMetaKey | LMetaKey | RSuperKey | LSuperKey | ModeKey | ComposeKey | HelpKey |- PrintKey | SysReqKey | BreakKey | MenuKey | PowerKey | EuroKey |- UndoKey deriving (Show, Eq, Ord, Read)--{- All integer values of this enum are equivalent to the SDL key enum. -}-instance Enum Key where- fromEnum BackspaceKey = 8- fromEnum TabKey = 9- fromEnum ClearKey = 12- fromEnum EnterKey = 13- fromEnum PauseKey = 19- fromEnum EscapeKey = 27- fromEnum SpaceKey = 32- fromEnum ExclaimKey = 33- fromEnum QuotedBlKey = 34- fromEnum HashKey = 35- fromEnum DollarKey = 36- fromEnum AmpersandKey = 38- fromEnum QuoteKey = 39- fromEnum LeftParenKey = 40- fromEnum RightParenKey = 41- fromEnum AsteriskKey = 42- fromEnum PlusKey = 43- fromEnum CommaKey = 44- fromEnum MinusKey = 45- fromEnum PeriodKey = 46- fromEnum SlashKey = 47- fromEnum Num0Key = 48- fromEnum Num1Key = 49- fromEnum Num2Key = 50- fromEnum Num3Key = 51- fromEnum Num4Key = 52- fromEnum Num5Key = 53- fromEnum Num6Key = 54- fromEnum Num7Key = 55- fromEnum Num8Key = 56- fromEnum Num9Key = 57- fromEnum ColonKey = 58- fromEnum SemicolonKey = 59- fromEnum LessKey = 60- fromEnum EqualsKey = 61- fromEnum GreaterKey = 62- fromEnum QuestionKey = 63- fromEnum AtKey = 64- fromEnum LeftBracketKey = 91- fromEnum BackslashKey = 92- fromEnum RightBracketKey = 93- fromEnum CaretKey = 94- fromEnum UnderscoreKey = 95- fromEnum BackquoteKey = 96- fromEnum AKey = 97- fromEnum BKey = 98- fromEnum CKey = 99- fromEnum DKey = 100- fromEnum EKey = 101- fromEnum FKey = 102- fromEnum GKey = 103- fromEnum HKey = 104- fromEnum IKey = 105- fromEnum JKey = 106- fromEnum KKey = 107- fromEnum LKey = 108- fromEnum MKey = 109- fromEnum NKey = 110- fromEnum OKey = 111- fromEnum PKey = 112- fromEnum QKey = 113- fromEnum RKey = 114- fromEnum SKey = 115- fromEnum TKey = 116- fromEnum UKey = 117- fromEnum VKey = 118- fromEnum WKey = 119- fromEnum XKey = 120- fromEnum YKey = 121- fromEnum ZKey = 122- fromEnum DeleteKey = 127- fromEnum KeypadNum0Key = 256- fromEnum KeypadNum1Key = 257- fromEnum KeypadNum2Key = 258- fromEnum KeypadNum3Key = 259- fromEnum KeypadNum4Key = 260- fromEnum KeypadNum5Key = 261- fromEnum KeypadNum6Key = 262- fromEnum KeypadNum7Key = 263- fromEnum KeypadNum8Key = 264- fromEnum KeypadNum9Key = 265- fromEnum KeypadPeriodKey = 266- fromEnum KeypadDivideKey = 267- fromEnum KeypadMultiplyKey = 268- fromEnum KeypadMinusKey = 269- fromEnum KeypadPlusKey = 270- fromEnum KeypadEnterKey = 271- fromEnum KeypadEqualsKey = 272- fromEnum UpKey = 273- fromEnum DownKey = 274- fromEnum RightKey = 275- fromEnum LeftKey = 276- fromEnum InsertKey = 277- fromEnum HomeKey = 278- fromEnum EndKey = 279- fromEnum PageUpKey = 280- fromEnum PageDownKey = 281- fromEnum F1Key = 282- fromEnum F2Key = 283- fromEnum F3Key = 284- fromEnum F4Key = 285- fromEnum F5Key = 286- fromEnum F6Key = 287- fromEnum F7Key = 288- fromEnum F8Key = 289- fromEnum F9Key = 290- fromEnum F10Key = 291- fromEnum F11Key = 292- fromEnum F12Key = 293- fromEnum F13Key = 294- fromEnum F14Key = 295- fromEnum F15Key = 296- fromEnum NumLockKey = 300- fromEnum CapsLockKey = 301- fromEnum ScrollLockKey = 302- fromEnum RShiftKey = 303- fromEnum LShiftKey = 304- fromEnum RCtrlKey = 305- fromEnum LCtrlKey = 306- fromEnum RAltKey = 307- fromEnum LAltKey = 308- fromEnum RMetaKey = 309- fromEnum LMetaKey = 310- fromEnum LSuperKey = 311- fromEnum RSuperKey = 312- fromEnum ModeKey = 313- fromEnum ComposeKey = 314- fromEnum HelpKey = 315- fromEnum PrintKey = 316- fromEnum SysReqKey = 317- fromEnum BreakKey = 318- fromEnum MenuKey = 319- fromEnum PowerKey = 320- fromEnum EuroKey = 321- fromEnum UndoKey = 322-- toEnum 8 = BackspaceKey- toEnum 9 = TabKey- toEnum 12 = ClearKey- toEnum 13 = EnterKey- toEnum 19 = PauseKey- toEnum 27 = EscapeKey- toEnum 32 = SpaceKey- toEnum 33 = ExclaimKey- toEnum 34 = QuotedBlKey- toEnum 35 = HashKey- toEnum 36 = DollarKey- toEnum 38 = AmpersandKey- toEnum 39 = QuoteKey- toEnum 40 = LeftParenKey- toEnum 41 = RightParenKey- toEnum 42 = AsteriskKey- toEnum 43 = PlusKey- toEnum 44 = CommaKey- toEnum 45 = MinusKey- toEnum 46 = PeriodKey- toEnum 47 = SlashKey- toEnum 48 = Num0Key- toEnum 49 = Num1Key- toEnum 50 = Num2Key- toEnum 51 = Num3Key- toEnum 52 = Num4Key- toEnum 53 = Num5Key- toEnum 54 = Num6Key- toEnum 55 = Num7Key- toEnum 56 = Num8Key- toEnum 57 = Num9Key- toEnum 58 = ColonKey- toEnum 59 = SemicolonKey- toEnum 60 = LessKey- toEnum 61 = EqualsKey- toEnum 62 = GreaterKey- toEnum 63 = QuestionKey- toEnum 64 = AtKey- toEnum 91 = LeftBracketKey- toEnum 92 = BackslashKey- toEnum 93 = RightBracketKey- toEnum 94 = CaretKey- toEnum 95 = UnderscoreKey- toEnum 96 = BackquoteKey- toEnum 97 = AKey- toEnum 98 = BKey- toEnum 99 = CKey- toEnum 100 = DKey- toEnum 101 = EKey- toEnum 102 = FKey- toEnum 103 = GKey- toEnum 104 = HKey- toEnum 105 = IKey- toEnum 106 = JKey- toEnum 107 = KKey- toEnum 108 = LKey- toEnum 109 = MKey- toEnum 110 = NKey- toEnum 111 = OKey- toEnum 112 = PKey- toEnum 113 = QKey- toEnum 114 = RKey- toEnum 115 = SKey- toEnum 116 = TKey- toEnum 117 = UKey- toEnum 118 = VKey- toEnum 119 = WKey- toEnum 120 = XKey- toEnum 121 = YKey- toEnum 122 = ZKey- toEnum 127 = DeleteKey- toEnum 256 = KeypadNum0Key- toEnum 257 = KeypadNum1Key- toEnum 258 = KeypadNum2Key- toEnum 259 = KeypadNum3Key- toEnum 260 = KeypadNum4Key- toEnum 261 = KeypadNum5Key- toEnum 262 = KeypadNum6Key- toEnum 263 = KeypadNum7Key- toEnum 264 = KeypadNum8Key- toEnum 265 = KeypadNum9Key- toEnum 266 = KeypadPeriodKey- toEnum 267 = KeypadDivideKey- toEnum 268 = KeypadMultiplyKey- toEnum 269 = KeypadMinusKey- toEnum 270 = KeypadPlusKey- toEnum 271 = KeypadEnterKey- toEnum 272 = KeypadEqualsKey- toEnum 273 = UpKey- toEnum 274 = DownKey- toEnum 275 = RightKey- toEnum 276 = LeftKey- toEnum 277 = InsertKey- toEnum 278 = HomeKey- toEnum 279 = EndKey- toEnum 280 = PageUpKey- toEnum 281 = PageDownKey- toEnum 282 = F1Key- toEnum 283 = F2Key- toEnum 284 = F3Key- toEnum 285 = F4Key- toEnum 286 = F5Key- toEnum 287 = F6Key- toEnum 288 = F7Key- toEnum 289 = F8Key- toEnum 290 = F9Key- toEnum 291 = F10Key- toEnum 292 = F11Key- toEnum 293 = F12Key- toEnum 294 = F13Key- toEnum 295 = F14Key- toEnum 296 = F15Key- toEnum 300 = NumLockKey- toEnum 301 = CapsLockKey- toEnum 302 = ScrollLockKey- toEnum 303 = RShiftKey- toEnum 304 = LShiftKey- toEnum 305 = RCtrlKey- toEnum 306 = LCtrlKey- toEnum 307 = RAltKey- toEnum 308 = LAltKey- toEnum 309 = RMetaKey- toEnum 310 = LMetaKey- toEnum 311 = LSuperKey- toEnum 312 = RSuperKey- toEnum 313 = ModeKey- toEnum 314 = ComposeKey- toEnum 315 = HelpKey- toEnum 316 = PrintKey- toEnum 317 = SysReqKey- toEnum 318 = BreakKey- toEnum 319 = MenuKey- toEnum 320 = PowerKey- toEnum 321 = EuroKey- toEnum 322 = UndoKey- toEnum _ = error "FRP.Helm.Keyboard.Key.toEnum: bad argument"--{-| Whether either shift key is pressed. -}-shift :: SignalGen (Signal Bool)-shift = effectful $ elem SDL.KeyModShift <$> SDL.getModState--{-| Whether either control key is pressed. -}-ctrl :: SignalGen (Signal Bool)-ctrl = effectful $ elem SDL.KeyModCtrl <$> SDL.getModState--{-| Whether a key is pressed. -}-isDown :: Key -> SignalGen (Signal Bool)-isDown k = effectful $ elem (fromEnum k) <$> getKeyState--{-| Whether the enter (a.k.a. return) key is pressed. -}-enter :: SignalGen (Signal Bool)-enter = isDown EnterKey--{-| Whether the space key is pressed. -}-space :: SignalGen (Signal Bool)-space = isDown SpaceKey+ isDown, keysDown,+ -- * Directions+ arrows, wasd+) where++import Control.Applicative+import Data.List+import Foreign hiding (shift)+import Foreign.C.Types+import FRP.Elerea.Simple++{-| The SDL bindings for Haskell don't wrap this, so we have to use the FFI ourselves. -}+foreign import ccall unsafe "SDL_GetKeyboardState" sdlGetKeyState :: Ptr CInt -> IO (Ptr Word8)++{-| A utility function for getting a list of SDL keys currently pressed.+ Based on <http://coderepos.org/share/browser/lang/haskell/nario/Main.hs?rev=22646#L49>. -}+getKeyState :: IO [Int]+getKeyState = alloca $ \numkeysPtr -> do+ keysPtr <- sdlGetKeyState numkeysPtr+ numkeys <- peek numkeysPtr++ (map fromIntegral . elemIndices 1) <$> peekArray (fromIntegral numkeys) keysPtr++{-| A data structure describing a physical key on a keyboard. -}+data Key+ = AKey+ | BKey+ | CKey+ | DKey+ | EKey+ | FKey+ | GKey+ | HKey+ | IKey+ | JKey+ | KKey+ | LKey+ | MKey+ | NKey+ | OKey+ | PKey+ | QKey+ | RKey+ | SKey+ | TKey+ | UKey+ | VKey+ | WKey+ | XKey+ | YKey+ | ZKey+ | Number1Key+ | Number2Key+ | Number3Key+ | Number4Key+ | Number5Key+ | Number6Key+ | Number7Key+ | Number8Key+ | Number9Key+ | Number0Key+ | ReturnKey+ | EscapeKey+ | BackspaceKey+ | TabKey+ | SpaceKey+ | MinusKey+ | EqualsKey+ | LeftBracketKey+ | RightBracketKey+ | BackslashKey+ | NonUSHashKey+ | SemicolonKey+ | ApostropheKey+ | GraveKey+ | CommaKey+ | PeriodKey+ | SlashKey+ | CapslockKey+ | F1Key+ | F2Key+ | F3Key+ | F4Key+ | F5Key+ | F6Key+ | F7Key+ | F8Key+ | F9Key+ | F10Key+ | F11Key+ | F12Key+ | PrintScreenKey+ | ScrollLockKey+ | PauseKey+ | InsertKey+ | HomeKey+ | PageUpKey+ | DeleteKey+ | EndKey+ | PageDownKey+ | RightKey+ | LeftKey+ | DownKey+ | UpKey+ | NumLockClearKey+ | KeypadDivideKey+ | KeypadMultiplyKey+ | KeypadMinusKey+ | KeypadPlusKey+ | KeypadEnterKey+ | Keypad1Key+ | Keypad2Key+ | Keypad3Key+ | Keypad4Key+ | Keypad5Key+ | Keypad6Key+ | Keypad7Key+ | Keypad8Key+ | Keypad9Key+ | Keypad0Key+ | KeypadPeriodKey+ | NonUSBackslashKey+ | ApplicationKey+ | PowerKey+ | KeypadEqualsKey+ | F13Key+ | F14Key+ | F15Key+ | F16Key+ | F17Key+ | F18Key+ | F19Key+ | F20Key+ | F21Key+ | F22Key+ | F23Key+ | F24Key+ | ExecuteKey+ | HelpKey+ | MenuKey+ | SelectKey+ | StopKey+ | AgainKey+ | UndoKey+ | CutKey+ | CopyKey+ | PasteKey+ | FindKey+ | MuteKey+ | VolumeUpKey+ | VolumeDownKey+ | KeypadCommaKey+ | KeyPadEqualsAs400Key+ | International1Key+ | International2Key+ | International3Key+ | International4Key+ | International5Key+ | International6Key+ | International7Key+ | International8Key+ | International9Key+ | Lang1Key+ | Lang2Key+ | Lang3Key+ | Lang4Key+ | Lang5Key+ | Lang6Key+ | Lang7Key+ | Lang8Key+ | Lang9Key+ | AltEraseKey+ | SysReqKey+ | CancelKey+ | ClearKey+ | PriorKey+ | Return2Key+ | SeparatorKey+ | OutKey+ | OperKey+ | ClearAgainKey+ | CrSelKey+ | ExSelKey+ | Keypad00Key+ | Keypad000Key+ | ThousandSeparatorKey+ | DecimalSeparatorKey+ | CurrencyUnitKey+ | CurrencySubUnitKey+ | KeypadLeftParenKey+ | KeypadRightParenKey+ | KeypadLeftBraceKey+ | KeypadRightBraceKey+ | KeypadTabKey+ | KeypadBackspaceKey+ | KeypadAKey+ | KeypadBKey+ | KeypadCKey+ | KeypadDKey+ | KeypadEKey+ | KeypadFKey+ | KeypadXORKey+ | KeypadPowerKey+ | KeypadPercentKey+ | KeypadLessKey+ | KeypadGreaterKey+ | KeypadAmpersandKey+ | KeypadDoubleAmpersandKey+ | KeypadVerticalBarKey+ | KeypadDoubleVerticalBarKey+ | KeypadColonKey+ | KeypadHashKey+ | KeypadSpaceKey+ | KeypadAtKey+ | KeypadExclamationKey+ | KeypadMemStoreKey+ | KeypadMemRecallKey+ | KeypadMemClearKey+ | KeypadMemAddKey+ | KeypadMemSubstractKey+ | KeypadMemMultiplyKey+ | KeypadMemDivideKey+ | KeypadPlusMinusKey+ | KeypadClearKey+ | KeypadClearEntryKey+ | KeypadBinaryKey+ | KeypadOctalKey+ | KeypadDecimalKey+ | KeypadHexadecimalKey+ | LeftControlKey+ | LeftShiftKey+ | LeftAltKey+ | LeftMetaKey+ | RightControlKey+ | RightShiftKey+ | RightAltKey+ | RightMetaKey+ | ModeKey+ | AudioNextKey+ | AudioPreviousKey+ | AudioStopKey+ | AudioPlayKey+ | AudioMuteKey+ | MediaSelectKey+ | WWWKey+ | MailKey+ | CalculatorKey+ | ComputerKey+ | ACSearchKey+ | ACHomeKey+ | ACBackKey+ | ACForwardKey+ | ACStopKey+ | ACRefreshKey+ | ACBookmarksKey+ | BrightnessDownKey+ | BrightnessUpKey+ | DisplaySwitchKey+ | KeyboardIllumToggleKey+ | KeyboardIllumDownKey+ | KeyboardIllumUpKey+ | EjectKey+ | SleepKey+ | App1Key+ | App2Key+ deriving (Show, Eq, Ord, Read)++{- All integer values of this enum are equivalent to the SDL scancode enum. -}+instance Enum Key where+ fromEnum AKey = 4+ fromEnum BKey = 5+ fromEnum CKey = 6+ fromEnum DKey = 7+ fromEnum EKey = 8+ fromEnum FKey = 9+ fromEnum GKey = 10+ fromEnum HKey = 11+ fromEnum IKey = 12+ fromEnum JKey = 13+ fromEnum KKey = 14+ fromEnum LKey = 15+ fromEnum MKey = 16+ fromEnum NKey = 17+ fromEnum OKey = 18+ fromEnum PKey = 19+ fromEnum QKey = 20+ fromEnum RKey = 21+ fromEnum SKey = 22+ fromEnum TKey = 23+ fromEnum UKey = 24+ fromEnum VKey = 25+ fromEnum WKey = 26+ fromEnum XKey = 27+ fromEnum YKey = 28+ fromEnum ZKey = 29+ fromEnum Number1Key = 30+ fromEnum Number2Key = 31+ fromEnum Number3Key = 32+ fromEnum Number4Key = 33+ fromEnum Number5Key = 34+ fromEnum Number6Key = 35+ fromEnum Number7Key = 36+ fromEnum Number8Key = 37+ fromEnum Number9Key = 38+ fromEnum Number0Key = 39+ fromEnum ReturnKey = 40+ fromEnum EscapeKey = 41+ fromEnum BackspaceKey = 42+ fromEnum TabKey = 43+ fromEnum SpaceKey = 44+ fromEnum MinusKey = 45+ fromEnum EqualsKey = 46+ fromEnum LeftBracketKey = 47+ fromEnum RightBracketKey = 48+ fromEnum BackslashKey = 49+ fromEnum NonUSHashKey = 50+ fromEnum SemicolonKey = 51+ fromEnum ApostropheKey = 52+ fromEnum GraveKey = 53+ fromEnum CommaKey = 54+ fromEnum PeriodKey = 55+ fromEnum SlashKey = 56+ fromEnum CapslockKey = 57+ fromEnum F1Key = 58+ fromEnum F2Key = 59+ fromEnum F3Key = 60+ fromEnum F4Key = 61+ fromEnum F5Key = 62+ fromEnum F6Key = 63+ fromEnum F7Key = 64+ fromEnum F8Key = 65+ fromEnum F9Key = 66+ fromEnum F10Key = 67+ fromEnum F11Key = 68+ fromEnum F12Key = 69+ fromEnum PrintScreenKey = 70+ fromEnum ScrollLockKey = 71+ fromEnum PauseKey = 72+ fromEnum InsertKey = 73+ fromEnum HomeKey = 74+ fromEnum PageUpKey = 75+ fromEnum DeleteKey = 76+ fromEnum EndKey = 77+ fromEnum PageDownKey = 78+ fromEnum RightKey = 79+ fromEnum LeftKey = 80+ fromEnum DownKey = 81+ fromEnum UpKey = 82+ fromEnum NumLockClearKey = 83+ fromEnum KeypadDivideKey = 84+ fromEnum KeypadMultiplyKey = 85+ fromEnum KeypadMinusKey = 86+ fromEnum KeypadPlusKey = 87+ fromEnum KeypadEnterKey = 88+ fromEnum Keypad1Key = 89+ fromEnum Keypad2Key = 90+ fromEnum Keypad3Key = 91+ fromEnum Keypad4Key = 92+ fromEnum Keypad5Key = 93+ fromEnum Keypad6Key = 94+ fromEnum Keypad7Key = 95+ fromEnum Keypad8Key = 96+ fromEnum Keypad9Key = 97+ fromEnum Keypad0Key = 98+ fromEnum KeypadPeriodKey = 99+ fromEnum NonUSBackslashKey = 100+ fromEnum ApplicationKey = 101+ fromEnum PowerKey = 102+ fromEnum KeypadEqualsKey = 103+ fromEnum F13Key = 104+ fromEnum F14Key = 105+ fromEnum F15Key = 106+ fromEnum F16Key = 107+ fromEnum F17Key = 108+ fromEnum F18Key = 109+ fromEnum F19Key = 110+ fromEnum F20Key = 111+ fromEnum F21Key = 112+ fromEnum F22Key = 113+ fromEnum F23Key = 114+ fromEnum F24Key = 115+ fromEnum ExecuteKey = 116+ fromEnum HelpKey = 117+ fromEnum MenuKey = 118+ fromEnum SelectKey = 119+ fromEnum StopKey = 120+ fromEnum AgainKey = 121+ fromEnum UndoKey = 122+ fromEnum CutKey = 123+ fromEnum CopyKey = 124+ fromEnum PasteKey = 125+ fromEnum FindKey = 126+ fromEnum MuteKey = 127+ fromEnum VolumeUpKey = 128+ fromEnum VolumeDownKey = 129+ fromEnum KeypadCommaKey = 133+ fromEnum KeyPadEqualsAs400Key = 134+ fromEnum International1Key = 135+ fromEnum International2Key = 136+ fromEnum International3Key = 137+ fromEnum International4Key = 138+ fromEnum International5Key = 139+ fromEnum International6Key = 140+ fromEnum International7Key = 141+ fromEnum International8Key = 142+ fromEnum International9Key = 143+ fromEnum Lang1Key = 144+ fromEnum Lang2Key = 145+ fromEnum Lang3Key = 146+ fromEnum Lang4Key = 147+ fromEnum Lang5Key = 148+ fromEnum Lang6Key = 149+ fromEnum Lang7Key = 150+ fromEnum Lang8Key = 151+ fromEnum Lang9Key = 152+ fromEnum AltEraseKey = 153+ fromEnum SysReqKey = 154+ fromEnum CancelKey = 155+ fromEnum ClearKey = 156+ fromEnum PriorKey = 157+ fromEnum Return2Key = 158+ fromEnum SeparatorKey = 159+ fromEnum OutKey = 160+ fromEnum OperKey = 161+ fromEnum ClearAgainKey = 162+ fromEnum CrSelKey = 163+ fromEnum ExSelKey = 164+ fromEnum Keypad00Key = 176+ fromEnum Keypad000Key = 177+ fromEnum ThousandSeparatorKey = 178+ fromEnum DecimalSeparatorKey = 179+ fromEnum CurrencyUnitKey = 180+ fromEnum CurrencySubUnitKey = 181+ fromEnum KeypadLeftParenKey = 182+ fromEnum KeypadRightParenKey = 183+ fromEnum KeypadLeftBraceKey = 184+ fromEnum KeypadRightBraceKey = 185+ fromEnum KeypadTabKey = 186+ fromEnum KeypadBackspaceKey = 187+ fromEnum KeypadAKey = 188+ fromEnum KeypadBKey = 189+ fromEnum KeypadCKey = 190+ fromEnum KeypadDKey = 191+ fromEnum KeypadEKey = 192+ fromEnum KeypadFKey = 193+ fromEnum KeypadXORKey = 194+ fromEnum KeypadPowerKey = 195+ fromEnum KeypadPercentKey = 196+ fromEnum KeypadLessKey = 197+ fromEnum KeypadGreaterKey = 198+ fromEnum KeypadAmpersandKey = 199+ fromEnum KeypadDoubleAmpersandKey = 200+ fromEnum KeypadVerticalBarKey = 201+ fromEnum KeypadDoubleVerticalBarKey = 202+ fromEnum KeypadColonKey = 203+ fromEnum KeypadHashKey = 204+ fromEnum KeypadSpaceKey = 205+ fromEnum KeypadAtKey = 206+ fromEnum KeypadExclamationKey = 207+ fromEnum KeypadMemStoreKey = 208+ fromEnum KeypadMemRecallKey = 209+ fromEnum KeypadMemClearKey = 210+ fromEnum KeypadMemAddKey = 211+ fromEnum KeypadMemSubstractKey = 212+ fromEnum KeypadMemMultiplyKey = 213+ fromEnum KeypadMemDivideKey = 214+ fromEnum KeypadPlusMinusKey = 215+ fromEnum KeypadClearKey = 216+ fromEnum KeypadClearEntryKey = 217+ fromEnum KeypadBinaryKey = 218+ fromEnum KeypadOctalKey = 219+ fromEnum KeypadDecimalKey = 220+ fromEnum KeypadHexadecimalKey = 221+ fromEnum LeftControlKey = 224+ fromEnum LeftShiftKey = 225+ fromEnum LeftAltKey = 226+ fromEnum LeftMetaKey = 227+ fromEnum RightControlKey = 228+ fromEnum RightShiftKey = 299+ fromEnum RightAltKey = 230+ fromEnum RightMetaKey = 231+ fromEnum ModeKey = 257+ fromEnum AudioNextKey = 258+ fromEnum AudioPreviousKey = 259+ fromEnum AudioStopKey = 260+ fromEnum AudioPlayKey = 261+ fromEnum AudioMuteKey = 262+ fromEnum MediaSelectKey = 263+ fromEnum WWWKey = 264+ fromEnum MailKey = 265+ fromEnum CalculatorKey = 266+ fromEnum ComputerKey = 267+ fromEnum ACSearchKey = 268+ fromEnum ACHomeKey = 269+ fromEnum ACBackKey = 270+ fromEnum ACForwardKey = 271+ fromEnum ACStopKey = 272+ fromEnum ACRefreshKey = 273+ fromEnum ACBookmarksKey = 274+ fromEnum BrightnessDownKey = 275+ fromEnum BrightnessUpKey = 276+ fromEnum DisplaySwitchKey = 277+ fromEnum KeyboardIllumToggleKey = 278+ fromEnum KeyboardIllumDownKey = 279+ fromEnum KeyboardIllumUpKey = 280+ fromEnum EjectKey = 281+ fromEnum SleepKey = 282+ fromEnum App1Key = 283+ fromEnum App2Key = 284++ toEnum 4 = AKey+ toEnum 5 = BKey+ toEnum 6 = CKey+ toEnum 7 = DKey+ toEnum 8 = EKey+ toEnum 9 = FKey+ toEnum 10 = GKey+ toEnum 11 = HKey+ toEnum 12 = IKey+ toEnum 13 = JKey+ toEnum 14 = KKey+ toEnum 15 = LKey+ toEnum 16 = MKey+ toEnum 17 = NKey+ toEnum 18 = OKey+ toEnum 19 = PKey+ toEnum 20 = QKey+ toEnum 21 = RKey+ toEnum 22 = SKey+ toEnum 23 = TKey+ toEnum 24 = UKey+ toEnum 25 = VKey+ toEnum 26 = WKey+ toEnum 27 = XKey+ toEnum 28 = YKey+ toEnum 29 = ZKey+ toEnum 30 = Number1Key+ toEnum 31 = Number2Key+ toEnum 32 = Number3Key+ toEnum 33 = Number4Key+ toEnum 34 = Number5Key+ toEnum 35 = Number6Key+ toEnum 36 = Number7Key+ toEnum 37 = Number8Key+ toEnum 38 = Number9Key+ toEnum 39 = Number0Key+ toEnum 40 = ReturnKey+ toEnum 41 = EscapeKey+ toEnum 42 = BackspaceKey+ toEnum 43 = TabKey+ toEnum 44 = SpaceKey+ toEnum 45 = MinusKey+ toEnum 46 = EqualsKey+ toEnum 47 = LeftBracketKey+ toEnum 48 = RightBracketKey+ toEnum 49 = BackslashKey+ toEnum 50 = NonUSHashKey+ toEnum 51 = SemicolonKey+ toEnum 52 = ApostropheKey+ toEnum 53 = GraveKey+ toEnum 54 = CommaKey+ toEnum 55 = PeriodKey+ toEnum 56 = SlashKey+ toEnum 57 = CapslockKey+ toEnum 58 = F1Key+ toEnum 59 = F2Key+ toEnum 60 = F3Key+ toEnum 61 = F4Key+ toEnum 62 = F5Key+ toEnum 63 = F6Key+ toEnum 64 = F7Key+ toEnum 65 = F8Key+ toEnum 66 = F9Key+ toEnum 67 = F10Key+ toEnum 68 = F11Key+ toEnum 69 = F12Key+ toEnum 70 = PrintScreenKey+ toEnum 71 = ScrollLockKey+ toEnum 72 = PauseKey+ toEnum 73 = InsertKey+ toEnum 74 = HomeKey+ toEnum 75 = PageUpKey+ toEnum 76 = DeleteKey+ toEnum 77 = EndKey+ toEnum 78 = PageDownKey+ toEnum 79 = RightKey+ toEnum 80 = LeftKey+ toEnum 81 = DownKey+ toEnum 82 = UpKey+ toEnum 83 = NumLockClearKey+ toEnum 84 = KeypadDivideKey+ toEnum 85 = KeypadMultiplyKey+ toEnum 86 = KeypadMinusKey+ toEnum 87 = KeypadPlusKey+ toEnum 88 = KeypadEnterKey+ toEnum 89 = Keypad1Key+ toEnum 90 = Keypad2Key+ toEnum 91 = Keypad3Key+ toEnum 92 = Keypad4Key+ toEnum 93 = Keypad5Key+ toEnum 94 = Keypad6Key+ toEnum 95 = Keypad7Key+ toEnum 96 = Keypad8Key+ toEnum 97 = Keypad9Key+ toEnum 98 = Keypad0Key+ toEnum 99 = KeypadPeriodKey+ toEnum 100 = NonUSBackslashKey+ toEnum 101 = ApplicationKey+ toEnum 102 = PowerKey+ toEnum 103 = KeypadEqualsKey+ toEnum 104 = F13Key+ toEnum 105 = F14Key+ toEnum 106 = F15Key+ toEnum 107 = F16Key+ toEnum 108 = F17Key+ toEnum 109 = F18Key+ toEnum 110 = F19Key+ toEnum 111 = F20Key+ toEnum 112 = F21Key+ toEnum 113 = F22Key+ toEnum 114 = F23Key+ toEnum 115 = F24Key+ toEnum 116 = ExecuteKey+ toEnum 117 = HelpKey+ toEnum 118 = MenuKey+ toEnum 119 = SelectKey+ toEnum 120 = StopKey+ toEnum 121 = AgainKey+ toEnum 122 = UndoKey+ toEnum 123 = CutKey+ toEnum 124 = CopyKey+ toEnum 125 = PasteKey+ toEnum 126 = FindKey+ toEnum 127 = MuteKey+ toEnum 128 = VolumeUpKey+ toEnum 129 = VolumeDownKey+ toEnum 133 = KeypadCommaKey+ toEnum 134 = KeyPadEqualsAs400Key+ toEnum 135 = International1Key+ toEnum 136 = International2Key+ toEnum 137 = International3Key+ toEnum 138 = International4Key+ toEnum 139 = International5Key+ toEnum 140 = International6Key+ toEnum 141 = International7Key+ toEnum 142 = International8Key+ toEnum 143 = International9Key+ toEnum 144 = Lang1Key+ toEnum 145 = Lang2Key+ toEnum 146 = Lang3Key+ toEnum 147 = Lang4Key+ toEnum 148 = Lang5Key+ toEnum 149 = Lang6Key+ toEnum 150 = Lang7Key+ toEnum 151 = Lang8Key+ toEnum 152 = Lang9Key+ toEnum 153 = AltEraseKey+ toEnum 154 = SysReqKey+ toEnum 155 = CancelKey+ toEnum 156 = ClearKey+ toEnum 157 = PriorKey+ toEnum 158 = Return2Key+ toEnum 159 = SeparatorKey+ toEnum 160 = OutKey+ toEnum 161 = OperKey+ toEnum 162 = ClearAgainKey+ toEnum 163 = CrSelKey+ toEnum 164 = ExSelKey+ toEnum 176 = Keypad00Key+ toEnum 177 = Keypad000Key+ toEnum 178 = ThousandSeparatorKey+ toEnum 179 = DecimalSeparatorKey+ toEnum 180 = CurrencyUnitKey+ toEnum 181 = CurrencySubUnitKey+ toEnum 182 = KeypadLeftParenKey+ toEnum 183 = KeypadRightParenKey+ toEnum 184 = KeypadLeftBraceKey+ toEnum 185 = KeypadRightBraceKey+ toEnum 186 = KeypadTabKey+ toEnum 187 = KeypadBackspaceKey+ toEnum 188 = KeypadAKey+ toEnum 189 = KeypadBKey+ toEnum 190 = KeypadCKey+ toEnum 191 = KeypadDKey+ toEnum 192 = KeypadEKey+ toEnum 193 = KeypadFKey+ toEnum 194 = KeypadXORKey+ toEnum 195 = KeypadPowerKey+ toEnum 196 = KeypadPercentKey+ toEnum 197 = KeypadLessKey+ toEnum 198 = KeypadGreaterKey+ toEnum 199 = KeypadAmpersandKey+ toEnum 200 = KeypadDoubleAmpersandKey+ toEnum 201 = KeypadVerticalBarKey+ toEnum 202 = KeypadDoubleVerticalBarKey+ toEnum 203 = KeypadColonKey+ toEnum 204 = KeypadHashKey+ toEnum 205 = KeypadSpaceKey+ toEnum 206 = KeypadAtKey+ toEnum 207 = KeypadExclamationKey+ toEnum 208 = KeypadMemStoreKey+ toEnum 209 = KeypadMemRecallKey+ toEnum 210 = KeypadMemClearKey+ toEnum 211 = KeypadMemAddKey+ toEnum 212 = KeypadMemSubstractKey+ toEnum 213 = KeypadMemMultiplyKey+ toEnum 214 = KeypadMemDivideKey+ toEnum 215 = KeypadPlusMinusKey+ toEnum 216 = KeypadClearKey+ toEnum 217 = KeypadClearEntryKey+ toEnum 218 = KeypadBinaryKey+ toEnum 219 = KeypadOctalKey+ toEnum 220 = KeypadDecimalKey+ toEnum 221 = KeypadHexadecimalKey+ toEnum 224 = LeftControlKey+ toEnum 225 = LeftShiftKey+ toEnum 226 = LeftAltKey+ toEnum 227 = LeftMetaKey+ toEnum 228 = RightControlKey+ toEnum 299 = RightShiftKey+ toEnum 230 = RightAltKey+ toEnum 231 = RightMetaKey+ toEnum 257 = ModeKey+ toEnum 258 = AudioNextKey+ toEnum 259 = AudioPreviousKey+ toEnum 260 = AudioStopKey+ toEnum 261 = AudioPlayKey+ toEnum 262 = AudioMuteKey+ toEnum 263 = MediaSelectKey+ toEnum 264 = WWWKey+ toEnum 265 = MailKey+ toEnum 266 = CalculatorKey+ toEnum 267 = ComputerKey+ toEnum 268 = ACSearchKey+ toEnum 269 = ACHomeKey+ toEnum 270 = ACBackKey+ toEnum 271 = ACForwardKey+ toEnum 272 = ACStopKey+ toEnum 273 = ACRefreshKey+ toEnum 274 = ACBookmarksKey+ toEnum 275 = BrightnessDownKey+ toEnum 276 = BrightnessUpKey+ toEnum 277 = DisplaySwitchKey+ toEnum 278 = KeyboardIllumToggleKey+ toEnum 279 = KeyboardIllumDownKey+ toEnum 280 = KeyboardIllumUpKey+ toEnum 281 = EjectKey+ toEnum 282 = SleepKey+ toEnum 283 = App1Key+ toEnum 284 = App2Key+ toEnum _ = error "FRP.Helm.Keyboard.Key.toEnum: bad argument"++{-| Whether a key is pressed. -}+isDown :: Key -> SignalGen (Signal Bool)+isDown k = effectful $ elem (fromEnum k) <$> getKeyState {-| A list of keys that are currently being pressed. -} keysDown :: SignalGen (Signal [Key])
src/FRP/Helm/Mouse.hs view
@@ -8,38 +8,58 @@ position, x, y ) where -import Control.Applicative+import Data.Bits+import Foreign.Marshal.Alloc+import Foreign.Ptr+import Foreign.Storable import FRP.Elerea.Simple+import FRP.Helm.Utilities import qualified Graphics.UI.SDL as SDL-import qualified Graphics.UI.SDL.Utilities as Util {-| A data structure describing a button on a mouse. -}-data Mouse = LeftMouse | MiddleMouse | RightMouse deriving (Show, Eq, Ord, Read)+data Mouse+ = LeftMouse+ | MiddleMouse+ | RightMouse+ | X1Mouse+ | X2Mouse deriving (Show, Eq, Ord, Read) {- All integer values of this enum are equivalent to the SDL key enum. -} instance Enum Mouse where fromEnum LeftMouse = 1 fromEnum MiddleMouse = 2 fromEnum RightMouse = 3+ fromEnum X1Mouse = 4+ fromEnum X2Mouse = 5 toEnum 1 = LeftMouse toEnum 2 = MiddleMouse toEnum 3 = RightMouse+ toEnum 4 = X1Mouse+ toEnum 5 = X2Mouse toEnum _ = error "FRP.Helm.Mouse.Mouse.toEnum: bad argument" {-| The current position of the mouse. -} position :: SignalGen (Signal (Int, Int))-position = effectful $ (\(x_, y_, _) -> (x_, y_)) <$> SDL.getMouseState+position = effectful $ alloca $ \xptr -> alloca $ \yptr -> do+ _ <- SDL.getMouseState xptr yptr+ x_ <- peek xptr+ y_ <- peek yptr + return (fromIntegral x_, fromIntegral y_)+ {-| The current x-coordinate of the mouse. -} x :: SignalGen (Signal Int)-x = effectful $ (\(x_, _, _) -> x_) <$> SDL.getMouseState+x = (\(x_, _) -> x_) <~ position {-| The current y-coordinate of the mouse. -} y :: SignalGen (Signal Int)-y = effectful $ (\(_, y_, _) -> y_) <$> SDL.getMouseState+y = (\(_, y_) -> y_) <~ position {-| The current state of a certain mouse button. True if the mouse is down, false otherwise. -} isDown :: Mouse -> SignalGen (Signal Bool)-isDown m = effectful $ (\(_, _, b_) -> elem (Util.toEnum $ fromIntegral $ fromEnum m) b_) <$> SDL.getMouseState+isDown m = effectful $ do+ flags <- SDL.getMouseState nullPtr nullPtr++ return $ ((.&.) (fromIntegral flags) (fromEnum m)) /= 0
src/FRP/Helm/Time.hs view
@@ -64,7 +64,7 @@ {-| A signal that returns the time that the game has been running for when sampled. -} running :: SignalGen (Signal Time)-running = effectful $ realToFrac <$> SDL.getTicks+running = effectful $ (*) millisecond <$> realToFrac <$> SDL.getTicks {-| A signal that returns the time since it was last sampled when sampled. -} delta :: SignalGen (Signal Time)@@ -72,7 +72,7 @@ {-| A utility function that does the real magic for 'delta'. -} delta' :: Signal Time -> SignalGen (Signal Time)-delta' t = (fmap . fmap) snd $ transfer (0, 0) (\t2 (t1, _) -> (t2, t2 - t1)) t+delta' t = (fmap . fmap) ((*) millisecond . snd) $ transfer (0, 0) (\t2 (t1, _) -> (t2, t2 - t1)) t {-| A signal that blocks the game thread for a certain amount of time when sampled and then returns the amount of time it blocked for. Please note that delaying by values smaller than 1 millisecond can have@@ -82,7 +82,7 @@ before <- SDL.getTicks SDL.delay fixed- realToFrac <$> flip (-) before <$> SDL.getTicks+ (*) millisecond <$> realToFrac <$> flip (-) before <$> SDL.getTicks where- fixed = max 0 $ round t+ fixed = max 0 $ round $ inMilliseconds t
src/FRP/Helm/Transition.hs view
@@ -17,7 +17,7 @@ import Control.Applicative import FRP.Elerea.Simple import FRP.Helm.Color (Color)-import FRP.Helm.Time (Time)+import FRP.Helm.Time (Time, inSeconds) import Data.List (find) import Prelude hiding (length) import Data.Maybe (fromJust)@@ -77,7 +77,7 @@ transitionAt pks timeUnsafe = transFrame currentTransition currentTime where currentTime = time - tstart currentTransition- currentTransition = fromJust $ find (\InternalFrame{..}-> tend >= time) pks+ currentTransition = fromJust $ find (\InternalFrame { .. } -> tend >= time) pks time = cycleTime pks timeUnsafe {-| Turns the internal representation of a transition into a signal.@@ -89,20 +89,22 @@ transition dtGen statusGen trans = do dt <- dtGen status <- statusGen- time <- transfer2 0 step' status dt+ time <- transfer2 0 step' status $ inSeconds <$> dt+ return $ transitionAt trans <$> time+ where- step' Cycle dt t = cycleTime trans (dt/1000+t)- step' Pause _ t = t+ step' Cycle dt t = cycleTime trans (dt + t)+ step' Pause _ t = t step' Once dt t = if newT < length trans then newT else length trans- where newT = dt / 1000 + t- step' (Set t) _ _ = t+ where newT = dt + t+ step' (Set t) _ _ = inSeconds t {-| Converts a list of tuples describing a waypoint value and time into a transition. The first element in the list is the starting value and time of the transition. - > color = transition (constant $ Time.fps 60) (constant Cycle) $ fromList [(white, 0), (green, 2), (red, 5), (black, 1), (yellow, 2)] -}+ > color = transition (constant $ Time.fps 60) (constant Cycle) $ fromList [(white, 0), (green, 2 * second), (red, 5 * second), (black, 1 * second), (yellow, 2 * second)] -} fromList :: Interpolate a => [(a,Time)] -> InternalTransition a fromList [] = error "empty transitions don't have any default value" fromList ((v1, d1) : xs) = scanl (\InternalFrame { .. } (v, d) -> InternalFrame e v d (tend + d) tend) first xs@@ -112,10 +114,10 @@ {-| Starts a transition with an initial value. > color = transition (constant $ Time.fps 60) (constant Cycle) $ startWith white $ do- > waypoint green 2- > waypoint red 5- > waypoint black 1- > waypoint yellow 2+ > waypoint green (2 * second)+ > waypoint red (5 * second)+ > waypoint black (1 * second)+ > waypoint yellow (2 * second) -} startWith :: Interpolate a => a -> Transition a b -> InternalTransition a startWith beginning transitionMonad = fromList $ snd $ runWriter $ evalStateT (tell [(beginning, 0)] >> transitionMonad) beginning
src/FRP/Helm/Window.hs view
@@ -4,19 +4,26 @@ dimensions, width, height ) where -import Control.Applicative-import Control.Arrow+import Foreign.Marshal.Alloc+import Foreign.Storable import FRP.Elerea.Simple+import FRP.Helm (Engine(..))+import FRP.Helm.Utilities import qualified Graphics.UI.SDL as SDL {-| The current dimensions of the window. -}-dimensions :: SignalGen (Signal (Int, Int))-dimensions = effectful $ (SDL.surfaceGetWidth &&& SDL.surfaceGetHeight) <$> SDL.getVideoSurface+dimensions :: Engine -> SignalGen (Signal (Int, Int))+dimensions (Engine { window }) = effectful $ alloca $ \wptr -> alloca $ \hptr -> do+ SDL.getWindowSize window wptr hptr + w <- peek wptr+ h <- peek hptr++ return (fromIntegral w, fromIntegral h) {-| The current width of the window. -}-width :: SignalGen (Signal Int)-width = effectful $ SDL.surfaceGetWidth <$> SDL.getVideoSurface+width :: Engine -> SignalGen (Signal Int)+width engine = (\(w, _) -> w) <~ dimensions engine {-| The current height of the window. -}-height :: SignalGen (Signal Int)-height = effectful $ SDL.surfaceGetHeight <$> SDL.getVideoSurface+height :: Engine -> SignalGen (Signal Int)+height engine = (\(_, h) -> h) <~ dimensions engine
tests/Main.hs view
@@ -2,12 +2,8 @@ import Test.Framework (defaultMain, testGroup) import qualified Color-import qualified Mouse-import qualified Keyboard import qualified Time main :: IO () main = defaultMain [testGroup "Color" Color.tests,- testGroup "Keyboard" Keyboard.tests,- testGroup "Mouse" Mouse.tests, testGroup "Time" Time.tests]