Initial commit

.gitignore

@@ -0,0 +1 @@
+dist

Demo.hs

@@ -0,0 +1,21 @@
+import Control.Applicative
+import FRP.Elerea.Simple
+import FRP.Helm
+import qualified FRP.Helm.Keyboard as Keyboard
+import qualified FRP.Helm.Window as Window
+
+data State = State { mx :: Double, my :: Double }
+
+step :: (Int, Int) -> State -> State
+step (dx, dy) state = state { mx = (realToFrac dx) + mx state, my = (realToFrac dy) + my state }
+
+render :: (Int, Int) -> State -> Element
+render (w, h) (State { .. }) = collage w h [move (mx, my) $ filled (rgb 1 1 1) $ square 100]
+
+main :: IO ()
+main = run $ do
+  dims <- Window.dimensions
+  arrows <- Keyboard.arrows
+  stepper <- transfer (State { mx = 0, my = 100 }) step arrows
+
+  return $ render <$> dims <*> stepper

FRP/Helm.hs

@@ -0,0 +1,147 @@
+module FRP.Helm (
+  radians,
+  degrees,
+  turns,
+  run,
+  module FRP.Helm.Color,
+  module FRP.Helm.Graphics,
+) where
+
+import Data.IORef
+import FRP.Elerea.Simple
+import FRP.Helm.Color
+import FRP.Helm.Graphics
+import FRP.Helm.Internal (keyState)
+import Graphics.Rendering.Cairo.Internal (imageSurfaceGetData)
+import qualified Data.Map as Map
+import qualified Graphics.UI.SDL as SDL
+import qualified Graphics.Rendering.Cairo as Cairo
+
+{-| 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 -> IO SDL.Surface
+requestDimensions w h =	do
+  mayhaps <- SDL.trySetVideoMode w h 32 [SDL.HWSurface, SDL.DoubleBuf, SDL.Resizable]
+
+  case mayhaps of
+    Just screen -> return screen
+    Nothing -> SDL.setVideoMode w h 32 [SDL.SWSurface, SDL.Resizable]
+
+-- |Converts radians into the standard angle measurement (radians).
+radians :: Float -> Float
+radians n = n
+
+-- |Converts degrees into the standard angle measurement (radians).
+degrees :: Float -> Float
+degrees n = n * pi / 180
+
+{-| Converts turns into the standard angle measurement (radians).
+    Turns are essentially full revolutions of the unit circle. -}
+turns :: Float -> Float
+turns n = 2 * pi * n
+
+{-| Initializes and runs the game engine. The supplied signal generator is
+    constantly sampled  for an element to render until the user quits. -}
+run :: SignalGen (Signal Element) -> IO ()
+run gen = SDL.init [SDL.InitVideo] >> requestDimensions 800 600 >> start gen >>= run'
+
+run' :: IO Element -> IO ()
+run' smp = do
+  continue <- run''
+
+  if continue then smp >>= render >> run' smp else SDL.quit
+
+run'' :: IO Bool
+run'' = do
+  event <- SDL.pollEvent
+  keys <- readIORef keyState
+
+  case event of
+    SDL.NoEvent -> return True
+    SDL.Quit -> return False
+    SDL.VideoResize w h -> requestDimensions w h >> run''
+    SDL.KeyDown (SDL.Keysym { symKey }) -> writeIORef keyState (Map.insert symKey True keys) >> run''
+    SDL.KeyUp (SDL.Keysym { symKey }) -> writeIORef keyState (Map.insert symKey False keys) >> run''
+    _ -> run''
+
+render :: Element -> IO ()
+render element = SDL.getVideoSurface >>= render' element
+
+render' :: Element -> SDL.Surface -> IO ()
+render' element screen = do
+    src <- Cairo.createImageSurface format w h
+    ptr <- imageSurfaceGetData src
+    dest <- SDL.createRGBSurfaceFrom ptr w h 32 stride rshift gshift bshift 0
+
+    Cairo.renderWith src (render'' w h element)
+    SDL.blitSurface dest Nothing screen Nothing >> SDL.flip screen
+
+  where
+    w = SDL.surfaceGetWidth screen
+    h = SDL.surfaceGetHeight screen
+    format = Cairo.FormatARGB32
+    stride = Cairo.formatStrideForWidth format w
+    rshift = 0x00ff0000
+    gshift = 0x0000ff00
+    bshift = 0x000000ff
+
+render'' :: Int -> Int -> Element -> Cairo.Render ()
+render'' w h element = do
+  Cairo.setSourceRGB 0 0 0
+  Cairo.rectangle 0 0 (fromIntegral w) (fromIntegral h)
+  Cairo.fill
+
+  renderElement element
+
+renderElement :: Element -> Cairo.Render ()
+renderElement (CollageElement _ _ forms) = mapM renderForm forms >> return ()
+renderElement (ImageElement _ ) = return ()
+
+withTransform :: Double -> Double -> Double -> Double -> Cairo.Render () -> Cairo.Render ()
+withTransform s t x y f = Cairo.save >> Cairo.scale s s >> Cairo.rotate t >> Cairo.translate x y >> f >> Cairo.restore
+
+setLineCap :: LineCap -> Cairo.Render ()
+setLineCap cap = 
+  case cap of
+    Flat -> Cairo.setLineCap Cairo.LineCapButt
+    Round -> Cairo.setLineCap Cairo.LineCapRound
+    Padded -> Cairo.setLineCap Cairo.LineCapSquare
+
+setLineJoin :: LineJoin -> Cairo.Render ()
+setLineJoin join =
+  case join of
+    Smooth -> Cairo.setLineJoin Cairo.LineJoinRound
+    Sharp lim -> Cairo.setLineJoin Cairo.LineJoinMiter >> Cairo.setMiterLimit lim
+    Clipped -> Cairo.setLineJoin Cairo.LineJoinBevel
+
+setLineStyle :: LineStyle -> Cairo.Render ()
+setLineStyle (LineStyle { color = Color r g b a, .. }) =
+  Cairo.setSourceRGBA r g b a >> setLineCap cap >> setLineJoin join >>
+  Cairo.setLineWidth width >> Cairo.setDash dashing dashOffset >> Cairo.stroke
+
+setFillStyle :: FillStyle -> Cairo.Render ()
+setFillStyle (Solid (Color r g b a)) = Cairo.setSourceRGBA r g b a >> Cairo.fill
+
+renderForm :: Form -> Cairo.Render ()
+renderForm (Form { style = PathForm style p, .. }) =
+  withTransform scalar theta x y $ 
+      setLineStyle style >> Cairo.moveTo hx hy >> mapM (\(x_, y_) -> Cairo.lineTo x_ y_) p >> return ()
+
+    where
+      (hx, hy) = head p
+
+renderForm (Form { style = ShapeForm style shape, .. }) =
+  withTransform scalar theta x y $ do
+      Cairo.newPath >> Cairo.moveTo hx hy >> mapM (\(x_, y_) -> Cairo.lineTo x_ y_) shape >> Cairo.closePath
+
+      case style of
+        Left lineStyle -> setLineStyle lineStyle
+        Right fillStyle -> setFillStyle fillStyle
+
+    where
+      (hx, hy) = head shape
+
+renderForm (Form { style = ImageForm _ _ _ _, .. }) = return ()
+renderForm (Form { style = ElementForm element, .. }) = withTransform scalar theta x y $ renderElement element
+renderForm (Form { style = GroupForm m forms, .. }) = withTransform scalar theta x y $ Cairo.setMatrix m >> mapM renderForm forms >> return ()

FRP/Helm/Color.hs

@@ -0,0 +1,85 @@
+module FRP.Helm.Color where
+
+data Color = Color { r :: !Double, g :: !Double, b :: !Double, a :: !Double }
+
+-- |Creates an RGB color.
+rgb :: Double -> Double -> Double -> Color
+rgb r g b = Color r g b 1
+
+-- |Creates an RGB color, with transparency.
+rgba :: Double -> Double -> Double -> Double -> Color
+rgba = Color
+
+red :: Color
+red = rgb 1 0 0
+
+lime :: Color
+lime = rgb 0 1 0
+
+blue :: Color
+blue = rgb 0 0 1
+
+yellow :: Color
+yellow = rgb 1 1 0
+
+cyan :: Color
+cyan = rgb 0 1 1
+
+magenta :: Color
+magenta = rgb 1 0 1
+
+black :: Color
+black = rgb 0 0 0
+
+white :: Color
+white = rgb 1 1 1
+
+gray :: Color
+gray = rgb 0.5 0.5 0.5
+
+grey :: Color
+grey = gray
+
+maroon :: Color
+maroon = rgb 0.5 0 0
+
+navy :: Color
+navy = rgb 0 0 0.5
+
+green :: Color
+green = rgb 0 0.5 0
+
+teal :: Color
+teal = rgb 0 0.5 0.5
+
+purple :: Color
+purple = rgb 0.5 0 0.5
+
+violet :: Color
+violet = rgb 0.923 0.508 0.923
+
+forestGreen :: Color
+forestGreen = rgb 0.133 0.543 0.133
+
+{-
+
+complement :: Color -> Color
+
+hsva :: Double -> Double -> Double -> Double -> Color
+
+hsv :: Double -> Double -> Double -> Color
+-}
+
+{-
+data Gradient = Linear (Double, Double) (Double, Double) [(Double, Color)] |
+                Radial (Double, Double) Double (Double, Double) Double [(Double, Color)]
+
+
+-- |Creates a linear gradient. Takes an 
+linear :: (Double, Double) -> (Double, Double) -> [(Double, Color)] -> Gradient
+linear = Linear
+
+-- |Creates a radial gradient.
+radial :: (Double, Double) -> Double -> (Double, Double) -> Double -> [(Double, Color)] -> Gradient
+radial = Radial
+-}

FRP/Helm/Graphics.hs

@@ -0,0 +1,176 @@
+module FRP.Helm.Graphics (
+  Element(..),
+  Form(..),
+  FillStyle(..),
+  LineCap(..),
+  LineJoin(..),
+  LineStyle(..),
+  defaultLine,
+  solid,
+  dashed,
+  dotted,
+  FormStyle(..),
+  filled,
+  outlined,
+  traced,
+  sprite,
+  toForm,
+  group,
+  groupTransform,
+  rotate,
+  scale,
+  move,
+  moveX,
+  moveY,
+  collage,
+  Path,
+  path,
+  segment,
+  Shape,
+  polygon,
+  rect,
+  square,
+  oval,
+  circle,
+  ngon
+) where
+
+import FRP.Helm.Color as Color
+import Graphics.Rendering.Cairo.Matrix (Matrix, identity)
+
+data Element = CollageElement Int Int [Form] |
+               ImageElement String
+
+data Form = Form {
+  theta :: Double,
+  scalar :: Double,
+  x :: Double,
+  y :: Double,
+  style :: FormStyle
+}
+data FillStyle = Solid Color -- Texture String | Gradient Gradient
+data LineCap = Flat | Round | Padded
+data LineJoin = Smooth | Sharp Double | Clipped
+data LineStyle = LineStyle {
+  color :: Color,
+  width :: Double,
+  cap :: LineCap,
+  join :: LineJoin,
+  dashing :: [Double],
+  dashOffset :: Double
+}
+
+defaultLine :: LineStyle
+defaultLine = LineStyle {
+  color = Color.rgb 0 0 0,
+  width = 1,
+  cap = Flat,
+  join = Sharp 10,
+  dashing = [],
+  dashOffset = 0
+}
+
+solid :: Color -> LineStyle
+solid color = defaultLine { color = color }
+
+dashed :: Color -> LineStyle
+dashed color = defaultLine { color = color, dashing = [8, 4] }
+
+dotted :: Color -> LineStyle
+dotted color = defaultLine { color = color, dashing = [3, 3] }
+
+data FormStyle = PathForm LineStyle Path |
+                 ShapeForm (Either LineStyle FillStyle) Shape |
+                 ImageForm Int Int (Int, Int) String |
+                 ElementForm Element |
+                 GroupForm Matrix [Form]
+
+form :: FormStyle -> Form
+form style = Form { theta = 0, scalar = 1, x = 0, y = 0, style = style }
+
+fill :: FillStyle -> Shape -> Form
+fill style shape = form (ShapeForm (Right style) shape)
+
+filled :: Color -> Shape -> Form
+filled color shape = fill (Solid color) shape
+
+{-
+textured :: String -> Shape -> Form
+
+gradient :: Gradient -> 
+ -}
+
+outlined :: LineStyle -> Shape -> Form
+outlined style shape = form (ShapeForm (Left style) shape)
+
+traced :: LineStyle -> Path -> Form
+traced style p = form (PathForm style p)
+
+sprite :: Int -> Int -> (Int, Int) -> String -> Form
+sprite w h pos src = form (ImageForm w h pos src)
+
+toForm :: Element -> Form
+toForm element = form (ElementForm element)
+
+group :: [Form] -> Form
+group forms = form (GroupForm identity forms)
+
+groupTransform :: Matrix -> [Form] -> Form
+groupTransform matrix forms = form (GroupForm matrix forms)
+
+rotate :: Double -> Form -> Form
+rotate t f= f { theta = t + theta f }
+
+scale :: Double -> Form -> Form
+scale n f = f { scalar = n + scalar f }
+
+move :: (Double, Double) -> Form -> Form
+move (rx, ry) f = f { x = rx + x f, y = ry + y f }
+
+moveX :: Double -> Form -> Form
+moveX x f = move (x, 0) f
+
+moveY :: Double -> Form -> Form
+moveY y f = move (0, y) f
+
+collage :: Int -> Int -> [Form] -> Element
+collage w h forms = CollageElement w h forms
+
+type Path = [(Double, Double)]
+
+path :: [(Double, Double)] -> Path
+path points = points
+
+segment :: (Double, Double) -> (Double, Double) -> Path
+segment p1 p2 = [p1,p2]
+
+type Shape = [(Double, Double)]
+
+polygon :: [(Double, Double)] -> Shape
+polygon points = points
+
+rect :: Double -> Double -> Shape
+rect w h = [(-hw, -hh), (-hw, hh), (hw, hh), (hw, -hh)]
+  where
+    hw = w / 2
+    hh = h / 2
+
+square :: Double -> Shape
+square n = rect n n
+
+oval :: Double -> Double -> Shape
+oval w h = map (\i -> (hw * cos (t * i), hh * sin (t * i))) [0 .. n - 1]
+  where
+    n = 50
+    t = 2 * pi / n
+    hw = w / 2
+    hh = h / 2
+
+circle :: Double -> Shape
+circle r = oval (2 * r) (2 * r)
+
+ngon :: Int -> Double -> Shape
+ngon n r = map (\i -> (r * cos (t * i), r * sin (t * i))) [0 .. fromIntegral (n - 1)]
+  where 
+    m = fromIntegral n
+    t = 2 * pi / m

FRP/Helm/Internal.hs

@@ -0,0 +1,15 @@
+{-# OPTIONS_HADDOCK hide #-}
+
+module FRP.Helm.Internal (keyState) where
+
+import Data.IORef
+import System.IO.Unsafe
+import qualified Data.Map as Map
+import qualified Graphics.UI.SDL as SDL
+
+-- FIXME: This entire hacky module can be removed if a non-hacky SDL_GetKeyState can be bound.
+-- I'm sorry, I really am.
+
+{-# NOINLINE keyState #-}
+keyState :: IORef (Map.Map SDL.SDLKey Bool)
+keyState = unsafePerformIO $ newIORef Map.empty

FRP/Helm/Keyboard.hs

@@ -0,0 +1,337 @@
+module FRP.Helm.Keyboard (
+  shift,
+  ctrl,
+  enter,
+  Key(..),
+  space,
+  arrows,
+  wasd
+) where
+
+import Control.Applicative
+import Data.IORef
+import FRP.Elerea.Simple
+import FRP.Helm.Internal (keyState)
+import qualified Data.Map as Map
+import qualified Graphics.UI.SDL as SDL
+
+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 |
+           LKey |
+           MKey |
+           NKey |
+           OKey |
+           PKey |
+           QKey |
+           RKey |
+           SKey |
+           TKey |
+           UKey |
+           VKey |
+           WKey |
+           XKey |
+           YKey |
+           ZKey |
+           DeleteKey |
+           Keypad0Key |
+           Keypad1Key |
+           Keypad2Key |
+           Keypad3Key |
+           Keypad4Key |
+           Keypad5Key |
+           Keypad6Key |
+           Keypad7Key |
+           Keypad8Key |
+           Keypad9Key |
+           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 |
+           ComposeKey |
+           HelpKey |
+           PrintKey |
+           SysReqKey |
+           BreakKey |
+           MenuKey |
+           PowerKey |
+           EuroKey |
+           UndoKey
+
+-- |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
+
+mapKey :: Key -> SDL.SDLKey
+mapKey k =
+  case k of
+    BackspaceKey -> SDL.SDLK_BACKSPACE
+    TabKey -> SDL.SDLK_TAB
+    ClearKey -> SDL.SDLK_CLEAR
+    EnterKey -> SDL.SDLK_RETURN
+    PauseKey -> SDL.SDLK_PAUSE
+    EscapeKey -> SDL.SDLK_ESCAPE
+    SpaceKey -> SDL.SDLK_SPACE
+    ExclaimKey -> SDL.SDLK_EXCLAIM
+    QuotedBlKey -> SDL.SDLK_QUOTEDBL
+    HashKey -> SDL.SDLK_HASH
+    DollarKey -> SDL.SDLK_DOLLAR
+    AmpersandKey -> SDL.SDLK_AMPERSAND
+    QuoteKey -> SDL.SDLK_QUOTE
+    LeftParenKey -> SDL.SDLK_LEFTPAREN
+    RightParenKey -> SDL.SDLK_RIGHTPAREN
+    AsteriskKey -> SDL.SDLK_ASTERISK
+    PlusKey -> SDL.SDLK_PLUS
+    CommaKey -> SDL.SDLK_COMMA
+    MinusKey -> SDL.SDLK_MINUS
+    PeriodKey -> SDL.SDLK_PERIOD
+    SlashKey -> SDL.SDLK_SLASH
+    Num0Key -> SDL.SDLK_0
+    Num1Key -> SDL.SDLK_1
+    Num2Key -> SDL.SDLK_2
+    Num3Key -> SDL.SDLK_3
+    Num4Key -> SDL.SDLK_4
+    Num5Key -> SDL.SDLK_5
+    Num6Key -> SDL.SDLK_6
+    Num7Key -> SDL.SDLK_7
+    Num8Key -> SDL.SDLK_8
+    Num9Key -> SDL.SDLK_9
+    ColonKey -> SDL.SDLK_COLON
+    SemicolonKey -> SDL.SDLK_SEMICOLON
+    LessKey -> SDL.SDLK_LESS
+    EqualsKey -> SDL.SDLK_EQUALS
+    GreaterKey -> SDL.SDLK_GREATER
+    QuestionKey -> SDL.SDLK_QUESTION
+    AtKey -> SDL.SDLK_AT
+    LeftBracketKey -> SDL.SDLK_LEFTBRACKET
+    BackslashKey -> SDL.SDLK_BACKSLASH
+    RightBracketKey -> SDL.SDLK_RIGHTBRACKET
+    CaretKey -> SDL.SDLK_CARET
+    UnderscoreKey -> SDL.SDLK_UNDERSCORE
+    BackquoteKey -> SDL.SDLK_BACKQUOTE
+    AKey -> SDL.SDLK_a
+    BKey -> SDL.SDLK_b
+    CKey -> SDL.SDLK_c
+    DKey -> SDL.SDLK_d
+    EKey -> SDL.SDLK_e
+    FKey -> SDL.SDLK_f
+    GKey -> SDL.SDLK_g
+    HKey -> SDL.SDLK_h
+    IKey -> SDL.SDLK_i
+    JKey -> SDL.SDLK_j
+    LKey -> SDL.SDLK_l
+    MKey -> SDL.SDLK_m
+    NKey -> SDL.SDLK_n
+    OKey -> SDL.SDLK_o
+    PKey -> SDL.SDLK_p
+    QKey -> SDL.SDLK_q
+    RKey -> SDL.SDLK_r
+    SKey -> SDL.SDLK_s
+    TKey -> SDL.SDLK_t
+    UKey -> SDL.SDLK_u
+    VKey -> SDL.SDLK_v
+    WKey -> SDL.SDLK_w
+    XKey -> SDL.SDLK_x
+    YKey -> SDL.SDLK_y
+    ZKey -> SDL.SDLK_z
+    DeleteKey -> SDL.SDLK_DELETE
+    Keypad0Key -> SDL.SDLK_KP0
+    Keypad1Key -> SDL.SDLK_KP1
+    Keypad2Key -> SDL.SDLK_KP2
+    Keypad3Key -> SDL.SDLK_KP3
+    Keypad4Key -> SDL.SDLK_KP4
+    Keypad5Key -> SDL.SDLK_KP5
+    Keypad6Key -> SDL.SDLK_KP6
+    Keypad7Key -> SDL.SDLK_KP7
+    Keypad8Key -> SDL.SDLK_KP8
+    Keypad9Key -> SDL.SDLK_KP9
+    KeypadPeriodKey -> SDL.SDLK_KP_PERIOD
+    KeypadDivideKey -> SDL.SDLK_KP_DIVIDE
+    KeypadMultiplyKey -> SDL.SDLK_KP_MULTIPLY
+    KeypadMinusKey -> SDL.SDLK_KP_MINUS
+    KeypadPlusKey -> SDL.SDLK_KP_PLUS
+    KeypadEnterKey -> SDL.SDLK_KP_ENTER
+    KeypadEqualsKey -> SDL.SDLK_KP_EQUALS
+    UpKey -> SDL.SDLK_UP
+    DownKey -> SDL.SDLK_DOWN
+    RightKey -> SDL.SDLK_RIGHT
+    LeftKey -> SDL.SDLK_LEFT
+    InsertKey -> SDL.SDLK_INSERT
+    HomeKey -> SDL.SDLK_HOME
+    EndKey -> SDL.SDLK_END
+    PageUpKey -> SDL.SDLK_PAGEUP
+    PageDownKey -> SDL.SDLK_PAGEDOWN
+    F1Key -> SDL.SDLK_F1
+    F2Key -> SDL.SDLK_F2
+    F3Key -> SDL.SDLK_F3
+    F4Key -> SDL.SDLK_F4
+    F5Key -> SDL.SDLK_F5
+    F6Key -> SDL.SDLK_F6
+    F7Key -> SDL.SDLK_F7
+    F8Key -> SDL.SDLK_F8
+    F9Key -> SDL.SDLK_F9
+    F10Key -> SDL.SDLK_F10
+    F11Key -> SDL.SDLK_F11
+    F12Key -> SDL.SDLK_F12
+    F13Key -> SDL.SDLK_F13
+    F14Key -> SDL.SDLK_F14
+    F15Key -> SDL.SDLK_F15
+    NumLockKey -> SDL.SDLK_NUMLOCK
+    CapsLockKey -> SDL.SDLK_CAPSLOCK
+    ScrollLockKey -> SDL.SDLK_SCROLLOCK
+    RShiftKey -> SDL.SDLK_RSHIFT
+    LShiftKey -> SDL.SDLK_LSHIFT
+    RCtrlKey -> SDL.SDLK_RCTRL
+    LCtrlKey -> SDL.SDLK_LCTRL
+    RAltKey -> SDL.SDLK_RALT
+    LAltKey -> SDL.SDLK_LALT
+    RMetaKey -> SDL.SDLK_RMETA
+    LMetaKey -> SDL.SDLK_LMETA
+    RSuperKey -> SDL.SDLK_RSUPER
+    LSuperKey -> SDL.SDLK_LSUPER
+    ComposeKey -> SDL.SDLK_COMPOSE
+    HelpKey -> SDL.SDLK_HELP
+    PrintKey -> SDL.SDLK_PRINT
+    SysReqKey -> SDL.SDLK_SYSREQ
+    BreakKey -> SDL.SDLK_BREAK
+    MenuKey -> SDL.SDLK_MENU
+    PowerKey -> SDL.SDLK_POWER
+    EuroKey -> SDL.SDLK_EURO
+    UndoKey -> SDL.SDLK_UNDO
+
+-- |Whether a specific key is pressed.
+isDown :: Key -> SignalGen (Signal Bool)
+isDown k = effectful $ (Map.findWithDefault False (mapKey k)) <$> readIORef keyState
+
+-- |Whether the shift key is pressed.
+enter :: SignalGen (Signal Bool)
+enter = isDown EnterKey
+
+-- |Whether the space key is pressed.
+space :: SignalGen (Signal Bool)
+space = isDown SpaceKey
+
+{-
+keysDown :: SignalGen (Signal [Key])
+-}
+
+{-| A unit vector combined from the arrow keys. When no keys are being pressed
+    this signal samples to (0, 0), otherwise it samples to a specific direction
+    based on which keys are pressed. For example, pressing the left key results
+    in (-1, 0), the down key (0, 1), etc. -}
+arrows :: SignalGen (Signal (Int, Int))
+arrows = do
+  up <- isDown UpKey
+  left <- isDown LeftKey
+  down <- isDown DownKey
+  right <- isDown RightKey
+
+  return $ arrows' <$> up <*> left <*> down <*> right
+
+arrows' :: Bool -> Bool -> Bool -> Bool -> (Int, Int)
+arrows' u l d r = (-1 * fromEnum l + 1 * fromEnum r, -1 * fromEnum u + 1 * fromEnum d)
+
+-- |Similar to the 'arrows' signal, but uses the W, A, S and D keys instead.
+wasd :: SignalGen (Signal (Int, Int))
+wasd = do
+  w <- isDown WKey
+  a <- isDown AKey
+  s <- isDown SKey
+  d <- isDown DKey
+
+  return $ arrows' <$> w <*> a <*> s <*> d

FRP/Helm/Mouse.hs

@@ -0,0 +1,34 @@
+module FRP.Helm.Mouse (position, x, y, isDown, Mouse(..)) where
+
+import Control.Applicative
+import FRP.Elerea.Simple
+import qualified Graphics.UI.SDL as SDL
+
+data Mouse = LeftMouse | MiddleMouse | RightMouse
+
+-- |The current mouse position.
+position :: SignalGen (Signal (Int, Int))
+position = effectful $ (\(x_, y_, _) -> (x_, y_)) <$> SDL.getMouseState
+
+-- |The current x-coordinate of the mouse.
+x :: SignalGen (Signal Int)
+x = effectful $ (\(x_, _, _) -> x_) <$> SDL.getMouseState
+
+-- |The current y-coordinate of the mouse.
+y :: SignalGen (Signal Int)
+y = effectful $ (\(_, y_, _) -> y_) <$> SDL.getMouseState
+
+mapMouse m =
+  case m of
+    LeftMouse -> SDL.ButtonLeft
+    MiddleMouse -> SDL.ButtonMiddle
+    RightMouse -> SDL.ButtonRight
+
+{-| 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 (mapMouse m) b_) <$> SDL.getMouseState
+
+{-
+isClicked :: SignalGen (Signal Bool)
+ -}

FRP/Helm/Window.hs

@@ -0,0 +1,17 @@
+module FRP.Helm.Window (dimensions, width, height) where
+
+import Control.Applicative
+import FRP.Elerea.Simple
+import qualified Graphics.UI.SDL as SDL
+
+-- |The current dimensions of the window.
+dimensions :: SignalGen (Signal (Int, Int))
+dimensions = effectful $ (\s -> (SDL.surfaceGetWidth s, SDL.surfaceGetHeight s)) <$> SDL.getVideoSurface
+
+-- |The current width of the window.
+width :: SignalGen (Signal Int)
+width = effectful $ SDL.surfaceGetWidth <$> SDL.getVideoSurface
+
+-- |The current height of the window.
+height :: SignalGen (Signal Int)
+height = effectful $ SDL.surfaceGetHeight <$> SDL.getVideoSurface

LICENSE

@@ -0,0 +1,19 @@
+Copyright (C) 2013, 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
+deal in the Software without restriction, including without limitation the
+rights to use, copy, modify, merge, publish, distribute, sublicense,
+and/or sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN
+NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
+DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
+THE USE OR OTHER DEALINGS IN THE SOFTWARE.

Setup.hs

@@ -0,0 +1,3 @@
+import Distribution.Simple
+
+main = defaultMain

helm.cabal

@@ -0,0 +1,52 @@
+name: helm
+version: 0.1
+synopsis: A functionally reactive game engine.
+description: Helm is a functionally reactive game engine inspired by the Elm programming language.
+             Protective head gear for preventing headaches from game development provided!
+homepage: http://github.com/z0w0/helm
+bug-reports: http://github.com/z0w0/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
+category: Game Engine
+build-type: Simple
+cabal-version: >=1.10
+
+source-repository head
+  type: git
+  location: git://github.com/z0w0/helm.git
+
+executable helm-demo
+  main-is: Demo.hs
+  build-depends:
+    base >= 4 && < 5,
+    helm >= 0.1 && < 1,
+    SDL >= 0.6.4 && < 1,
+    cairo >= 0.12.4 && < 1,
+    elerea >= 2.7.0 && < 3,
+    containers >= 0.5.0.0 && < 1
+  default-language: Haskell2010
+  default-extensions: RecordWildCards, NamedFieldPuns
+  ghc-options: -Wall
+
+library
+  exposed-modules:
+    FRP.Helm
+    FRP.Helm.Color
+    FRP.Helm.Graphics
+    FRP.Helm.Keyboard
+    FRP.Helm.Mouse
+    FRP.Helm.Window
+  build-depends:
+    base >= 4 && < 5,
+    SDL >= 0.6.4 && < 1,
+    cairo >= 0.12.4 && < 1,
+    elerea >= 2.7.0 && < 3,
+    containers >= 0.5.0.0 && < 1
+  default-language: Haskell2010
+  default-extensions: RecordWildCards, NamedFieldPuns
+  ghc-options: -Wall