diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -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
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,5 +1,8 @@
- 
+
+
+
+ 
## 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).
diff --git a/helm.cabal b/helm.cabal
--- a/helm.cabal
+++ b/helm.cabal
@@ -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
-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
diff --git a/src/FRP/Helm.hs b/src/FRP/Helm.hs
--- a/src/FRP/Helm.hs
+++ b/src/FRP/Helm.hs
@@ -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
diff --git a/src/FRP/Helm/Animation.hs b/src/FRP/Helm/Animation.hs
--- a/src/FRP/Helm/Animation.hs
+++ b/src/FRP/Helm/Animation.hs
@@ -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)
diff --git a/src/FRP/Helm/Automaton.hs b/src/FRP/Helm/Automaton.hs
deleted file mode 100644
--- a/src/FRP/Helm/Automaton.hs
+++ /dev/null
@@ -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
diff --git a/src/FRP/Helm/Color.hs b/src/FRP/Helm/Color.hs
--- a/src/FRP/Helm/Color.hs
+++ b/src/FRP/Helm/Color.hs
@@ -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
diff --git a/src/FRP/Helm/Joystick.hs b/src/FRP/Helm/Joystick.hs
deleted file mode 100644
--- a/src/FRP/Helm/Joystick.hs
+++ /dev/null
@@ -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)
diff --git a/src/FRP/Helm/Keyboard.hs b/src/FRP/Helm/Keyboard.hs
--- a/src/FRP/Helm/Keyboard.hs
+++ b/src/FRP/Helm/Keyboard.hs
@@ -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 . -}
-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 . -}
+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])
diff --git a/src/FRP/Helm/Mouse.hs b/src/FRP/Helm/Mouse.hs
--- a/src/FRP/Helm/Mouse.hs
+++ b/src/FRP/Helm/Mouse.hs
@@ -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
diff --git a/src/FRP/Helm/Time.hs b/src/FRP/Helm/Time.hs
--- a/src/FRP/Helm/Time.hs
+++ b/src/FRP/Helm/Time.hs
@@ -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
diff --git a/src/FRP/Helm/Transition.hs b/src/FRP/Helm/Transition.hs
--- a/src/FRP/Helm/Transition.hs
+++ b/src/FRP/Helm/Transition.hs
@@ -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
diff --git a/src/FRP/Helm/Window.hs b/src/FRP/Helm/Window.hs
--- a/src/FRP/Helm/Window.hs
+++ b/src/FRP/Helm/Window.hs
@@ -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
diff --git a/tests/Main.hs b/tests/Main.hs
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -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]