packages feed

helm 0.3.1 → 0.4

raw patch · 24 files changed

+1812/−1504 lines, 24 filesdep +HUnitdep +test-frameworkdep +test-framework-hunitPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, test-framework, test-framework-hunit, test-framework-quickcheck2

API changes (from Hackage documentation)

- FRP.Helm.Color: a :: Color -> !Double
- FRP.Helm.Color: b :: Color -> !Double
- FRP.Helm.Color: g :: Color -> !Double
- FRP.Helm.Color: r :: Color -> !Double
- FRP.Helm.Graphics: cap :: LineStyle -> LineCap
- FRP.Helm.Graphics: color :: LineStyle -> Color
- FRP.Helm.Graphics: dashOffset :: LineStyle -> Double
- FRP.Helm.Graphics: dashing :: LineStyle -> [Double]
- FRP.Helm.Graphics: fontSize :: Text -> Double
- FRP.Helm.Graphics: fontSlant :: Text -> FontSlant
- FRP.Helm.Graphics: fontTypeface :: Text -> String
- FRP.Helm.Graphics: fontWeight :: Text -> FontWeight
- FRP.Helm.Graphics: join :: LineStyle -> LineJoin
- FRP.Helm.Graphics: scalar :: Form -> Double
- FRP.Helm.Graphics: style :: Form -> FormStyle
- FRP.Helm.Graphics: theta :: Form -> Double
- FRP.Helm.Graphics: width :: LineStyle -> Double
- FRP.Helm.Graphics: x :: Form -> Double
- FRP.Helm.Graphics: y :: Form -> Double
+ FRP.Helm: type Time = Double
+ FRP.Helm.Animation: Animation :: [Frame] -> Animation
+ FRP.Helm.Animation: absolute :: [Frame] -> Animation
+ FRP.Helm.Animation: animate :: Animation -> SignalGen (Signal Time) -> SignalGen (Signal Bool) -> SignalGen (Signal Form)
+ FRP.Helm.Animation: formAt :: Animation -> Time -> Form
+ FRP.Helm.Animation: instance Eq Animation
+ FRP.Helm.Animation: instance Show Animation
+ FRP.Helm.Animation: length :: Animation -> Time
+ FRP.Helm.Animation: newtype Animation
+ FRP.Helm.Animation: relative :: [Frame] -> Animation
+ FRP.Helm.Animation: type Frame = (Time, Form)
+ FRP.Helm.Color: instance Ord Color
+ FRP.Helm.Color: instance Ord Gradient
+ FRP.Helm.Color: instance Read Color
+ FRP.Helm.Color: instance Read Gradient
+ FRP.Helm.Graphics: centeredCollage :: Int -> Int -> [Form] -> Element
+ FRP.Helm.Graphics: formScale :: Form -> Double
+ FRP.Helm.Graphics: formStyle :: Form -> FormStyle
+ FRP.Helm.Graphics: formTheta :: Form -> Double
+ FRP.Helm.Graphics: formX :: Form -> Double
+ FRP.Helm.Graphics: formY :: Form -> Double
+ FRP.Helm.Graphics: instance Ord FillStyle
+ FRP.Helm.Graphics: instance Ord LineJoin
+ FRP.Helm.Graphics: instance Ord Shape
+ FRP.Helm.Graphics: instance Read FillStyle
+ FRP.Helm.Graphics: instance Read LineCap
+ FRP.Helm.Graphics: instance Read LineJoin
+ FRP.Helm.Graphics: instance Read Shape
+ FRP.Helm.Graphics: lineCap :: LineStyle -> LineCap
+ FRP.Helm.Graphics: lineColor :: LineStyle -> Color
+ FRP.Helm.Graphics: lineDashOffset :: LineStyle -> Double
+ FRP.Helm.Graphics: lineDashing :: LineStyle -> [Double]
+ FRP.Helm.Graphics: lineJoin :: LineStyle -> LineJoin
+ FRP.Helm.Graphics: lineWidth :: LineStyle -> Double
+ FRP.Helm.Graphics: textHeight :: Text -> Double
+ FRP.Helm.Graphics: textSlant :: Text -> FontSlant
+ FRP.Helm.Graphics: textTypeface :: Text -> String
+ FRP.Helm.Graphics: textWeight :: Text -> FontWeight
+ FRP.Helm.Keyboard: instance Read Key
+ FRP.Helm.Mouse: instance Read Mouse
+ FRP.Helm.Signal: (<~) :: (a -> b) -> SignalGen (Signal a) -> SignalGen (Signal b)
+ FRP.Helm.Signal: (~~) :: SignalGen (Signal (a -> b)) -> SignalGen (Signal a) -> SignalGen (Signal b)
+ FRP.Helm.Signal: constant :: a -> SignalGen (Signal a)
+ FRP.Helm.Signal: count :: SignalGen (Signal Int)
+ FRP.Helm.Signal: countIf :: (a -> Bool) -> SignalGen (Signal a) -> SignalGen (Signal Int)
+ FRP.Helm.Signal: foldp :: (a -> b -> b) -> b -> SignalGen (Signal a) -> SignalGen (Signal b)
+ FRP.Helm.Signal: lift :: (a -> b) -> SignalGen (Signal a) -> SignalGen (Signal b)
+ FRP.Helm.Signal: lift2 :: (a -> b -> c) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c)
+ FRP.Helm.Signal: lift3 :: (a -> b -> c -> d) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c) -> SignalGen (Signal d)
+ FRP.Helm.Signal: lift4 :: (a -> b -> c -> d -> e) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c) -> SignalGen (Signal d) -> SignalGen (Signal e)
+ FRP.Helm.Signal: lift5 :: (a -> b -> c -> d -> e -> f) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c) -> SignalGen (Signal d) -> SignalGen (Signal e) -> SignalGen (Signal f)
+ FRP.Helm.Signal: lift6 :: (a -> b -> c -> d -> e -> f -> g) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c) -> SignalGen (Signal d) -> SignalGen (Signal e) -> SignalGen (Signal f) -> SignalGen (Signal g)
+ FRP.Helm.Signal: lift7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c) -> SignalGen (Signal d) -> SignalGen (Signal e) -> SignalGen (Signal f) -> SignalGen (Signal g) -> SignalGen (Signal h)
+ FRP.Helm.Signal: lift8 :: (a -> b -> c -> d -> e -> f -> g -> h -> i) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c) -> SignalGen (Signal d) -> SignalGen (Signal e) -> SignalGen (Signal f) -> SignalGen (Signal g) -> SignalGen (Signal h) -> SignalGen (Signal i)
+ FRP.Helm.Time: delay :: Time -> SignalGen (Signal Time)
+ FRP.Helm.Time: delta :: SignalGen (Signal Time)
+ FRP.Helm.Time: fps :: Int -> Time
+ FRP.Helm.Time: hour :: Time
+ FRP.Helm.Time: inHours :: Time -> Double
+ FRP.Helm.Time: inMilliseconds :: Time -> Double
+ FRP.Helm.Time: inMinutes :: Time -> Double
+ FRP.Helm.Time: inSeconds :: Time -> Double
+ FRP.Helm.Time: millisecond :: Time
+ FRP.Helm.Time: minute :: Time
+ FRP.Helm.Time: running :: SignalGen (Signal Time)
+ FRP.Helm.Time: second :: Time
+ FRP.Helm.Time: type Time = Double
- FRP.Helm.Color: Color :: !Double -> !Double -> !Double -> !Double -> Color
+ FRP.Helm.Color: Color :: Double -> Double -> Double -> Double -> Color
- FRP.Helm.Graphics: CollageElement :: Int -> Int -> [Form] -> Element
+ FRP.Helm.Graphics: CollageElement :: Int -> Int -> Bool -> [Form] -> Element
- FRP.Helm.Graphics: GroupForm :: Matrix -> [Form] -> FormStyle
+ FRP.Helm.Graphics: GroupForm :: (Maybe Matrix) -> [Form] -> FormStyle

Files

− FRP/Helm.hs
@@ -1,273 +0,0 @@-{-| Contains miscellaneous utility functions and the main-    functions for interfacing with the engine. -}-module FRP.Helm (-  -- * Engine-  run,-  -- * Utilities-  radians,-  degrees,-  turns,-  -- * Prelude-  module FRP.Helm.Color,-  module FRP.Helm.Graphics,-) where--import Control.Monad (void)-import Data.IORef-import Foreign.Ptr (castPtr)-import FRP.Elerea.Simple-import FRP.Helm.Color-import FRP.Helm.Graphics-import System.FilePath-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 :: Double -> Double-radians n = n--{-| Converts degrees into the standard angle measurement (radians). -}-degrees :: Double -> Double-degrees n = n * pi / 180--{-| Converts turns into the standard angle measurement (radians).-    Turns are essentially full revolutions of the unit circle. -}-turns :: Double -> Double-turns n = 2 * pi * n--{-| 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)-}--{-| 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--  return EngineState { smp = smp, cache = cache }--{-| Initializes and runs the game engine. The supplied signal generator is-    constantly sampled  for an element to render until the user quits.--    > import FRP.Helm-    > import qualified FRP.Helm.Window as Window-    >-    > render :: (Int, Int) -> Element-    > render (w, h) = collage w h [filled red $ rect (fromIntegral w) (fromIntegral h)]-    >-    > main :: IO ()-    > main = run $ do-    >   dims <- Window.dimensions-    >-    >   return $ fmap render dims- -}-run :: SignalGen (Signal Element) -> IO ()-run gen = SDL.init [SDL.InitVideo, SDL.InitJoystick] >> requestDimensions 800 600 >> start gen >>= newEngineState >>= run'--{-| 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-  continue <- run''--  if continue then smp state >>= render state >> run' state else SDL.quit--{-| 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--  case event of-    SDL.NoEvent -> return True-    SDL.Quit -> return False-    SDL.VideoResize w h -> requestDimensions w h >> run''-    _ -> run''--{-| A utility function that renders a previously sampled element-    using an engine state. -}-render :: EngineState -> Element -> IO ()-render state element = SDL.getVideoSurface >>= render' state element--{-| A utility function called by 'render\'' that does-    the actual heavy lifting. -}-render' :: EngineState -> Element -> SDL.Surface -> IO ()-render' state element screen = do-    pixels <- SDL.surfaceGetPixels screen--    Cairo.withImageSurfaceForData (castPtr pixels) Cairo.FormatRGB24 w h (w * 4) $ \surface ->-      Cairo.renderWith surface (render'' w h state element)--    SDL.flip screen--  where-    w = SDL.surfaceGetWidth screen-    h = SDL.surfaceGetHeight screen--{-| 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--  renderElement state 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)--  case Map.lookup src cached 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--      writeIORef cache (Map.insert src surface cached) >> return (surface, w, h)--{-| A utility function for rendering a specific element. -}-renderElement :: EngineState -> Element -> Cairo.Render ()-renderElement state (CollageElement _ _ forms) = void $ mapM_ (renderForm state) forms-renderElement state (ImageElement (sx, sy) sw sh src stretch) = do-  (surface, w, h) <- Cairo.liftIO $ getSurface state (normalise src)--  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--  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.setSourceRGBA r g b a-  Cairo.selectFontFace fontTypeface fontSlant fontWeight-  Cairo.setFontSize fontSize-  Cairo.showText textUTF8--{-| 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.rotate t >> Cairo.translate x y >> f >> Cairo.restore--{-| A utility function that sets the Cairo line cap based off of our version. -}-setLineCap :: LineCap -> Cairo.Render ()-setLineCap cap = -  case cap of-    Flat -> Cairo.setLineCap Cairo.LineCapButt-    Round -> Cairo.setLineCap Cairo.LineCapRound-    Padded -> Cairo.setLineCap Cairo.LineCapSquare--{-| A utility function that sets the Cairo line style based off of our version. -}-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--{-| A utility function that sets up all the necessary settings with Cairo-    to render with a line style and then strokes afterwards. Assumes-    that all drawing paths have already been setup before being called. -}-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--{-| 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)) = 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 _ (Gradient (Linear (sx, sy) (ex, ey) points)) =-  Cairo.withLinearPattern sx sy ex ey $ \pattern ->-    Cairo.setSource pattern >> mapM (\(o, Color r g b a) -> Cairo.patternAddColorStopRGBA pattern o r g b a) points >> Cairo.fill--setFillStyle _ (Gradient (Radial (sx, sy) sr (ex, ey) er points)) =-  Cairo.withRadialPattern sx sy sr ex ey er $ \pattern ->-    Cairo.setSource pattern >> mapM (\(o, Color r g b a) -> Cairo.patternAddColorStopRGBA pattern o r g b a) points >> Cairo.fill--{-| A utility that renders a form. -}-renderForm :: EngineState -> Form -> Cairo.Render ()-renderForm _ (Form { style = PathForm style p, .. }) =-  withTransform scalar theta x y $ -      void $ setLineStyle style >> Cairo.moveTo hx hy >> mapM (uncurry Cairo.lineTo) p--    where-      (hx, hy) = head p--renderForm state (Form { style = ShapeForm style (PolygonShape points), .. }) =-  withTransform scalar theta x y $ do-      Cairo.newPath >> Cairo.moveTo hx hy >> mapM (uncurry Cairo.lineTo) points >> Cairo.closePath--      case style of-        Left lineStyle -> setLineStyle lineStyle-        Right fillStyle -> setFillStyle state fillStyle--    where-      (hx, hy) = head points--renderForm state (Form { style = ShapeForm style (RectangleShape (w, h)), .. }) =-  withTransform scalar theta x y $ do-    Cairo.rectangle 0 0 w h--    case style of-      Left lineStyle -> setLineStyle lineStyle-      Right fillStyle -> setFillStyle state fillStyle--renderForm state (Form { style = ShapeForm style (ArcShape (cx, cy) a1 a2 r (sx, sy)), .. }) =-  withTransform scalar theta x y $ do-    Cairo.scale sx sy-    Cairo.arc cx cy r a1 a2-    Cairo.scale 1 1--    case style of-      Left lineStyle -> setLineStyle lineStyle-      Right fillStyle -> setFillStyle state fillStyle--renderForm state (Form { style = ElementForm element, .. }) = withTransform scalar theta x y $ renderElement state element-renderForm state (Form { style = GroupForm m forms, .. }) = withTransform scalar theta x y $ void $ Cairo.setMatrix m >> mapM (renderForm state) forms
− FRP/Helm/Automaton.hs
@@ -1,73 +0,0 @@-{-| Contains all data structures and functions for composing, calculating and creating automatons. -}-module FRP.Helm.Automaton (-  -- * Types-  Automaton(..),-  -- * Composing-  pure,-  stateful,-  combine,-  -- * Computing-  step,-  run,-  counter-) where--import Control.Arrow-import Control.Category-import Prelude hiding (id, (.))-import FRP.Elerea.Simple (Signal, SignalGen, transfer)--{-| A data structure describing an automaton.-    An automaton is essentially a high-level way to package piped behavior-    between an input signal and an output signal. Automatons can also-    be composed, allowing you to connect one automaton to another-    and pipe data between them. Automatons are an easy and powerful way-    to create composable dynamic behavior, like animation systems. -}-data Automaton a b = Step (a -> (Automaton a b, b))--instance Category Automaton where-  id = Step (\a -> (id, a))-  (Step f) . (Step g) = Step (\a -> let (g', b) = g a-                                        (f', c) = f b in (f' . g', c))--instance Arrow Automaton where-  arr = pure-  first (Step f) = Step (\(b, d) -> let (f', c) = f b in (first f', (c, d)))--{-| Creates a pure automaton that has no accumulated state. It applies input to-    a function at each step. -}-pure :: (a -> b) -> Automaton a b-pure f = Step (\x -> (pure f, f x))--{-| Creates an automaton that has an initial and accumulated state. It applies-    input and the last state to a function at each step. -}-stateful :: b -> (a -> b -> b) -> Automaton a b-stateful state f = Step (\x -> let state' = f x state in (stateful state' f, state'))--{-| Steps an automaton forward, returning the next automaton to step-    and output of the step in a tuple. -}-step :: a -> Automaton a b -> (Automaton a b, b)-step auto (Step f) = f auto--{-| Combines a list of automatons that take some input-    and turns it into an automaton that takes-    the same input and outputs a list of all outputs-    from each separate automaton. -}-combine :: [Automaton a b] -> Automaton a [b]-combine autos =-  Step (\a -> let (autos', bs) = unzip $ map (step a) autos-              in  (combine autos', bs))--{-| A useful automaton that outputs the amount of times it has been stepped,-    discarding its input value. -}-counter :: Automaton a Int-counter = stateful 0 (\_ c -> c + 1)--{-| Runs an automaton with an initial output value and input signal generator-    and creates an output signal generator that contains a signal that can be-    sampled for the output value. -}-run :: Automaton a b -> b -> SignalGen (Signal a) -> SignalGen (Signal b)-run auto ini feeder = do-  food <- feeder >>= transfer (auto, ini) (\a (Step f, _) -> f a)--  return $ fmap snd food
− FRP/Helm/Color.hs
@@ -1,177 +0,0 @@-{-| Contains all data structures and functions for composing colors. -}-module FRP.Helm.Color (-  -- * Types-  Color(..),-  Gradient(..),-  -- * Composing-  rgba,-  rgb,-  hsva,-  hsv,-  complement,-  linear,-  radial,-  -- * Constants-  red,-  lime,-  blue,-  yellow,-  cyan,-  magenta,-  black,-  white,-  gray,-  grey,-  maroon,-  navy,-  green,-  teal,-  purple,-  violet,-  forestGreen-) where--{-| A data structure describing a color. It is represented interally as an RGBA-    color, but the utility functions 'hsva', 'hsv', etc. can be used to convert-    from other popular formats to this structure. -}-data Color = Color { r :: !Double, g :: !Double, b :: !Double, a :: !Double } deriving (Show, Eq)--{-| 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--{-| A bright red color. -}-red :: Color-red = rgb 1 0 0--{-| A bright green color. -}-lime :: Color-lime = rgb 0 1 0--{-| A bright blue color. -}-blue :: Color-blue = rgb 0 0 1--{-| A yellow color, made from combining red and green. -}-yellow :: Color-yellow = rgb 1 1 0--{-| A cyan color, combined from bright green and blue. -}-cyan :: Color-cyan = rgb 0 1 1--{-| A magenta color, combined from bright red and blue. -}-magenta :: Color-magenta = rgb 1 0 1--{-| A black color. -}-black :: Color-black = rgb 0 0 0--{-| A white color. -}-white :: Color-white = rgb 1 1 1--{-| A gray color, exactly halfway between black and white. -}-gray :: Color-gray = rgb 0.5 0.5 0.5--{-| Common alternative spelling of 'gray'. -}-grey :: Color-grey = gray--{-| A medium red color. -}-maroon :: Color-maroon = rgb 0.5 0 0--{-| A medium blue color. -}-navy :: Color-navy = rgb 0 0 0.5--{-| A medium green color. -}-green :: Color-green = rgb 0 0.5 0--{-| A teal color, combined from medium green and blue. -}-teal :: Color-teal = rgb 0 0.5 0.5--{-| A purple color, combined from medium red and blue. -}-purple :: Color-purple = rgb 0.5 0 0.5--{-| A violet color. -}-violet :: Color-violet = rgb 0.923 0.508 0.923--{-| A dark green color. -}-forestGreen :: Color-forestGreen = rgb 0.133 0.543 0.133--{-| Calculate a complementary color for a provided color. Useful for outlining-    a filled shape in a color clearly distinguishable from the fill color. -}-complement :: Color -> Color-complement (Color r g b a) = hsva (fromIntegral ((round (h + 180) :: Int) `mod` 360)) (s / mx) mx a-  where-    mx = r `max` g `max` b-    mn = r `min` g `min` b-    s = mx - mn-    h | mx == r = (g - b) / s * 60-      | mx == g = (b - r) / s * 60 + 120-      | mx == b = (r - g) / s * 60 + 240-      | otherwise = undefined--{-| Create an RGBA color from HSVA values. -}-hsva :: Double -> Double -> Double -> Double -> Color-hsva h s v a-  | h'' == 0 = rgba v t p a-  | h'' == 1 = rgba q v p a-  | h'' == 2 = rgba p v t a-  | h'' == 3 = rgba p q v a-  | h'' == 4 = rgba t p v a-  | h'' == 5 = rgba v p q a-  | otherwise = undefined--  where-    h' = h / 60-    h'' = floor h' `mod` 6 :: Int-    f = h' - fromIntegral h''-    p = v * (1 - s)-    q = v * (1 - f * s)-    t = v * (1 - (1 - f) * s)    --{-| Create an RGB color from HSV values. -}-hsv :: Double -> Double -> Double -> Color-hsv h s v = hsva h s v 1--{-| A data structure describing a gradient. There are two types of gradients:-    radial and linear. Radial gradients are based on a set of colors transitioned-    over certain radii in an arc pattern. Linear gradients are a set of colors-    transitioned in a straight line. -}-data Gradient = Linear (Double, Double) (Double, Double) [(Double, Color)] |-                Radial (Double, Double) Double (Double, Double) Double [(Double, Color)] deriving (Show, Eq)---{-| Creates a linear gradient. Takes a starting position, ending position and a list-    of color stops (which are colors combined with a floating value between /0.0/ and /1.0/-    that describes at what step along the line between the starting position-    and ending position the paired color should be transitioned to).--	> linear (0, 0) (100, 100) [(0, black), (1, white)]--	The above example creates a gradient that starts at /(0, 0)/-	and ends at /(100, 100)/. In other words, it's a diagonal gradient, transitioning from the top-left-	to the bottom-right. The provided color stops result in the gradient transitioning from-	black to white.- -}-linear :: (Double, Double) -> (Double, Double) -> [(Double, Color)] -> Gradient-linear = Linear--{-| Creates a radial gradient. Takes a starting position and radius, ending position and radius-    and a list of color stops. See the document for 'linear' for more information on color stops. -}-radial :: (Double, Double) -> Double -> (Double, Double) -> Double -> [(Double, Color)] -> Gradient-radial = Radial
− FRP/Helm/Graphics.hs
@@ -1,276 +0,0 @@-{-| Contains all the data structures and functions for composing-    and rendering graphics. -}-module FRP.Helm.Graphics (-  -- * Types-  Element(..),-  Text(..),-  Form(..),-  FormStyle(..),-  FillStyle(..),-  LineCap(..),-  LineJoin(..),-  LineStyle(..),-  Path,-  Shape(..),-  -- * Elements-  image,-  fittedImage,-  croppedImage,-  collage,-  -- * Styles & Forms-  defaultLine,-  solid,-  dashed,-  dotted,-  filled,-  textured,-  gradient,-  outlined,-  traced,-  sprite,-  toForm,-  -- * Grouping-  group,-  groupTransform,-  -- * Transforming-  rotate,-  scale,-  move,-  moveX,-  moveY,-  -- * Paths-  path,-  segment,-  -- * Shapes-  polygon,-  rect,-  square,-  oval,-  circle,-  ngon-) where--import FRP.Helm.Color (Color, black, Gradient)-import Graphics.Rendering.Cairo.Matrix (Matrix, identity)-import qualified Graphics.Rendering.Cairo as Cairo--{-| A data structure describing something that can be rendered-    to the screen. Elements are the most important structure-    in Helm. Games essentially feed the engine a stream-    of elements which are then rendered directly to the screen.-    The usual way to render art in a Helm game is to call-    off to the 'collage' function, which essentially-    renders a collection of forms together. -}-data Element = CollageElement Int Int [Form] |-               ImageElement (Int, Int) Int Int FilePath Bool |-               TextElement Text deriving (Show, Eq)--{-| A data structure describing a piece of formatted text. -}-data Text = Text {-  textUTF8 :: String,-  textColor :: Color,-  fontTypeface :: String,-  fontSize :: Double,-  fontWeight :: Cairo.FontWeight,-  fontSlant :: Cairo.FontSlant-} deriving (Show, Eq)--{-| Create an element from an image with a given width, height and image file path.-    If the image dimensions are not the same as given, then it will stretch/shrink to fit.-    Only PNG files are supported currently. -}-image :: Int -> Int -> FilePath -> Element-image w h src = ImageElement (0, 0) w h src True--{-| Create an element from an image with a given width, height and image file path.-    If the image dimensions are not the same as given, then it will only use the relevant pixels-    (i.e. cut out the given dimensions instead of scaling). If the given dimensions are bigger than-    the actual image, than irrelevant pixels are ignored. -}-fittedImage :: Int -> Int -> FilePath -> Element-fittedImage w h src = ImageElement (0, 0) w h src False--{-| Create an element from an image by cropping it with a certain position, width, height-    and image file path. This can be used to divide a single image up into smaller ones. -}-croppedImage :: (Int, Int) -> Int -> Int -> FilePath -> Element-croppedImage pos w h src = ImageElement pos w h src False--{-| A data structure describing a form. A form is essentially a notion of a transformed-    graphic, whether it be an element or shape. See 'FormStyle' for an insight-    into what sort of graphics can be wrapped in a form. -}-data Form = Form {-  theta :: Double,-  scalar :: Double,-  x :: Double,-  y :: Double,-  style :: FormStyle-} deriving (Show, Eq)--{-| A data structure describing how a shape or path looks when filled. -}-data FillStyle = Solid Color | Texture String | Gradient Gradient deriving (Show, Eq)--{-| A data structure describing the shape of the ends of a line. -}-data LineCap = Flat | Round | Padded deriving (Show, Eq, Enum, Ord)--{-| A data structure describing the shape of the join of a line, i.e.-    where separate line segments join. The 'Sharp' variant takes-    an argument to limit the length of the join. -}-data LineJoin = Smooth | Sharp Double | Clipped deriving (Show, Eq)--{-| A data structure describing how a shape or path looks when stroked. -}-data LineStyle = LineStyle {-  color :: Color,-  width :: Double,-  cap :: LineCap,-  join :: LineJoin,-  dashing :: [Double],-  dashOffset :: Double-} deriving (Show, Eq)--{-| Creates the default line style. By default, the line is black with a width of 1,-    flat caps and regular sharp joints. -}-defaultLine :: LineStyle-defaultLine = LineStyle {-  color = black,-  width = 1,-  cap = Flat,-  join = Sharp 10,-  dashing = [],-  dashOffset = 0-}--{-| Create a solid line style with a color. -}-solid :: Color -> LineStyle-solid color = defaultLine { color = color }--{-| Create a dashed line style with a color. -}-dashed :: Color -> LineStyle-dashed color = defaultLine { color = color, dashing = [8, 4] }--{-| Create a dotted line style with a color. -}-dotted :: Color -> LineStyle-dotted color = defaultLine { color = color, dashing = [3, 3] }--{-| A data structure describing a few ways that graphics that can be wrapped in a form-    and hence transformed. -}-data FormStyle = PathForm LineStyle Path |-                 ShapeForm (Either LineStyle FillStyle) Shape |-                 ElementForm Element |-                 GroupForm Matrix [Form] deriving (Show, Eq)--{-| Utility function for creating a form. -}-form :: FormStyle -> Form-form style = Form { theta = 0, scalar = 1, x = 0, y = 0, style = style }--{-| Utility function for creating a filled form from a fill style and shape. -}-fill :: FillStyle -> Shape -> Form-fill style shape = form (ShapeForm (Right style) shape)--{-| Creates a form from a shape by filling it with a specific color. -}-filled :: Color -> Shape -> Form-filled color = fill (Solid color)--{-| Creates a form from a shape with a tiled texture and image file path. -}-textured :: String -> Shape -> Form-textured src = fill (Texture src)--{-| Creates a form from a shape filled with a gradient. -}-gradient :: Gradient -> Shape -> Form-gradient grad = fill (Gradient grad)--{-| Creates a form from a shape by outlining it with a specific line style. -}-outlined :: LineStyle -> Shape -> Form-outlined style shape = form (ShapeForm (Left style) shape)--{-| Creates a form from a path by tracing it with a specific line style. -}-traced :: LineStyle -> Path -> Form-traced style p = form (PathForm style p)--{-| Creates a form from a image file path with additional position, width and height arguments.-    Allows you to splice smaller parts from a single image. -}-sprite :: Int -> Int -> (Int, Int) -> FilePath -> Form-sprite w h pos src = form (ElementForm (ImageElement pos w h src False))--{-| Creates a form from an element. -}-toForm :: Element -> Form-toForm element = form (ElementForm element)--{-| Groups a collection of forms into a single one. -}-group :: [Form] -> Form-group forms = form (GroupForm identity forms)--{-| Groups a collection of forms into a single one, also applying a matrix transformation. -}-groupTransform :: Matrix -> [Form] -> Form-groupTransform matrix forms = form (GroupForm matrix forms)--{-| Rotates a form by an amount (in radians). -}-rotate :: Double -> Form -> Form-rotate t f = f { theta = t + theta f }--{-| Scales a form by an amount, e.g. scaling by /2.0/ will double the size. -}-scale :: Double -> Form -> Form-scale n f = f { scalar = n + scalar f }--{-| Moves a form relative to its current position. -}-move :: (Double, Double) -> Form -> Form-move (rx, ry) f = f { x = rx + x f, y = ry + y f }--{-| Moves a form's x-coordinate relative to its current position. -}-moveX :: Double -> Form -> Form-moveX x = move (x, 0)--{-| Moves a form's y-coordinate relative to its current position. -}-moveY :: Double -> Form -> Form-moveY y = move (0, y)--{-| Create an element from a collection of forms, with width and height arguments.-    Can be used to directly render a collection of forms.--    > collage 800 600 [move (100, 100) $ filled red $ square 100,-    >                  move (100, 100) $ outlined (solid white) $ circle 50]- -}-collage :: Int -> Int -> [Form] -> Element-collage = CollageElement--{-| A data type made up a collection of points that form a path when joined. -}-type Path = [(Double, Double)]--{-| Creates a path for a collection of points. -}-path :: [(Double, Double)] -> Path-path points = points--{-| Creates a path from a line segment, i.e. a start and end point. -}-segment :: (Double, Double) -> (Double, Double) -> Path-segment p1 p2 = [p1, p2]--{-| A data structure describing a some sort of graphically representable object,-    such as a polygon formed from a set of points or a rectangle. -}-data Shape = PolygonShape Path |-             RectangleShape (Double, Double) |-             ArcShape (Double, Double) Double Double Double (Double, Double) deriving (Show, Eq)--{-| Creates a shape from a path (a set of points). -}-polygon :: Path -> Shape-polygon = PolygonShape--{-| Creates a rectangular shape with a width and height. -}-rect :: Double -> Double -> Shape-rect w h = RectangleShape (w, h)--{-| Creates a square shape with a side length. -}-square :: Double -> Shape-square n = rect n n--{-| Creates an oval shape with a width and height. -}-oval :: Double -> Double -> Shape-oval w h = ArcShape (0, 0) 0 (2 * pi) 1 (w / 2, h / 2)--{-| Creates a circle shape with a radius. -}-circle :: Double -> Shape-circle r = ArcShape (0, 0) 0 (2 * pi) r (1, 1)--{-| Creates a generic n-sided polygon (e.g. octagon, pentagon, etc) with-    an amount of sides and radius. -}-ngon :: Int -> Double -> Shape-ngon n r = PolygonShape (map (\i -> (r * cos (t * i), r * sin (t * i))) [0 .. fromIntegral (n - 1)])-  where -    m = fromIntegral n-    t = 2 * pi / m
− FRP/Helm/Joystick.hs
@@ -1,105 +0,0 @@-{-| Contains signals that sample input from joysticks. -}-module FRP.Helm.Joystick (-  -- * Types-  Joystick,-  -- * Probing-  available,-  name,-  open,-  index,-  availableAxes,-  availableBalls,-  availableHats,-  availableButtons,-  -- * Joystick State-  axis,-  hat,-  button,-  ball-) where--import Control.Applicative-import Data.Int (Int16)-import FRP.Elerea.Simple-import qualified Graphics.UI.SDL as SDL--{-| A type describing a joystick. -}-type Joystick = SDL.Joystick--{-| The amount of joysticks available. -}-available :: SignalGen (Signal Int)-available = effectful SDL.countAvailable--{-| The name of a joystick. -}-name :: Int -> SignalGen (Signal String)-name i = effectful $ SDL.name i--{-| The joystick at a certain slot. -}-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)
− FRP/Helm/Keyboard.hs
@@ -1,379 +0,0 @@-{-| Contains signals that sample input from the keyboard. -}-module FRP.Helm.Keyboard (-  -- * Types-  Key(..),-  -- * Key State-  shift, ctrl, enter,-  space, isDown, keysDown,-  -- * Directions-  arrows, wasd-) where--import Control.Applicative-import Data.List-import Foreign hiding (shift)-import Foreign.C.Types-import FRP.Elerea.Simple-import qualified Graphics.UI.SDL as SDL--{-| The SDL bindings for Haskell don't wrap this, so we have to use the FFI ourselves. -}-foreign import ccall unsafe "SDL_GetKeyState" sdlGetKeyState :: Ptr CInt -> IO (Ptr Word8)--{-| A utility function for getting a list of SDL keys currently pressed.-    Based on <http://coderepos.org/share/browser/lang/haskell/nario/Main.hs?rev=22646#L49>. -}-getKeyState :: IO [Int]-getKeyState = alloca $ \numkeysPtr -> do-  keysPtr <- sdlGetKeyState numkeysPtr-  numkeys <- peek numkeysPtr-  (map fromIntegral . elemIndices 1) <$> peekArray (fromIntegral numkeys) keysPtr--{-| A data structure describing a physical key on a keyboard. -}-data Key = BackspaceKey | TabKey | ClearKey | EnterKey | PauseKey | EscapeKey |-           SpaceKey | ExclaimKey | QuotedBlKey | HashKey | DollarKey | AmpersandKey |-           QuoteKey | LeftParenKey | RightParenKey | AsteriskKey | PlusKey | CommaKey |-           MinusKey | PeriodKey | SlashKey | Num0Key | Num1Key | Num2Key |-           Num3Key | Num4Key | Num5Key | Num6Key | Num7Key | Num8Key |-           Num9Key | ColonKey | SemicolonKey | LessKey | EqualsKey | GreaterKey |-           QuestionKey | AtKey | LeftBracketKey | BackslashKey | RightBracketKey | CaretKey |-           UnderscoreKey | BackquoteKey | AKey | BKey | CKey | DKey |-           EKey | FKey | GKey | HKey | IKey | JKey | KKey |-           LKey | MKey | NKey | OKey | PKey | QKey |-           RKey | SKey | TKey | UKey | VKey | WKey |-           XKey | YKey | ZKey | DeleteKey | KeypadNum0Key | KeypadNum1Key |-           KeypadNum2Key | KeypadNum3Key | KeypadNum4Key | KeypadNum5Key | KeypadNum6Key | KeypadNum7Key |-           KeypadNum8Key | KeypadNum9Key | KeypadPeriodKey | KeypadDivideKey | KeypadMultiplyKey | KeypadMinusKey |-           KeypadPlusKey | KeypadEnterKey | KeypadEqualsKey | UpKey | DownKey | RightKey |-           LeftKey | InsertKey | HomeKey | EndKey | PageUpKey | PageDownKey |-           F1Key | F2Key | F3Key | F4Key |  F5Key | F6Key |-           F7Key | F8Key | F9Key | F10Key | F11Key | F12Key |-           F13Key | F14Key | F15Key | NumLockKey | CapsLockKey | ScrollLockKey |-           RShiftKey | LShiftKey | RCtrlKey | LCtrlKey | RAltKey | LAltKey |-           RMetaKey | LMetaKey | RSuperKey | LSuperKey | ModeKey | ComposeKey | HelpKey |-           PrintKey | SysReqKey | BreakKey | MenuKey | PowerKey | EuroKey |-           UndoKey deriving (Show, Eq, Ord)--{- 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--{-| A list of keys that are currently being pressed. -}-keysDown :: SignalGen (Signal [Key])-keysDown = effectful $ map toEnum <$> getKeyState--{-| A directional tuple combined from the arrow keys. When none of the arrow keys-    are being pressed this signal samples to /(0, 0)/, otherwise it samples to a-    direction based on which keys are pressed. For example, pressing the left key-    results in /(-1, 0)/, the down key /(0, 1)/, up and right /(1, -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--{-| A utility function for setting up a vector signal from directional keys. -}-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 popular WASD movement controls 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
@@ -1,45 +0,0 @@-{-| Contains signals that sample input from the mouse. -}-module FRP.Helm.Mouse (-  -- * Types-  Mouse(..),-  -- * Position-  isDown,-  -- * Mouse State-  position, x, y-) where--import Control.Applicative-import FRP.Elerea.Simple-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)--{- 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--  toEnum 1 = LeftMouse-  toEnum 2 = MiddleMouse-  toEnum 3 = RightMouse-  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--{-| 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--{-| 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
− FRP/Helm/Text.hs
@@ -1,91 +0,0 @@-{-| Contains all the data structures and functions for composing-    pieces of formatted text. -}-module FRP.Helm.Text (-  -- * Elements-  plainText,-  asText,-  text,-  -- * Composing-  defaultText,-  toText,-  -- * Formatting-  bold,-  italic,-  color,-  monospace,-  typeface,-  header,-  height-) where--import FRP.Helm.Color (Color, black)-import FRP.Helm.Graphics (Element(TextElement), Text(..))-import qualified Graphics.Rendering.Cairo as Cairo--{-| Creates the default text. By default the text is black sans-serif-    with a height of 14px. -}-defaultText :: Text-defaultText = Text {-  textUTF8 = "",-  textColor = black,-  fontTypeface = "sans-serif",-  fontSize = 14,-  fontWeight = Cairo.FontWeightNormal,-  fontSlant = Cairo.FontSlantNormal-}--{-| Creates a text from a string. -}-toText :: String -> Text-toText utf8 = defaultText { textUTF8 = utf8 }--{-| Creates a text element from a string. -}-plainText :: String -> Element-plainText utf8 = text $ toText utf8--{-| Creates a text element from any showable type, defaulting to-    the monospace typeface. -}-asText :: Show a => a -> Element-asText val = text $ monospace $ toText $ show val--{-| Creates an element from a text. -}-text :: Text -> Element-text = TextElement--{- TODO:-centered-justified-righted-underline-strikeThrough-overline--}--{-| Sets the weight of a piece of text to bold. -}-bold :: Text -> Text-bold txt = txt { fontWeight = Cairo.FontWeightBold }--{-| Sets the slant of a piece of text to italic. -}-italic :: Text -> Text-italic txt = txt { fontSlant = Cairo.FontSlantItalic }--{-| Sets the color of a piece of text. -}-color :: Color -> Text -> Text-color col txt = txt { textColor = col }--{-| Sets the typeface of the text to monospace. -}-monospace :: Text -> Text-monospace txt = txt { fontTypeface = "monospace" }--{-| Sets the typeface of the text. Only fonts-    supported by Cairo's toy font API are currently-    supported. -}-typeface :: String -> Text -> Text-typeface face txt = txt { fontTypeface = face }--{-| Sets the size of a text noticeably large. -}-header :: Text -> Text-header = height 32--{-| Sets the size of a piece of text. -}-height :: Double -> Text -> Text-height size txt = txt { fontSize = size }
− FRP/Helm/Window.hs
@@ -1,22 +0,0 @@-{-| Contains signals that sample input from the game window. -}-module FRP.Helm.Window (-	-- * Dimensions-	dimensions, width, height-) where--import Control.Applicative-import Control.Arrow-import FRP.Elerea.Simple-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--{-| 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
README.md view
@@ -1,4 +1,6 @@-# Helm+<p align="center">+  <a href="http://helm-engine.org" title="Homepage"><img src="http://helm-engine.org/img/logo-alt.png"/></a>+</p>  ## Introduction @@ -6,54 +8,48 @@ the [Elerea FRP framework](https://github.com/cobbpg/elerea). Helm is heavily inspired by the [Elm programming language](http://elm-lang.org) (especially the API). All rendering is done through a vector-graphics based API. At the core, Helm is-built on SDL and the Cairo vector graphics library. The plan is to change to a more-robust setup in the future, such as a lightweight homebrewed renderer built on OpenGL.-But for now, Cairo performs pretty well.+built on SDL and the Cairo vector graphics library.  In Helm, every piece of input that can be gathered from a user (or the operating system) is hidden behind a signal. For those unfamiliar with FRP, signals are essentially a value that changes over time. This sort of architecture used for a game allows for pretty simplistic (and in my opinion, artistic) code. +Documentation of the Helm API is available on [Hackage](http://hackage.haskell.org/package/helm).+There is currently a heavily work-in-progress guide on [Helm's website](http://helm-engine.org/guide),+which is a resource aiming to give thorough explanations of the way Helm and its API work through examples.+ ## Features  * Allows you to express game logic dependent on input in a straightforward manner,   treating events as first class values (the essence of FRP).- * Vector graphics based rendering, allow you to either write art   designed for any resolution or still load generic images and render-  those as you would with any pixel-based direct blitting game engine.-+  those as you would with any pixel-blitting engine. * Straightforward API heavily inspired by the Elm programming language. The API   is broken up into the following areas:-   * `FRP.Helm` contains the main code for interfacing with the game engine but     also includes some utility functions and the modules `FRP.Helm.Color` and `FRP.Helm.Graphics`     in the style of a sort of prelude library, allowing it to be included 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     and then turning it into an element.-+  * `FRP.Helm.Time` contains functions for composing units of time and signals that sample from the game clock.   * `FRP.Helm.Window` contains signals for working with the game window state.  ## Example@@ -68,10 +64,7 @@ render (w, h) = collage w h [move (100, 100) $ filled red $ square 64]  main :: IO ()-main = run $ do-  dims <- Window.dimensions--  return $ fmap render dims+main = run $ render <~ Window.dimensions ```  It renders a red square at the position `(100, 100)` with a side length of 64px.  @@ -81,8 +74,6 @@ You should see a white square on the screen and pressing the arrow keys allows you to move it.  ```haskell-{-# LANGUAGE RecordWildCards #-}- import Control.Applicative import FRP.Elerea.Simple import FRP.Helm@@ -96,17 +87,19 @@                               my = (realToFrac dy) + my state }  render :: (Int, Int) -> State -> Element-render (w, h) (State { .. }) = collage w h [move (mx, my) $ filled white $ square 100]+render (w, h) (State { mx = mx, my = my }) =+  centeredCollage w h [move (mx, my) $ filled white $ square 100]  main :: IO ()-main = run $ do-  dims <- Window.dimensions-  arrows <- Keyboard.arrows-  stepper <- transfer (State { mx = 0, my = 100 }) step arrows+main = run $ render <~ Window.dimensions ~~ stepper+  where+    state = State { mx = 0, my = 0 }+    stepper = foldp step state Keyboard.arrows -  return $ render <$> dims <*> stepper ``` +Checkout the demos folder for more examples.+ ## Installing and Building  Helm requires GHC 7.6 (Elerea doesn't work with older versions due to a compiler bug).@@ -123,56 +116,36 @@ ```  You may need to jump a few hoops to install the Cairo bindings (which are a dependency),-which unfortunately is out of my hands.+which unfortunately is out of my hands. Read the [installing guide](http://helm-engine.org/guide/installing/)+on the website for a few platform-specific instructions.  ## License -Helm is licensed under the MIT license. See the `LICENSE` file for more details.+Helm is licensed under the MIT license. See the LICENSE file for more details.  ## Contributing  Helm would benefit from either of the following contributions:  1. Try out the engine, reporting any issues or suggestions you have.- 2. Look through the source, get a feel for the code and then    contribute some features or fixes. If you plan on contributing    code please submit a pull request and follow the formatting    styles set out in the current code: 2 space indents, documentation    on every top-level function, favouring monad operators over-   do blocks, etc.--The following is a list of areas I want to tackle in the future, -and possible targets that others could try for:--* Improve the API. There's a few API calls from Elm that would work-  just as nicely in Helm. These are marked inside TODOs in the code.-  There also other important things that it's missing,-  such as audio, joysticks and loading a larger range of-  image formats.+   do blocks when there is a logical flow of data, spaces between operators+   and after commas, etc. Please also confirm that the code passes under+   HLint. -* Backend wise, it would be nice to use OpenGL instead of Cairo.-  Cairo isn't particuarly that well performing for graphic intensive games,-  although work is done being towards to fix that. However, using-  OpenGL would make the engine more lightweight, easier to port-  and be incredibly easier to accelerate. This means I have-  to write the full vector graphics stack myself, but the worse part-  will probably just be line styles, the rest should be moderately easy.-  This will also allow loading of multiple image formats, as the current-  reason for not using SDL_image is that it's annoying as fuck-  to integrate with Cairo. Helm also currently uses the Cairo toy text-  API for rendering, which isn't suppose to be used in production. If switched-  to OpenGL, SDL_ttf would be a better fit.+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.-  It's a little hard to set up a test framework for a game engine,-  but I have a few ideas, such as writing a dummy version of the backend-  that simply renders to a PNG file that is fed fake (but predictable) input,-  which is then compared to a static PNG file to see if the final expected-  rendering outcome was achieved.-+  See [issue #2](https://github.com/z0w0/helm/issues/2). * 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. But I'd definitely-  also like to investigate Android and iOS.+  on Windows or OSX after setting up the dependencies.+  See [issue #3](https://github.com/z0w0/helm/issues/3).
helm.cabal view
@@ -1,5 +1,5 @@ name: helm-version: 0.3.1+version: 0.4 synopsis: A functionally reactive game engine. description: A functionally reactive game engine, with headgear to protect you              from the headache of game development provided.@@ -21,15 +21,19 @@   location: git://github.com/z0w0/helm.git  library+  hs-source-dirs: src   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.Signal     FRP.Helm.Text+    FRP.Helm.Time     FRP.Helm.Window   build-depends:     base >= 4 && < 5,@@ -40,4 +44,20 @@     SDL >= 0.6 && < 1   default-language: Haskell2010   default-extensions: RecordWildCards, NamedFieldPuns-  ghc-options: -Wall+  ghc-options: -Wall -fno-warn-unused-do-bind++test-suite helm-tests+  type: exitcode-stdio-1.0+  x-uses-tf: true+  ghc-options: -Wall -rtsopts+  hs-source-dirs: tests, src+  default-language: Haskell2010+  build-depends:+    base >= 4 && < 5,+    HUnit >= 1.2 && < 2,+    test-framework >= 0.8 && < 1,+    test-framework-hunit >= 0.3 && < 1,+    test-framework-quickcheck2 >= 0.3 && < 1,+    elerea >= 2.7 && < 3,+    SDL >= 0.6 && < 1+  main-is: Main.hs
+ src/FRP/Helm.hs view
@@ -0,0 +1,289 @@+{-| Contains miscellaneous utility functions and the main+    functions for interfacing with the engine. -}+module FRP.Helm (+  -- * Types+  Time,+  -- * Engine+  run,+  -- * Utilities+  radians,+  degrees,+  turns,+  -- * Prelude+  module Color,+  module Graphics,+  module Signal,+) where++import Control.Exception+import Control.Monad (when)+import Data.Foldable (forM_)+import Data.IORef+import Foreign.Ptr (castPtr)+import FRP.Elerea.Simple+import FRP.Helm.Color as Color+import FRP.Helm.Graphics as Graphics+import FRP.Helm.Signal as Signal+import FRP.Helm.Time (Time)+import System.FilePath+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 :: Double -> Double+radians n = n++{-| Converts degrees into the standard angle measurement (radians). -}+degrees :: Double -> Double+degrees n = n * pi / 180++{-| Converts turns into the standard angle measurement (radians).+    Turns are essentially full revolutions of the unit circle. -}+turns :: Double -> Double+turns n = 2 * pi * n++{-| 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)+}++{-| 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++  return EngineState { smp = smp, cache = cache }++{-| Initializes and runs the game engine. The supplied signal generator is+    constantly sampled for an element to render until the user quits.++    > import FRP.Helm+    > import qualified FRP.Helm.Window as Window+    >+    > render :: (Int, Int) -> Element+    > render (w, h) = collage w h [filled red $ rect (fromIntegral w) (fromIntegral h)]+    >+    > main :: IO ()+    > main = run $ fmap (fmap render) Window.dimensions+ -}+run :: SignalGen (Signal Element) -> IO ()+run gen = finally SDL.quit $ do+  SDL.init [SDL.InitVideo, SDL.InitJoystick]+  requestDimensions 800 600+  start gen >>= newEngineState >>= run'++{-| 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+  continue <- run''++  when continue $ smp state >>= render state >> run' state++{-| 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++  case event of+    SDL.NoEvent -> return True+    SDL.Quit -> return False+    SDL.VideoResize w h -> requestDimensions w h >> run''+    _ -> run''++{-| A utility function that renders a previously sampled element+    using an engine state. -}+render :: EngineState -> Element -> IO ()+render state element = SDL.getVideoSurface >>= render' state element++{-| A utility function called by 'render\'' that does+    the actual heavy lifting. -}+render' :: EngineState -> Element -> SDL.Surface -> IO ()+render' state element screen = do+    pixels <- SDL.surfaceGetPixels screen++    Cairo.withImageSurfaceForData (castPtr pixels) Cairo.FormatRGB24 w h (w * 4) $ \surface ->+      Cairo.renderWith surface (render'' w h state element)++    SDL.flip screen++  where+    w = SDL.surfaceGetWidth screen+    h = SDL.surfaceGetHeight screen++{-| 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++  renderElement state 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)++  case Map.lookup src cached 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++      writeIORef cache (Map.insert src surface cached) >> return (surface, w, h)++{-| A utility function for rendering a specific element. -}+renderElement :: EngineState -> Element -> Cairo.Render ()+renderElement state (CollageElement w h centered forms) = do+  Cairo.save+  Cairo.rectangle 0 0 (fromIntegral w) (fromIntegral h)+  Cairo.clip+  when centered $ Cairo.translate (fromIntegral w / 2) (fromIntegral h / 2)+  mapM_ (renderForm state) forms+  Cairo.restore++renderElement state (ImageElement (sx, sy) sw sh src stretch) = do+  (surface, w, h) <- Cairo.liftIO $ getSurface state (normalise src)++  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++  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.setSourceRGBA r g b a+  Cairo.selectFontFace textTypeface textSlant textWeight+  Cairo.setFontSize textHeight+  Cairo.showText textUTF8++{-| 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++{-| A utility function that sets the Cairo line cap based off of our version. -}+setLineCap :: LineCap -> Cairo.Render ()+setLineCap cap = case cap of+  Flat   -> Cairo.setLineCap Cairo.LineCapButt+  Round  -> Cairo.setLineCap Cairo.LineCapRound+  Padded -> Cairo.setLineCap Cairo.LineCapSquare++{-| A utility function that sets the Cairo line style based off of our version. -}+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++{-| A utility function that sets up all the necessary settings with Cairo+    to render with a line style and then strokes afterwards. Assumes+    that all drawing paths have already been setup before being called. -}+setLineStyle :: LineStyle -> Cairo.Render ()+setLineStyle (LineStyle { lineColor = Color r g b a, .. }) = do+  Cairo.setSourceRGBA r g b a+  setLineCap lineCap+  setLineJoin lineJoin+  Cairo.setLineWidth lineWidth+  Cairo.setDash lineDashing lineDashOffset+  Cairo.stroke++{-| 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 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 _ (Gradient (Linear (sx, sy) (ex, ey) points)) =+  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++{-| A utility function that adds color stops to a pattern and then fills it. -}+setFillStyle' :: Cairo.Pattern -> [(Double, Color)] -> Cairo.Render ()+setFillStyle' pattern points = do+  Cairo.setSource pattern+  mapM_ (\(o, Color r g b a) -> Cairo.patternAddColorStopRGBA pattern o r g b a) points+  Cairo.fill++{-| A utility that renders a form. -}+renderForm :: EngineState -> Form -> Cairo.Render ()+renderForm state Form { .. } = withTransform formScale formTheta formX formY $+  case formStyle of+    PathForm style ~ps @ ((hx, hy) : _) -> do+      setLineStyle style+      Cairo.moveTo hx hy+      mapM_ (uncurry Cairo.lineTo) ps++    ShapeForm style shape -> do+      case shape of+        PolygonShape ~ps @ ((hx, hy) : _) -> do+          Cairo.newPath+          Cairo.moveTo hx hy+          mapM_ (uncurry Cairo.lineTo) ps+          Cairo.closePath++        RectangleShape (w, h) -> 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++      either setLineStyle (setFillStyle state) style++    ElementForm element -> renderElement state element+    GroupForm mayhaps forms -> do+      Cairo.save+      forM_ mayhaps Cairo.setMatrix+      mapM_ (renderForm state) forms+      Cairo.restore
+ src/FRP/Helm/Animation.hs view
@@ -0,0 +1,85 @@+{-| Contains all data structures and functions for creating and stepping animations. -}+module FRP.Helm.Animation (+  -- * Types+  Frame,+  Animation(..),+  -- * Creating+  absolute,+  relative,+  -- * Animating+  animate,+  formAt,+  length+) where++import Prelude hiding (length)++import FRP.Elerea.Simple+import Control.Applicative+import FRP.Helm.Graphics (Form)+import FRP.Helm.Time (Time)+import Data.Maybe (fromJust)+import Data.List (find)++{-| A type describing a single frame in an animation. A frame consists of a time at+    which the frame takes place in an animation and the form which is how the frame+    actually looks when rendered. -}+type Frame = (Time, Form)++{-| A type describing an animation consisting of a list of frames. -}+newtype Animation = Animation [Frame] deriving (Show, Eq)++{-| 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.+    The list of frames should never be empty.+ -}+absolute :: [Frame] -> Animation+absolute = Animation++{-| Creates an animation from a list of frames. The time value in each frame+    is relative to other frames, i.e. each time value is the difference+    in time from the last frame. The list of frames should never be empty.++    > relative [(100, picture1), (100, picture2), (300, picture3)] == absolute [(100, picture1), (200, picture2), (500, picture3)]+ -}+relative :: [Frame] -> Animation+relative frames = Animation $ scanl1 (\acc x -> (fst acc + fst x, snd x)) frames++{-| 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 Bool) -> SignalGen (Signal Form)+animate anim dt cont = do+  dt1 <- dt+  cont1 <- cont+  progress <- transfer2 0 (\t r animT -> if r then t else resetThisAnim (animT + t)) dt1 cont1++  return $ (formAt anim) <$> progress+    where+      resetThisAnim = resetOnEnd anim++{-| The form that will be rendered for a specific time in an animation. -}+formAt :: Animation -> Time -> Form+formAt (Animation anim) t = snd $ fromJust $ find (\frame -> t < (fst frame)) anim++{-| The amount of time one cycle of the animation takes. -}+length :: Animation -> Time+length = maximum . times++{-| A list of all the time values of each frame in the animation. -}+times :: Animation -> [Time]+times (Animation anim) = map fst anim++{-| Given an animation, a function is created which resets the time of the animation+    if the animation was finished. -}+resetOnEnd :: Animation -> (Time -> Time)+resetOnEnd anim = resetOnEnd' (length anim)++{-| Helper function which resets a timer if the timer got bigger than a given number. -}+resetOnEnd' :: Time -> Time -> Time+resetOnEnd' l t+  | t >= l = 0+  | otherwise = t
+ src/FRP/Helm/Automaton.hs view
@@ -0,0 +1,73 @@+{-| Contains all data structures and functions for composing, calculating and creating automatons. -}+module FRP.Helm.Automaton (+  -- * Types+  Automaton(..),+  -- * Composing+  pure,+  stateful,+  combine,+  -- * Computing+  step,+  run,+  counter+) where++import Control.Arrow+import Control.Category+import Prelude hiding (id, (.))+import FRP.Elerea.Simple (Signal, SignalGen, transfer)++{-| A data structure describing an automaton.+    An automaton is essentially a high-level way to package piped behavior+    between an input signal and an output signal. Automatons can also+    be composed, allowing you to connect one automaton to another+    and pipe data between them. Automatons are an easy and powerful way+    to create composable dynamic behavior, like animation systems. -}+data Automaton a b = Step (a -> (Automaton a b, b))++instance Category Automaton where+  id = Step (\a -> (id, a))+  (Step f) . (Step g) = Step (\a -> let (g', b) = g a+                                        (f', c) = f b in (f' . g', c))++instance Arrow Automaton where+  arr = pure+  first (Step f) = Step (\(b, d) -> let (f', c) = f b in (first f', (c, d)))++{-| Creates a pure automaton that has no accumulated state. It applies input to+    a function at each step. -}+pure :: (a -> b) -> Automaton a b+pure f = Step (\x -> (pure f, f x))++{-| Creates an automaton that has an initial and accumulated state. It applies+    input and the last state to a function at each step. -}+stateful :: b -> (a -> b -> b) -> Automaton a b+stateful state f = Step (\x -> let state' = f x state in (stateful state' f, state'))++{-| Steps an automaton forward, returning the next automaton to step+    and output of the step in a tuple. -}+step :: a -> Automaton a b -> (Automaton a b, b)+step auto (Step f) = f auto++{-| Combines a list of automatons that take some input+    and turns it into an automaton that takes+    the same input and outputs a list of all outputs+    from each separate automaton. -}+combine :: [Automaton a b] -> Automaton a [b]+combine autos =+  Step (\a -> let (autos', bs) = unzip $ map (step a) autos+              in  (combine autos', bs))++{-| A useful automaton that outputs the amount of times it has been stepped,+    discarding its input value. -}+counter :: Automaton a Int+counter = stateful 0 (\_ c -> c + 1)++{-| Runs an automaton with an initial output value and input signal generator+    and creates an output signal generator that contains a signal that can be+    sampled for the output value. -}+run :: Automaton a b -> b -> SignalGen (Signal a) -> SignalGen (Signal b)+run auto ini feeder = do+  food <- feeder >>= transfer (auto, ini) (\a (Step f, _) -> f a)++  return $ fmap snd food
+ src/FRP/Helm/Color.hs view
@@ -0,0 +1,176 @@+{-| Contains all data structures and functions for composing colors. -}+module FRP.Helm.Color (+  -- * Types+  Color(..),+  Gradient(..),+  -- * Composing+  rgba,+  rgb,+  hsva,+  hsv,+  complement,+  linear,+  radial,+  -- * Constants+  red,+  lime,+  blue,+  yellow,+  cyan,+  magenta,+  black,+  white,+  gray,+  grey,+  maroon,+  navy,+  green,+  teal,+  purple,+  violet,+  forestGreen+) where++{-| A data structure describing a color. It is represented interally as an RGBA+    color, but the utility functions 'hsva', 'hsv', etc. can be used to convert+    from other popular formats to this structure. -}+data Color = Color Double Double Double Double deriving (Show, Eq, Ord, Read)++{-| 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++{-| A bright red color. -}+red :: Color+red = rgb 1 0 0++{-| A bright green color. -}+lime :: Color+lime = rgb 0 1 0++{-| A bright blue color. -}+blue :: Color+blue = rgb 0 0 1++{-| A yellow color, made from combining red and green. -}+yellow :: Color+yellow = rgb 1 1 0++{-| A cyan color, combined from bright green and blue. -}+cyan :: Color+cyan = rgb 0 1 1++{-| A magenta color, combined from bright red and blue. -}+magenta :: Color+magenta = rgb 1 0 1++{-| A black color. -}+black :: Color+black = rgb 0 0 0++{-| A white color. -}+white :: Color+white = rgb 1 1 1++{-| A gray color, exactly halfway between black and white. -}+gray :: Color+gray = rgb 0.5 0.5 0.5++{-| Common alternative spelling of 'gray'. -}+grey :: Color+grey = gray++{-| A medium red color. -}+maroon :: Color+maroon = rgb 0.5 0 0++{-| A medium blue color. -}+navy :: Color+navy = rgb 0 0 0.5++{-| A medium green color. -}+green :: Color+green = rgb 0 0.5 0++{-| A teal color, combined from medium green and blue. -}+teal :: Color+teal = rgb 0 0.5 0.5++{-| A purple color, combined from medium red and blue. -}+purple :: Color+purple = rgb 0.5 0 0.5++{-| A violet color. -}+violet :: Color+violet = rgb 0.923 0.508 0.923++{-| A dark green color. -}+forestGreen :: Color+forestGreen = rgb 0.133 0.543 0.133++{-| Calculate a complementary color for a provided color. Useful for outlining+    a filled shape in a color clearly distinguishable from the fill color. -}+complement :: Color -> Color+complement (Color r g b a) = hsva (fromIntegral ((round (h + 180) :: Int) `mod` 360)) (s / mx) mx a+  where+    mx = r `max` g `max` b+    mn = r `min` g `min` b+    s = mx - mn+    h | mx == r = (g - b) / s * 60+      | mx == g = (b - r) / s * 60 + 120+      | mx == b = (r - g) / s * 60 + 240+      | otherwise = undefined++{-| Create an RGBA color from HSVA values. -}+hsva :: Double -> Double -> Double -> Double -> Color+hsva h s v a+  | h'' == 0 = rgba v t p a+  | h'' == 1 = rgba q v p a+  | h'' == 2 = rgba p v t a+  | h'' == 3 = rgba p q v a+  | h'' == 4 = rgba t p v a+  | h'' == 5 = rgba v p q a+  | otherwise = undefined++  where+    h' = h / 60+    h'' = floor h' `mod` 6 :: Int+    f = h' - fromIntegral h''+    p = v * (1 - s)+    q = v * (1 - f * s)+    t = v * (1 - (1 - f) * s)    ++{-| Create an RGB color from HSV values. -}+hsv :: Double -> Double -> Double -> Color+hsv h s v = hsva h s v 1++{-| A data structure describing a gradient. There are two types of gradients:+    radial and linear. Radial gradients are based on a set of colors transitioned+    over certain radii in an arc pattern. Linear gradients are a set of colors+    transitioned in a straight line. -}+data Gradient = Linear (Double, Double) (Double, Double) [(Double, Color)] |+                Radial (Double, Double) Double (Double, Double) Double [(Double, Color)] deriving (Show, Eq, Ord, Read)++{-| Creates a linear gradient. Takes a starting position, ending position and a list+    of color stops (which are colors combined with a floating value between /0.0/ and /1.0/+    that describes at what step along the line between the starting position+    and ending position the paired color should be transitioned to).++	> linear (0, 0) (100, 100) [(0, black), (1, white)]++	The above example creates a gradient that starts at /(0, 0)/+	and ends at /(100, 100)/. In other words, it's a diagonal gradient, transitioning from the top-left+	to the bottom-right. The provided color stops result in the gradient transitioning from+	black to white.+ -}+linear :: (Double, Double) -> (Double, Double) -> [(Double, Color)] -> Gradient+linear = Linear++{-| Creates a radial gradient. Takes a starting position and radius, ending position and radius+    and a list of color stops. See the document for 'linear' for more information on color stops. -}+radial :: (Double, Double) -> Double -> (Double, Double) -> Double -> [(Double, Color)] -> Gradient+radial = Radial
+ src/FRP/Helm/Graphics.hs view
@@ -0,0 +1,282 @@+{-| Contains all the data structures and functions for composing+    and rendering graphics. -}+module FRP.Helm.Graphics (+  -- * Types+  Element(..),+  Text(..),+  Form(..),+  FormStyle(..),+  FillStyle(..),+  LineCap(..),+  LineJoin(..),+  LineStyle(..),+  Path,+  Shape(..),+  -- * Elements+  image,+  fittedImage,+  croppedImage,+  collage,+  centeredCollage,+  -- * Styles & Forms+  defaultLine,+  solid,+  dashed,+  dotted,+  filled,+  textured,+  gradient,+  outlined,+  traced,+  sprite,+  toForm,+  -- * Grouping+  group,+  groupTransform,+  -- * Transforming+  rotate,+  scale,+  move,+  moveX,+  moveY,+  -- * Paths+  path,+  segment,+  -- * Shapes+  polygon,+  rect,+  square,+  oval,+  circle,+  ngon+) where++import FRP.Helm.Color (Color, black, Gradient)+import Graphics.Rendering.Cairo.Matrix (Matrix)+import qualified Graphics.Rendering.Cairo as Cairo++{-| A data structure describing something that can be rendered+    to the screen. Elements are the most important structure+    in Helm. Games essentially feed the engine a stream+    of elements which are then rendered directly to the screen.+    The usual way to render art in a Helm game is to call+    off to the 'collage' function, which essentially+    renders a collection of forms together. -}+data Element = CollageElement Int Int Bool [Form] |+               ImageElement (Int, Int) Int Int FilePath Bool |+               TextElement Text deriving (Show, Eq)++{-| A data structure describing a piece of formatted text. -}+data Text = Text {+  textUTF8 :: String,+  textColor :: Color,+  textTypeface :: String,+  textHeight :: Double,+  textWeight :: Cairo.FontWeight,+  textSlant :: Cairo.FontSlant+} deriving (Show, Eq)++{-| Create an element from an image with a given width, height and image file path.+    If the image dimensions are not the same as given, then it will stretch/shrink to fit.+    Only PNG files are supported currently. -}+image :: Int -> Int -> FilePath -> Element+image w h src = ImageElement (0, 0) w h src True++{-| Create an element from an image with a given width, height and image file path.+    If the image dimensions are not the same as given, then it will only use the relevant pixels+    (i.e. cut out the given dimensions instead of scaling). If the given dimensions are bigger than+    the actual image, than irrelevant pixels are ignored. -}+fittedImage :: Int -> Int -> FilePath -> Element+fittedImage w h src = ImageElement (0, 0) w h src False++{-| Create an element from an image by cropping it with a certain position, width, height+    and image file path. This can be used to divide a single image up into smaller ones. -}+croppedImage :: (Int, Int) -> Int -> Int -> FilePath -> Element+croppedImage pos w h src = ImageElement pos w h src False++{-| A data structure describing a form. A form is essentially a notion of a transformed+    graphic, whether it be an element or shape. See 'FormStyle' for an insight+    into what sort of graphics can be wrapped in a form. -}+data Form = Form {+  formTheta :: Double,+  formScale :: Double,+  formX :: Double,+  formY :: Double,+  formStyle :: FormStyle+} deriving (Show, Eq)++{-| A data structure describing how a shape or path looks when filled. -}+data FillStyle = Solid Color | Texture String | Gradient Gradient deriving (Show, Eq, Ord, Read)++{-| A data structure describing the shape of the ends of a line. -}+data LineCap = Flat | Round | Padded deriving (Show, Eq, Enum, Ord, Read)++{-| A data structure describing the shape of the join of a line, i.e.+    where separate line segments join. The 'Sharp' variant takes+    an argument to limit the length of the join. -}+data LineJoin = Smooth | Sharp Double | Clipped deriving (Show, Eq, Ord, Read)++{-| A data structure describing how a shape or path looks when stroked. -}+data LineStyle = LineStyle {+  lineColor :: Color,+  lineWidth :: Double,+  lineCap :: LineCap,+  lineJoin :: LineJoin,+  lineDashing :: [Double],+  lineDashOffset :: Double+} deriving (Show, Eq)++{-| Creates the default line style. By default, the line is black with a width of 1,+    flat caps and regular sharp joints. -}+defaultLine :: LineStyle+defaultLine = LineStyle {+  lineColor = black,+  lineWidth = 1,+  lineCap = Flat,+  lineJoin = Sharp 10,+  lineDashing = [],+  lineDashOffset = 0+}++{-| Create a solid line style with a color. -}+solid :: Color -> LineStyle+solid color = defaultLine { lineColor = color }++{-| Create a dashed line style with a color. -}+dashed :: Color -> LineStyle+dashed color = defaultLine { lineColor = color, lineDashing = [8, 4] }++{-| Create a dotted line style with a color. -}+dotted :: Color -> LineStyle+dotted color = defaultLine { lineColor = color, lineDashing = [3, 3] }++{-| A data structure describing a few ways that graphics that can be wrapped in a form+    and hence transformed. -}+data FormStyle = PathForm LineStyle Path |+                 ShapeForm (Either LineStyle FillStyle) Shape |+                 ElementForm Element |+                 GroupForm (Maybe Matrix) [Form] deriving (Show, Eq)++{-| Utility function for creating a form. -}+form :: FormStyle -> Form+form style = Form { formTheta = 0, formScale = 1, formX = 0, formY = 0, formStyle = style }++{-| Utility function for creating a filled form from a fill style and shape. -}+fill :: FillStyle -> Shape -> Form+fill style shape = form (ShapeForm (Right style) shape)++{-| Creates a form from a shape by filling it with a specific color. -}+filled :: Color -> Shape -> Form+filled color = fill (Solid color)++{-| Creates a form from a shape with a tiled texture and image file path. -}+textured :: String -> Shape -> Form+textured src = fill (Texture src)++{-| Creates a form from a shape filled with a gradient. -}+gradient :: Gradient -> Shape -> Form+gradient grad = fill (Gradient grad)++{-| Creates a form from a shape by outlining it with a specific line style. -}+outlined :: LineStyle -> Shape -> Form+outlined style shape = form (ShapeForm (Left style) shape)++{-| Creates a form from a path by tracing it with a specific line style. -}+traced :: LineStyle -> Path -> Form+traced style p = form (PathForm style p)++{-| Creates a form from a image file path with additional position, width and height arguments.+    Allows you to splice smaller parts from a single image. -}+sprite :: Int -> Int -> (Int, Int) -> FilePath -> Form+sprite w h pos src = form (ElementForm (ImageElement pos w h src False))++{-| Creates a form from an element. -}+toForm :: Element -> Form+toForm element = form (ElementForm element)++{-| Groups a collection of forms into a single one. -}+group :: [Form] -> Form+group forms = form (GroupForm Nothing forms)++{-| Groups a collection of forms into a single one, also applying a matrix transformation. -}+groupTransform :: Matrix -> [Form] -> Form+groupTransform matrix forms = form (GroupForm (Just matrix) forms)++{-| Rotates a form by an amount (in radians). -}+rotate :: Double -> Form -> Form+rotate t f = f { formTheta = t + formTheta f }++{-| Scales a form by an amount, e.g. scaling by /2.0/ will double the size. -}+scale :: Double -> Form -> Form+scale n f = f { formScale = n * formScale f }++{-| Moves a form relative to its current position. -}+move :: (Double, Double) -> Form -> Form+move (rx, ry) f = f { formX = rx + formX f, formY = ry + formY f }++{-| Moves a form's x-coordinate relative to its current position. -}+moveX :: Double -> Form -> Form+moveX x = move (x, 0)++{-| Moves a form's y-coordinate relative to its current position. -}+moveY :: Double -> Form -> Form+moveY y = move (0, y)++{-| Create an element from a collection of forms, with width and height arguments.+    All forms are centered and clipped within the supplied dimensions.+    It is generally used to directly render a collection of forms.++    > collage 800 600 [move (100, 100) $ filled red $ square 100,+    >                  move (100, 100) $ outlined (solid white) $ circle 50]+ -}+collage :: Int -> Int -> [Form] -> Element+collage w h = CollageElement w h False++{-| Like 'collage', but it centers the forms within the supplied dimensions. -}+centeredCollage :: Int -> Int -> [Form] -> Element+centeredCollage w h = CollageElement w h True++{-| A data type made up a collection of points that form a path when joined. -}+type Path = [(Double, Double)]++{-| Creates a path for a collection of points. -}+path :: [(Double, Double)] -> Path+path points = points++{-| Creates a path from a line segment, i.e. a start and end point. -}+segment :: (Double, Double) -> (Double, Double) -> Path+segment p1 p2 = [p1, p2]++{-| A data structure describing a some sort of graphically representable object,+    such as a polygon formed from a list of points or a rectangle. -}+data Shape = PolygonShape Path |+             RectangleShape (Double, Double) |+             ArcShape (Double, Double) Double Double Double (Double, Double) deriving (Show, Eq, Ord, Read)++{-| Creates a shape from a path (a list of points). -}+polygon :: Path -> Shape+polygon = PolygonShape++{-| Creates a rectangular shape with a width and height. -}+rect :: Double -> Double -> Shape+rect w h = RectangleShape (w, h)++{-| Creates a square shape with a side length. -}+square :: Double -> Shape+square n = rect n n++{-| Creates an oval shape with a width and height. -}+oval :: Double -> Double -> Shape+oval w h = ArcShape (0, 0) 0 (2 * pi) 1 (w / 2, h / 2)++{-| Creates a circle shape with a radius. -}+circle :: Double -> Shape+circle r = ArcShape (0, 0) 0 (2 * pi) r (1, 1)++{-| Creates a generic n-sided polygon (e.g. octagon, pentagon, etc) with+    an amount of sides and radius. -}+ngon :: Int -> Double -> Shape+ngon n r = PolygonShape (map (\i -> (r * cos (t * i), r * sin (t * i))) [0 .. fromIntegral (n - 1)])+  where +    m = fromIntegral n+    t = 2 * pi / m
+ src/FRP/Helm/Joystick.hs view
@@ -0,0 +1,105 @@+{-| Contains signals that sample input from joysticks. -}+module FRP.Helm.Joystick (+  -- * Types+  Joystick,+  -- * Probing+  available,+  name,+  open,+  index,+  availableAxes,+  availableBalls,+  availableHats,+  availableButtons,+  -- * Joystick State+  axis,+  hat,+  button,+  ball+) where++import Control.Applicative+import Data.Int (Int16)+import FRP.Elerea.Simple+import qualified Graphics.UI.SDL as SDL++{-| A type describing a joystick. -}+type Joystick = SDL.Joystick++{-| The amount of joysticks available. -}+available :: SignalGen (Signal Int)+available = effectful SDL.countAvailable++{-| The name of a joystick. Can throw an exception when sampled if the joystick index is invalid. -}+name :: Int -> SignalGen (Signal String)+name i = effectful $ SDL.name i++{-| The joystick at a certain slot. Can throw an exception when sampled if the joystick index is invalid. -}+open :: Int -> SignalGen (Signal Joystick)+open i = effectful $ SDL.open i++{-| The index of a joystick. -}+index :: Joystick -> SignalGen (Signal Int)+index j = return $ return $ SDL.index j++{-| The amount of axes available for a joystick. -}+availableAxes :: Joystick -> SignalGen (Signal Int)+availableAxes j = return $ return $ SDL.axesAvailable j++{-| The amount of balls available for a joystick. -}+availableBalls :: Joystick -> SignalGen (Signal Int)+availableBalls j = return $ return $ SDL.ballsAvailable j++{-| The amount of hats available for a joystick. -}+availableHats :: Joystick -> SignalGen (Signal Int)+availableHats j = return $ return $ SDL.hatsAvailable j++{-| The amount of buttons available for a joystick. -}+availableButtons :: Joystick -> SignalGen (Signal Int)+availableButtons j = return $ return $ SDL.buttonsAvailable j++{-| The current state of the axis of the joystick. -}+axis :: Joystick -> Int -> SignalGen (Signal Int)+axis j i = effectful $ SDL.update >> fromIntegral <$> SDL.getAxis j (fromIntegral i)++{-| The current state of the hat of the joystick, returned+    as a directional tuple. For example, up is /(0, -1)/,+    left /(-1, 0)/, bottom-right is /(1, 1)/, etc. -}+hat :: Joystick -> Int -> SignalGen (Signal (Int, Int))+hat j i = effectful $ SDL.update >> hat' <$> SDL.getHat j (fromIntegral i)++{-| A utility function for mapping a list of hat states to an averaged directional tuple. -}+hat' :: [SDL.Hat] -> (Int, Int)+hat' hats = if l > 0 then (round $ fromIntegral hx / l, round $ fromIntegral hy / l) else (0, 0)+  where+    l = realToFrac $ length hats :: Double+    (hx, hy) = foldl hat'' (0, 0) hats++{-| A utility function for accumulating the total directional tuple. -}+hat'' :: (Int, Int) -> SDL.Hat -> (Int, Int)+hat'' (x, y) h =+  case h of+    SDL.HatCentered -> (x, y)+    SDL.HatUp -> (x, y - 1)+    SDL.HatRight -> (x + 1, y)+    SDL.HatDown -> (x, y + 1)+    SDL.HatLeft -> (x - 1, y)+    SDL.HatRightUp -> (x + 1, y - 1)+    SDL.HatRightDown -> (x + 1, y + 1)+    SDL.HatLeftUp -> (x - 1, x - 1)+    SDL.HatLeftDown -> (x - 1, y + 1)++{-| The current state of the button of the joystick. -}+button :: Joystick -> Int -> SignalGen (Signal Bool)+button j i = effectful $ SDL.update >> SDL.getButton j (fromIntegral i)++{-| The current state of the ball of the joystick. -}+ball :: Joystick -> Int -> SignalGen (Signal (Int, Int))+ball j i = effectful $ SDL.update >> ball' <$> SDL.getBall j (fromIntegral i)++{-| A utility function for mapping the optional value to a null tuple or the actual tuple. -}+ball' :: Maybe (Int16, Int16) -> (Int, Int)+ball' mayhaps =+  case mayhaps of+    Just (x, y) -> (fromIntegral x, fromIntegral y)+    Nothing -> (0, 0)
+ src/FRP/Helm/Keyboard.hs view
@@ -0,0 +1,380 @@+{-| Contains signals that sample input from the keyboard. -}+module FRP.Helm.Keyboard (+  -- * Types+  Key(..),+  -- * Key State+  shift, ctrl, enter,+  space, isDown, keysDown,+  -- * Directions+  arrows, wasd+) where++import Control.Applicative+import Data.List+import Foreign hiding (shift)+import Foreign.C.Types+import FRP.Elerea.Simple+import qualified Graphics.UI.SDL as SDL++{-| The SDL bindings for Haskell don't wrap this, so we have to use the FFI ourselves. -}+foreign import ccall unsafe "SDL_GetKeyState" sdlGetKeyState :: Ptr CInt -> IO (Ptr Word8)++{-| A utility function for getting a list of SDL keys currently pressed.+    Based on <http://coderepos.org/share/browser/lang/haskell/nario/Main.hs?rev=22646#L49>. -}+getKeyState :: IO [Int]+getKeyState = alloca $ \numkeysPtr -> do+  keysPtr <- sdlGetKeyState numkeysPtr+  numkeys <- peek numkeysPtr++  (map fromIntegral . elemIndices 1) <$> peekArray (fromIntegral numkeys) keysPtr++{-| A data structure describing a physical key on a keyboard. -}+data Key = BackspaceKey | TabKey | ClearKey | EnterKey | PauseKey | EscapeKey |+           SpaceKey | ExclaimKey | QuotedBlKey | HashKey | DollarKey | AmpersandKey |+           QuoteKey | LeftParenKey | RightParenKey | AsteriskKey | PlusKey | CommaKey |+           MinusKey | PeriodKey | SlashKey | Num0Key | Num1Key | Num2Key |+           Num3Key | Num4Key | Num5Key | Num6Key | Num7Key | Num8Key |+           Num9Key | ColonKey | SemicolonKey | LessKey | EqualsKey | GreaterKey |+           QuestionKey | AtKey | LeftBracketKey | BackslashKey | RightBracketKey | CaretKey |+           UnderscoreKey | BackquoteKey | AKey | BKey | CKey | DKey |+           EKey | FKey | GKey | HKey | IKey | JKey | KKey |+           LKey | MKey | NKey | OKey | PKey | QKey |+           RKey | SKey | TKey | UKey | VKey | WKey |+           XKey | YKey | ZKey | DeleteKey | KeypadNum0Key | KeypadNum1Key |+           KeypadNum2Key | KeypadNum3Key | KeypadNum4Key | KeypadNum5Key | KeypadNum6Key | KeypadNum7Key |+           KeypadNum8Key | KeypadNum9Key | KeypadPeriodKey | KeypadDivideKey | KeypadMultiplyKey | KeypadMinusKey |+           KeypadPlusKey | KeypadEnterKey | KeypadEqualsKey | UpKey | DownKey | RightKey |+           LeftKey | InsertKey | HomeKey | EndKey | PageUpKey | PageDownKey |+           F1Key | F2Key | F3Key | F4Key |  F5Key | F6Key |+           F7Key | F8Key | F9Key | F10Key | F11Key | F12Key |+           F13Key | F14Key | F15Key | NumLockKey | CapsLockKey | ScrollLockKey |+           RShiftKey | LShiftKey | RCtrlKey | LCtrlKey | RAltKey | LAltKey |+           RMetaKey | LMetaKey | RSuperKey | LSuperKey | ModeKey | ComposeKey | HelpKey |+           PrintKey | SysReqKey | BreakKey | MenuKey | PowerKey | EuroKey |+           UndoKey deriving (Show, Eq, Ord, Read)++{- All integer values of this enum are equivalent to the SDL key enum. -}+instance Enum Key where+  fromEnum BackspaceKey = 8+  fromEnum TabKey = 9+  fromEnum ClearKey = 12+  fromEnum EnterKey = 13+  fromEnum PauseKey = 19+  fromEnum EscapeKey = 27+  fromEnum SpaceKey = 32+  fromEnum ExclaimKey = 33+  fromEnum QuotedBlKey = 34+  fromEnum HashKey = 35+  fromEnum DollarKey = 36+  fromEnum AmpersandKey = 38+  fromEnum QuoteKey = 39+  fromEnum LeftParenKey = 40+  fromEnum RightParenKey = 41+  fromEnum AsteriskKey = 42+  fromEnum PlusKey = 43+  fromEnum CommaKey = 44+  fromEnum MinusKey = 45+  fromEnum PeriodKey = 46+  fromEnum SlashKey = 47+  fromEnum Num0Key = 48+  fromEnum Num1Key = 49+  fromEnum Num2Key = 50+  fromEnum Num3Key = 51+  fromEnum Num4Key = 52+  fromEnum Num5Key = 53+  fromEnum Num6Key = 54+  fromEnum Num7Key = 55+  fromEnum Num8Key = 56+  fromEnum Num9Key = 57+  fromEnum ColonKey = 58+  fromEnum SemicolonKey = 59+  fromEnum LessKey = 60+  fromEnum EqualsKey = 61+  fromEnum GreaterKey = 62+  fromEnum QuestionKey = 63+  fromEnum AtKey = 64+  fromEnum LeftBracketKey = 91+  fromEnum BackslashKey = 92+  fromEnum RightBracketKey = 93+  fromEnum CaretKey = 94+  fromEnum UnderscoreKey = 95+  fromEnum BackquoteKey = 96+  fromEnum AKey = 97+  fromEnum BKey = 98+  fromEnum CKey = 99+  fromEnum DKey = 100+  fromEnum EKey = 101+  fromEnum FKey = 102+  fromEnum GKey = 103+  fromEnum HKey = 104+  fromEnum IKey = 105+  fromEnum JKey = 106+  fromEnum KKey = 107+  fromEnum LKey = 108+  fromEnum MKey = 109+  fromEnum NKey = 110+  fromEnum OKey = 111+  fromEnum PKey = 112+  fromEnum QKey = 113+  fromEnum RKey = 114+  fromEnum SKey = 115+  fromEnum TKey = 116+  fromEnum UKey = 117+  fromEnum VKey = 118+  fromEnum WKey = 119+  fromEnum XKey = 120+  fromEnum YKey = 121+  fromEnum ZKey = 122+  fromEnum DeleteKey = 127+  fromEnum KeypadNum0Key = 256+  fromEnum KeypadNum1Key = 257+  fromEnum KeypadNum2Key = 258+  fromEnum KeypadNum3Key = 259+  fromEnum KeypadNum4Key = 260+  fromEnum KeypadNum5Key = 261+  fromEnum KeypadNum6Key = 262+  fromEnum KeypadNum7Key = 263+  fromEnum KeypadNum8Key = 264+  fromEnum KeypadNum9Key = 265+  fromEnum KeypadPeriodKey = 266+  fromEnum KeypadDivideKey = 267+  fromEnum KeypadMultiplyKey = 268+  fromEnum KeypadMinusKey = 269+  fromEnum KeypadPlusKey = 270+  fromEnum KeypadEnterKey = 271+  fromEnum KeypadEqualsKey = 272+  fromEnum UpKey = 273+  fromEnum DownKey = 274+  fromEnum RightKey = 275+  fromEnum LeftKey = 276+  fromEnum InsertKey = 277+  fromEnum HomeKey = 278+  fromEnum EndKey = 279+  fromEnum PageUpKey = 280+  fromEnum PageDownKey = 281+  fromEnum F1Key = 282+  fromEnum F2Key = 283+  fromEnum F3Key = 284+  fromEnum F4Key = 285+  fromEnum F5Key = 286+  fromEnum F6Key = 287+  fromEnum F7Key = 288+  fromEnum F8Key = 289+  fromEnum F9Key = 290+  fromEnum F10Key = 291+  fromEnum F11Key = 292+  fromEnum F12Key = 293+  fromEnum F13Key = 294+  fromEnum F14Key = 295+  fromEnum F15Key = 296+  fromEnum NumLockKey = 300+  fromEnum CapsLockKey = 301+  fromEnum ScrollLockKey = 302+  fromEnum RShiftKey = 303+  fromEnum LShiftKey = 304+  fromEnum RCtrlKey = 305+  fromEnum LCtrlKey = 306+  fromEnum RAltKey = 307+  fromEnum LAltKey = 308+  fromEnum RMetaKey = 309+  fromEnum LMetaKey = 310+  fromEnum LSuperKey = 311+  fromEnum RSuperKey = 312+  fromEnum ModeKey = 313+  fromEnum ComposeKey = 314+  fromEnum HelpKey = 315+  fromEnum PrintKey = 316+  fromEnum SysReqKey = 317+  fromEnum BreakKey = 318+  fromEnum MenuKey = 319+  fromEnum PowerKey = 320+  fromEnum EuroKey = 321+  fromEnum UndoKey = 322++  toEnum 8 = BackspaceKey+  toEnum 9 = TabKey+  toEnum 12 = ClearKey+  toEnum 13 = EnterKey+  toEnum 19 = PauseKey+  toEnum 27 = EscapeKey+  toEnum 32 = SpaceKey+  toEnum 33 = ExclaimKey+  toEnum 34 = QuotedBlKey+  toEnum 35 = HashKey+  toEnum 36 = DollarKey+  toEnum 38 = AmpersandKey+  toEnum 39 = QuoteKey+  toEnum 40 = LeftParenKey+  toEnum 41 = RightParenKey+  toEnum 42 = AsteriskKey+  toEnum 43 = PlusKey+  toEnum 44 = CommaKey+  toEnum 45 = MinusKey+  toEnum 46 = PeriodKey+  toEnum 47 = SlashKey+  toEnum 48 = Num0Key+  toEnum 49 = Num1Key+  toEnum 50 = Num2Key+  toEnum 51 = Num3Key+  toEnum 52 = Num4Key+  toEnum 53 = Num5Key+  toEnum 54 = Num6Key+  toEnum 55 = Num7Key+  toEnum 56 = Num8Key+  toEnum 57 = Num9Key+  toEnum 58 = ColonKey+  toEnum 59 = SemicolonKey+  toEnum 60 = LessKey+  toEnum 61 = EqualsKey+  toEnum 62 = GreaterKey+  toEnum 63 = QuestionKey+  toEnum 64 = AtKey+  toEnum 91 = LeftBracketKey+  toEnum 92 = BackslashKey+  toEnum 93 = RightBracketKey+  toEnum 94 = CaretKey+  toEnum 95 = UnderscoreKey+  toEnum 96 = BackquoteKey+  toEnum 97 = AKey+  toEnum 98 = BKey+  toEnum 99 = CKey+  toEnum 100 = DKey+  toEnum 101 = EKey+  toEnum 102 = FKey+  toEnum 103 = GKey+  toEnum 104 = HKey+  toEnum 105 = IKey+  toEnum 106 = JKey+  toEnum 107 = KKey+  toEnum 108 = LKey+  toEnum 109 = MKey+  toEnum 110 = NKey+  toEnum 111 = OKey+  toEnum 112 = PKey+  toEnum 113 = QKey+  toEnum 114 = RKey+  toEnum 115 = SKey+  toEnum 116 = TKey+  toEnum 117 = UKey+  toEnum 118 = VKey+  toEnum 119 = WKey+  toEnum 120 = XKey+  toEnum 121 = YKey+  toEnum 122 = ZKey+  toEnum 127 = DeleteKey+  toEnum 256 = KeypadNum0Key+  toEnum 257 = KeypadNum1Key+  toEnum 258 = KeypadNum2Key+  toEnum 259 = KeypadNum3Key+  toEnum 260 = KeypadNum4Key+  toEnum 261 = KeypadNum5Key+  toEnum 262 = KeypadNum6Key+  toEnum 263 = KeypadNum7Key+  toEnum 264 = KeypadNum8Key+  toEnum 265 = KeypadNum9Key+  toEnum 266 = KeypadPeriodKey+  toEnum 267 = KeypadDivideKey+  toEnum 268 = KeypadMultiplyKey+  toEnum 269 = KeypadMinusKey+  toEnum 270 = KeypadPlusKey+  toEnum 271 = KeypadEnterKey+  toEnum 272 = KeypadEqualsKey+  toEnum 273 = UpKey+  toEnum 274 = DownKey+  toEnum 275 = RightKey+  toEnum 276 = LeftKey+  toEnum 277 = InsertKey+  toEnum 278 = HomeKey+  toEnum 279 = EndKey+  toEnum 280 = PageUpKey+  toEnum 281 = PageDownKey+  toEnum 282 = F1Key+  toEnum 283 = F2Key+  toEnum 284 = F3Key+  toEnum 285 = F4Key+  toEnum 286 = F5Key+  toEnum 287 = F6Key+  toEnum 288 = F7Key+  toEnum 289 = F8Key+  toEnum 290 = F9Key+  toEnum 291 = F10Key+  toEnum 292 = F11Key+  toEnum 293 = F12Key+  toEnum 294 = F13Key+  toEnum 295 = F14Key+  toEnum 296 = F15Key+  toEnum 300 = NumLockKey+  toEnum 301 = CapsLockKey+  toEnum 302 = ScrollLockKey+  toEnum 303 = RShiftKey+  toEnum 304 = LShiftKey+  toEnum 305 = RCtrlKey+  toEnum 306 = LCtrlKey+  toEnum 307 = RAltKey+  toEnum 308 = LAltKey+  toEnum 309 = RMetaKey+  toEnum 310 = LMetaKey+  toEnum 311 = LSuperKey+  toEnum 312 = RSuperKey+  toEnum 313 = ModeKey+  toEnum 314 = ComposeKey+  toEnum 315 = HelpKey+  toEnum 316 = PrintKey+  toEnum 317 = SysReqKey+  toEnum 318 = BreakKey+  toEnum 319 = MenuKey+  toEnum 320 = PowerKey+  toEnum 321 = EuroKey+  toEnum 322 = UndoKey+  toEnum _ = error "FRP.Helm.Keyboard.Key.toEnum: bad argument"++{-| Whether either shift key is pressed. -}+shift :: SignalGen (Signal Bool)+shift = effectful $ elem SDL.KeyModShift <$> SDL.getModState++{-| Whether either control key is pressed. -}+ctrl :: SignalGen (Signal Bool)+ctrl = effectful $ elem SDL.KeyModCtrl <$> SDL.getModState++{-| Whether a key is pressed. -}+isDown :: Key -> SignalGen (Signal Bool)+isDown k = effectful $ elem (fromEnum k) <$> getKeyState++{-| Whether the enter (a.k.a. return) key is pressed. -}+enter :: SignalGen (Signal Bool)+enter = isDown EnterKey++{-| Whether the space key is pressed. -}+space :: SignalGen (Signal Bool)+space = isDown SpaceKey++{-| A list of keys that are currently being pressed. -}+keysDown :: SignalGen (Signal [Key])+keysDown = effectful $ map toEnum <$> getKeyState++{-| A directional tuple combined from the arrow keys. When none of the arrow keys+    are being pressed this signal samples to /(0, 0)/, otherwise it samples to a+    direction based on which keys are pressed. For example, pressing the left key+    results in /(-1, 0)/, the down key /(0, 1)/, up and right /(1, -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++{-| A utility function for setting up a vector signal from directional keys. -}+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 popular WASD movement controls 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
+ src/FRP/Helm/Mouse.hs view
@@ -0,0 +1,45 @@+{-| Contains signals that sample input from the mouse. -}+module FRP.Helm.Mouse (+  -- * Types+  Mouse(..),+  -- * Position+  isDown,+  -- * Mouse State+  position, x, y+) where++import Control.Applicative+import FRP.Elerea.Simple+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)++{- 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++  toEnum 1 = LeftMouse+  toEnum 2 = MiddleMouse+  toEnum 3 = RightMouse+  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++{-| 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++{-| 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
+ src/FRP/Helm/Signal.hs view
@@ -0,0 +1,112 @@+{-| Contains utility functions for working with signals and signal generators. -}+module FRP.Helm.Signal (+  -- * Composing+  constant,+  lift,+  lift2,+  lift3,+  (<~),+  (~~),+  -- * Accumulating+  foldp,+  count,+  countIf,+  -- * DYEL?+  lift4,+  lift5,+  lift6,+  lift7,+  lift8+) where++import Control.Applicative ((<*>))+import FRP.Elerea.Simple++{-| Creates a signal that never changes. -}+constant :: a -> SignalGen (Signal a)+constant value = return $ return value++{- TODO:+combine :: [SignalGen (Signal a)] -> SignalGen (Signal [a])+-}++{-| Applies a function to a signal producing a new signal. This is a wrapper around the builtin+    'fmap' function that automatically binds the input signal out of the signal generator.++    > render <~ Window.dimensions+ -}+lift :: (a -> b) -> SignalGen (Signal a) -> SignalGen (Signal b)+lift f = fmap (fmap f)++{-| Applies a function to two signals. -}+lift2 :: (a -> b -> c) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c)+lift2 f a b = f <~ a ~~ b++{-| Applies a function to three signals. -}+lift3 :: (a -> b -> c -> d) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c) -> SignalGen (Signal d)+lift3 f a b c = (f <~ a ~~ b) ~~ c++{-| Applies a function to four signals. -}+lift4 :: (a -> b -> c -> d -> e) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c) -> SignalGen (Signal d)+                                 -> SignalGen (Signal e)+lift4 f a b c d = ((f <~ a ~~ b) ~~ c) ~~ d++{-| Applies a function to five signals. -}+lift5 :: (a -> b -> c -> d -> e -> f) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c) -> SignalGen (Signal d)+                                      -> SignalGen (Signal e) -> SignalGen (Signal f)+lift5 f a b c d e = (((f <~ a ~~ b) ~~ c) ~~ d) ~~ e++{-| Applies a function to six signals. -}+lift6 :: (a -> b -> c -> d -> e -> f -> g) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c) -> SignalGen (Signal d)+                                           -> SignalGen (Signal e) -> SignalGen (Signal f) -> SignalGen (Signal g)+lift6 f a b c d e f1 = ((((f <~ a ~~ b) ~~ c) ~~ d) ~~ e) ~~ f1++{-| Applies a function to seven signals. -}+lift7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c) -> SignalGen (Signal d)+                                                -> SignalGen (Signal e) -> SignalGen (Signal f) -> SignalGen (Signal g) -> SignalGen (Signal h)+lift7 f a b c d e f1 g = (((((f <~ a ~~ b) ~~ c) ~~ d) ~~ e) ~~ f1) ~~ g++{-| Applies a function to eight signals. -}+lift8 :: (a -> b -> c -> d -> e -> f -> g -> h -> i) -> SignalGen (Signal a) -> SignalGen (Signal b) -> SignalGen (Signal c) -> SignalGen (Signal d)+                                                     -> SignalGen (Signal e) -> SignalGen (Signal f) -> SignalGen (Signal g) -> SignalGen (Signal h)+                                                     -> SignalGen (Signal i)+lift8 f a b c d e f1 g h = ((((((f <~ a ~~ b) ~~ c) ~~ d) ~~ e) ~~ f1) ~~ g) ~~ h++{-| An alias for 'lift'. -}+(<~) :: (a -> b) -> SignalGen (Signal a) -> SignalGen (Signal b)+(<~) = lift++infix 4 <~++{-| Applies a function within a signal to a signal. This is a wrapper around the builtin '<*>' operator+    that automatically binds the input signal out of the signal generator.++    > render <~ Window.dimensions ~~ Window.position+ -}+(~~) :: SignalGen (Signal (a -> b)) -> SignalGen (Signal a) -> SignalGen (Signal b)+(~~) f input = do+	f1 <- f+	input1 <- input++	return $ f1 <*> input1++infix 3 ~~++{-| Creates a past-dependent signal that depends on another signal. This is a+    wrapper around the 'transfer' function that automatically binds the input+    signal out of the signal generator. This function is useful for making a render+    function that depends on some accumulated state. -}+foldp :: (a -> b -> b) -> b -> SignalGen (Signal a) -> SignalGen (Signal b)+foldp f ini input = do+	input1 <- input++	transfer ini f input1++{-| Creates a signal that counts the amount of times it has been sampled. -}+count :: SignalGen (Signal Int)+count = stateful 0 (+ 1)++{-| Creates a signal that counts the amount of times an input signal has passed+    a predicate when sampled. -}+countIf :: (a -> Bool) -> SignalGen (Signal a) -> SignalGen (Signal Int)+countIf f = foldp (\v c -> c + fromEnum (f v)) 0
+ src/FRP/Helm/Text.hs view
@@ -0,0 +1,91 @@+{-| Contains all the data structures and functions for composing+    pieces of formatted text. -}+module FRP.Helm.Text (+  -- * Elements+  plainText,+  asText,+  text,+  -- * Composing+  defaultText,+  toText,+  -- * Formatting+  bold,+  italic,+  color,+  monospace,+  typeface,+  header,+  height+) where++import FRP.Helm.Color (Color, black)+import FRP.Helm.Graphics (Element(TextElement), Text(..))+import qualified Graphics.Rendering.Cairo as Cairo++{-| Creates the default text. By default the text is black sans-serif+    with a height of 14px. -}+defaultText :: Text+defaultText = Text {+  textUTF8 = "",+  textColor = black,+  textTypeface = "sans-serif",+  textHeight = 14,+  textWeight = Cairo.FontWeightNormal,+  textSlant = Cairo.FontSlantNormal+}++{-| Creates a text from a string. -}+toText :: String -> Text+toText utf8 = defaultText { textUTF8 = utf8 }++{-| Creates a text element from a string. -}+plainText :: String -> Element+plainText utf8 = text $ toText utf8++{-| Creates a text element from any showable type, defaulting to+    the monospace typeface. -}+asText :: Show a => a -> Element+asText val = text $ monospace $ toText $ show val++{-| Creates an element from a text. -}+text :: Text -> Element+text = TextElement++{- TODO:+centered+justified+righted+underline+strikeThrough+overline+-}++{-| Sets the weight of a piece of text to bold. -}+bold :: Text -> Text+bold txt = txt { textWeight = Cairo.FontWeightBold }++{-| Sets the slant of a piece of text to italic. -}+italic :: Text -> Text+italic txt = txt { textSlant = Cairo.FontSlantItalic }++{-| Sets the color of a piece of text. -}+color :: Color -> Text -> Text+color col txt = txt { textColor = col }++{-| Sets the typeface of the text to monospace. -}+monospace :: Text -> Text+monospace txt = txt { textTypeface = "monospace" }++{-| Sets the typeface of the text. Only fonts+    supported by Cairo's toy font API are currently+    supported. -}+typeface :: String -> Text -> Text+typeface face txt = txt { textTypeface = face }++{-| Sets the size of a text noticeably large. -}+header :: Text -> Text+header = height 32++{-| Sets the size of a piece of text. -}+height :: Double -> Text -> Text+height size txt = txt { textHeight = size }
+ src/FRP/Helm/Time.hs view
@@ -0,0 +1,83 @@+{-| Contains functions for composing units of time and signals that sample from the game clock. -}+module FRP.Helm.Time (+  -- * Types+  Time,+  -- * Composing+  millisecond,+  second,+  minute,+  hour,+  inMilliseconds,+  inSeconds,+  inMinutes,+  inHours,+  fps,+  -- * Clock State+  running,+  delta,+  delay+) where++import Control.Applicative+import FRP.Elerea.Simple hiding (delay)+import qualified Graphics.UI.SDL as SDL++{-| A type describing an amount of time in an arbitary unit. Use the time composing/converting functions to manipulate+    time values. -}+type Time = Double++{-| A time value representing one millisecond. -}+millisecond :: Time+millisecond = 1++{-| A time value representing one second. -}+second :: Time+second = 1000++{-| A time value representing one minute. -}+minute :: Time+minute = 60000++{-| A time value representing one hour. -}+hour :: Time+hour = 3600000++{-| Converts a time value to a fractional value, in milliseconds. -}+inMilliseconds :: Time -> Double+inMilliseconds n = n++{-| Converts a time value to a fractional value, in seconds. -}+inSeconds :: Time -> Double+inSeconds n = n / second++{-| Converts a time value to a fractional value, in minutes. -}+inMinutes :: Time -> Double+inMinutes n = n / minute++{-| Converts a time value to a fractional value, in hours. -}+inHours :: Time -> Double+inHours n = n / hour++{-| Converts a frames-per-second value into a time value. -}+fps :: Int -> Time+fps n = second / realToFrac n++{-| A signal that returns the time that the game has been running for when sampled. -}+running :: SignalGen (Signal Time)+running = effectful $ realToFrac <$> SDL.getTicks++{-| A signal that returns the time since it was last sampled when sampled. -}+delta :: SignalGen (Signal Time)+delta = running >>= delta'++{-| 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++{-| 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+    platform-specific results. -}+delay :: Time -> SignalGen (Signal Time)+delay t = effectful $ SDL.delay fixed >> return (realToFrac fixed)+  where+    fixed = max 0 $ round t
+ src/FRP/Helm/Window.hs view
@@ -0,0 +1,22 @@+{-| Contains signals that sample input from the game window. -}+module FRP.Helm.Window (+	-- * Dimensions+	dimensions, width, height+) where++import Control.Applicative+import Control.Arrow+import FRP.Elerea.Simple+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++{-| 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
+ tests/Main.hs view
@@ -0,0 +1,13 @@+module Main where++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]