packages feed

helm 0.7.1 → 1.0.0

raw patch · 40 files changed

+2914/−2501 lines, 40 filesdep +helmdep +hspecdep +lineardep −HUnitdep −cpudep −filepathdep ~cairodep ~elereadep ~mtlnew-component:exe:helm-example-flappy

Dependencies added: helm, hspec, linear, stm

Dependencies removed: HUnit, cpu, filepath, test-framework, test-framework-hunit, test-framework-quickcheck2, time

Dependency ranges changed: cairo, elerea, mtl, pango, random, sdl2, text, transformers

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright (C) 2013-2014, Zack Corr+Copyright (C) 2013-2016, Zack Corr  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to
README.md view
@@ -2,119 +2,100 @@   <a href="http://helm-engine.org" title="Homepage"><img src="http://helm-engine.org/img/logo-alt.png" /></a>   <br>   <br>-  <a href="https://travis-ci.org/switchface/helm" title="Travis CI"><img src="https://travis-ci.org/switchface/helm.svg" /></a>+  <a href="https://circleci.com/gh/z0w0/helm" title="CircleCI"><img src="https://circleci.com/gh/z0w0/helm.svg?style=svg" /></a> </p>  ## Introduction -Helm is a functionally reactive game engine written in Haskell and built around-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.+Helm is a purely functional game engine written in Haskell and built with+the [Elerea functionally-reactive programming framework](https://github.com/cobbpg/elerea)+and [SDL2](https://www.libsdl.org/). Helm was originally inspired by the+[Elm programming language](http://elm-lang.org).  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.-You can [ask on the mailing list](https://groups.google.com/d/forum/helm-dev) if you're having any trouble-with using the engine for games or working on the engine itself, or if you just want to chit-chat about-Helm.--## 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-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`, `FRP.Helm.Utilities`-    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.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.Keyboard` contains signals for working with keyboard state.-  * `FRP.Helm.Mouse` contains signals for working with mouse state.-  * `FRP.Helm.Random` contains signals for generating random values-  * `FRP.Helm.Signal`  constains useful functions for working with signals such-     as lifting/folding-  * `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 time-dependant signals-  * `FRP.Helm.Utilities` contains an assortment of useful functions,-  * `FRP.Helm.Window` contains signals for working with the game window state.--## Example--The simplest example of a Helm game that doesn't require any input from the user is the following:+is contained in a subscription, which is essentially +as a collection of input events changing over time mapped to game interactions. -```haskell-import FRP.Helm-import qualified FRP.Helm.Window as Window+Think of it this way - when you hold down the w and a keys, two keyboard events are being captured at every moment.+You might want your game to move your character forward by pressing `w`.+When you add a subscription to your game, you choose how to map these two input events+into a game action type (which you provide, the engine doesn't have any concept+of how the action works). So if you mapped the `w` key to some game action variant (game+actions are usually represented as a collection of data type variants), and the `w` key was held down,+then at every game tick the game would produce a `w` key press event and turn this into+the relevant game action. -render :: (Int, Int) -> Element-render (w, h) = collage w h [move (100, 100) $ filled red $ square 64]+On top of subscriptions, Helm has another core concept called commands.+Commands are essentially IO-like monads that have context about the engine state.+Like subscriptions, commands are mapped directly to game actions. This+means that when interacting with IO through Helm, you directly+specify how the result maps to a game action and allows you to make logical+conclusions about how certain monadic results should interact with your game. -main :: IO ()-main = run defaultConfig $ render <~ Window.dimensions-```+Helm provides a structure familiar to MVC-based framework developers.+There is a model (which represents the state of your game), +a view of the current model (i.e. what's actually shown on the screen) and a function similiar+to a controller that folds the model forward based off of input actions (which are in turn+mapped to from subscription events). -It renders a red square at the position `(100, 100)` with a side length of `64`.+This presents a powerful paradigm shift for game development. Instead of writing event listeners,+Helm treats input events as first-class citizens of the type system, and the actual interaction+between the game state and input events becomes immediately clearer. -The next example is the barebones of a game that depends on input. It shows how to create-an accumulated state that depends on the values sampled from signals (e.g. mouse input).-You should see a white square on the screen and pressing the arrow keys allows you to move it.+## Features -```haskell-import FRP.Helm-import qualified FRP.Helm.Keyboard as Keyboard-import qualified FRP.Helm.Window as Window+* Interactions between input and game logic is made clear by events and game actions being treated+  first-class by the engine+* Color composition via `Helm.Color`+* 2D vector graphics rendering via `Helm.Graphics2D`+  * Advanced text rendering via `Helm.Graphics2D.Text`+  * Matrix-based 2D transformations (for advanced techniques like skewing) via `Helm.Graphics2D.Transform`+* Keyboard event interactions via `Helm.Keyboard`+* Mouse event interactions via `Helm.Mouse`+* Command-related utilities such as batching via `Helm.Cmd`+* Subscription-related utilities, such as batching and lifting IO-likes via `Helm.Sub`+* Time-based event interactions via `Helm.Time`+* Window event interactions and other utilities via `Helm.Window`+* The base functionality of Helm is separate from the backend engine implementation, so+  custom media frameworks (which generally handle rendering, input, etc.) can be integrated+  with Helm quite easily. At the moment, the only available implementation is SDL2+  (which is currently bundled with the game engine) however the plan is to have more options in the future. -data State = State { mx :: Double, my :: Double }+## Installing and Building -step :: (Int, Int) -> State -> State-step (dx, dy) state = state { mx = (10 * (realToFrac dx)) + mx state,-                              my = (10 * (realToFrac dy)) + my state }+Before you can use Helm, you'll to follow the+[Gtk2Hs installation guide](https://wiki.haskell.org/Gtk2Hs/Installation)+(which is required for the Haskell Cairo bindings). Additionally, Helm+requires a GHC version of 7.6 or higher. -render :: (Int, Int) -> State -> Element-render (w, h) (State { mx = mx, my = my }) =-  centeredCollage w h [move (mx, my) $ filled white $ square 100]+Using [Stack](https://haskellstack.org) when working with Helm is recommended.+To install Helm with Stack, use: -main :: IO ()-main = run defaultConfig $ render <~ Window.dimensions ~~ stepper-  where-    state = State { mx = 0, my = 0 }-    stepper = foldp step state Keyboard.arrows ```+stack install helm+``` -## Installing and Building+It's best to add Helm as a dependency in your game's Cabal file rather+than installing it globally, however if you're new to the engine, installing+it globally will let you run the example Helm games. See the next section. -Helm requires GHC 7.6 (Elerea doesn't work with older versions due to a compiler bug).-To install the latest (stable) version from the Hackage repository, use:+## Getting Started -```-cabal install helm-```+Check out the `examples` directory for some examples; the `flappy` example is a particularly good start.+Unfortunately, there's little to no example games yet, so if you end up making something cool and lightweight+that you'd think would be a good example, feel free to open a pull request! -Alternatively to get the latest development version, you can clone this repository and then run:+If you have installed Helm globally using Stack, you can run the `flappy` example using:  ```-cabal install+stack exec helm-example-flappy ``` -You may need to jump a few hoops to install the Cairo bindings (which are a dependency),-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.+## Documentation +API documentation for the latest stable version of Helm is available on [Hackage](http://hackage.haskell.org/package/helm).+Alternatively, if you've cloned this repo, you can build the documentation manually using Haddock.+ ## License  Helm is licensed under the MIT license. See the LICENSE file for more details.@@ -126,12 +107,10 @@ 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 when there is a logical flow of data, spaces between operators-   and after commas, etc. Please also confirm that the code passes under-   HLint.--There are a number of issues [tagged with the bounty tag](https://github.com/switchface/helm/issues?labels=bounty&state=open),-meaning they have associated bounties on [Bountysource](https://www.bountysource.com/trackers/290443-helm).+   code, please follow+   [Johan Tibell's Haskell style guide](https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md)+   with the following exceptions:+   * Up to 120 characters per line are allowed (widescreens for life).+   * Use a two space indent.+   * Acronyms in all caps for identifiers (while maintaing camel-case), i.e. SDL or 2D/3D.+   
+ examples/flappy/Main.hs view
@@ -0,0 +1,402 @@+{-# LANGUAGE RecordWildCards #-}+-- | A Flappy Bird clone. Click to flap.+-- Avoid the grey obstacles and don't touch the lava.+module Main where++import           Data.List (find)+import           Data.Maybe (isJust)+import           Debug.Trace (traceShow)+import           Text.Printf (printf)++import           Linear.V2 (V2(V2))+import qualified System.Random as Rand++import           Helm+import qualified Helm.Cmd as Cmd+import           Helm.Color+import           Helm.Engine.SDL (SDLEngine)+import qualified Helm.Engine.SDL as SDL+import           Helm.Graphics2D+import qualified Helm.Graphics2D.Text as Text+import qualified Helm.Keyboard as Keyboard+import qualified Helm.Mouse as Mouse+import qualified Helm.Sub as Sub+import qualified Helm.Time as Time+import           Helm.Time (Time)++-- | Represents the game actions for our game.+data Action+  = DoNothing                   -- ^ Do nothing.+  | Animate Double              -- ^ Animate the player with a dt.+  | Flap                        -- ^ Flap the player.+  | Restart                     -- ^ Restart the game after dying.+  | SetupObstacles Rand.StdGen  -- ^ Setup the obstacles using an RNG.++-- | Represents the status of the player (i.e. where they're at).+data PlayerStatus+  = Playing  -- ^ The player is playing the game.+  | Waiting  -- ^ The player is waiting and needs to click to start the game.+  | Dead     -- ^ The player is dead and needs to hit space to get to the waiting state.+  deriving (Eq, Ord, Show)++-- | Represents an obstacle the flapper can hit.+data Obstacle+  = NoObstacle  -- ^ The obstacle exists, but it's just empty (not visible and uncollidable).+  | Obstacle    -- ^ An actually collidable obstacle.+    { obsTopLeft     :: V2 Double+    , obsBottomRight :: V2 Double+    } deriving (Eq, Ord, Show)++-- | Represents the game state of the game.+data Model = Model+  { flapperPos   :: V2 Double+  , flapperVel   :: V2 Double+  , playerStatus :: PlayerStatus+  , obstacles    :: [Obstacle]+  , timeScore    :: Time+  , timeSpeed    :: Double+  }++initial :: (Model, Cmd SDLEngine Action)+initial =+  ( Model+      { flapperPos   = V2 0 0+      , flapperVel   = V2 0 0+      , playerStatus = Waiting+      , obstacles    = []+      , timeScore    = 0+      , timeSpeed    = 1+      }+  , Cmd.execute Rand.newStdGen SetupObstacles+  )++-- | The gravity acceleration for the flapper.+-- Note that the Y component is positive as the downwards+-- direction in our view is the positive end of the Y-axis.+-- The origin (0, 0) is the center of the screen.+gravity :: V2 Double+gravity = V2 0 7++lavaHeight :: Double+lavaHeight = 65++windowDims :: V2 Int+windowDims = V2 800 600++scrollVel :: V2 Double+scrollVel = V2 4 0++obsWidth :: Double+obsWidth = 70++obsMargin :: Double+obsMargin = 50++obsOffset :: Double+obsOffset = (obsMargin + obsWidth) * 6++flapperDims :: V2 Double+flapperDims = V2 50 50++-- | Only the obstacles the player has seen/can see.+relevantObs :: Model -> [Obstacle]+relevantObs Model { .. } =+  take n obstacles++  where+    V2 x _ = flapperPos+    V2 w _ = fromIntegral <$> windowDims+    n = max 0 $ floor $ (x - obsOffset + w) / (obsMargin + obsWidth)++-- | Are any obstacles touching the flapper?+touchingObs :: Model -> Bool+touchingObs model@Model { .. } =+  isJust $ find f $ relevantObs model++  where+    V2 x y = flapperPos+    V2 w h = flapperDims++    -- The flapper pos is centered. Turn it into a box.+    ftx = x - w / 2+    fty = y - h / 2+    fbx = x + w / 2+    fby = y + h / 2++    -- Check if the flapper box and obs box intersect.+    -- If so, we're dead.+    f NoObstacle = False+    f Obstacle { .. } =+      max tx ftx < min bx fbx &&+      max ty fty < min by fby++      where+        V2 tx ty = obsTopLeft+        V2 bx by = obsBottomRight++-- | Is our flapper touching the lava at the bottom of the screen?+inLava :: Model -> Bool+inLava Model { .. } =+  y + fh  / 2 >= h / 2 - lavaHeight++  where+    V2 _ fh = flapperDims+    V2 x y = flapperPos+    V2 w h = fromIntegral <$> windowDims++-- | Should our flapper die? Only checks if they should -+-- DOES NOT transition the player status to dead.+shouldDie :: Model -> Bool+shouldDie model = inLava model || touchingObs model++update :: Model -> Action -> (Model, Cmd SDLEngine Action)+update model@Model { .. } (Animate dt) =+  if playerStatus == Waiting then (model, Cmd.none)+  else+    ( model+      { flapperPos   = if y < -hh+                       then V2 x (-hh)+                       else pos+      , flapperVel   = vel+      , playerStatus = if dead+                       then Dead+                       else Playing+      , timeScore    = elapsed+      , timeSpeed    = speed+      }+    , Cmd.none+    )++  where+    -- | If the player is actually playing, increase the score.+    -- They might be at the death screen (which is also animated).+    elapsed = if dead+              then timeScore+              else timeScore + dt++    dt' = dt * 0.005+    gravity' = gravity * V2 dt' dt'++    -- Make the movement right faster as the player gets further across.+    speed = logBase 10 (10 + Time.inSeconds elapsed)+    vel = if dead+          then V2 0 1 * (flapperVel + gravity') -- No x-velocity while dead.+          else flapperVel + gravity'++    pos@(V2 x y) = flapperPos + vel + if dead+                                      then V2 0 0+                                      else scrollVel * V2 speed 0++    V2 _ h = fromIntegral <$> windowDims+    hh = h / 2+    dead = (playerStatus == Dead) || shouldDie model++-- | The player has clicked using their mouse.+-- | Process the "flap" of our flapper's wings.+update model@Model { .. } Flap =+  if playerStatus == Dead+  then (model, Cmd.none)+  else+    ( model+      { flapperVel   = V2 0 (-17)+      , playerStatus = Playing+      }+    , Cmd.none+    )++-- | The player has pressed space while on the death screen.+-- Restart the game.+update model@Model { .. } Restart =+  if playerStatus /= Dead+  then (model, Cmd.none)+  else+    ( model+      { playerStatus = Waiting+      , flapperPos   = V2 0 0+      , flapperVel   = V2 0 0+      , timeScore    = 0+      }++    -- Trigger a regeneration of obstacles+    , Cmd.execute Rand.newStdGen SetupObstacles+    )++-- | Initialize a list of all the obstacles in the game.+-- This works really nicely, as the list of obstacles+-- we produce is lazy and we can just keep generating+-- new obstacles out of until infinity - which is perfect,+-- as our player might just keep playing the game+-- for an eternity and beyond.+update model (SetupObstacles rng) =+  (model+   { obstacles = scanl generate NoObstacle $+                 zip [0..] $+                 Rand.randoms rng+   }+  , Cmd.none+  )++  where+    -- | Generate an obstacle based based off the last obstacle+    -- generated and some random input.+    generate+      :: Obstacle      -- | The last obstacle generated (or 'NoObstacle' if first).+      -> (Int, Double) -- | First element is the obstacle index, second is random input between [0,1).+      -> Obstacle      -- | The generated obstacle.+    generate last (i, n) =+      -- Randomly exclude obstacles, but don't do it for the first one.+      if i > 0 && (n < lb || n > hb)+      then NoObstacle+      else+        Obstacle+          { obsTopLeft = V2 x y+          , obsBottomRight = V2 (x + obsWidth) (y + height)+          }++      where+        lb = 0.2+        hb = 0.8++        -- We have to normalize the value here as we ignored < lb and > hb above.+        -- Let's get this back to (0, 1]+        n' = (n - lb) / (hb - lb)+        x = obsOffset + (obsWidth + obsMargin) * fromIntegral i+        V2 _ h = fromIntegral <$> windowDims+        h' = h - lavaHeight+        hh' = h / 2+        minHeight = 100+        maxHeight = 300+        (y, height) = calc last++        -- | Calc the obstacle height and+        calc NoObstacle =+          -- Generate a random y and random height. This can be anywhere on the screen as+          -- we're not next to an older obstacle.+          (-hh' + n' * h', height')++          where+            height' = minHeight + (maxHeight - minHeight) * n'++        calc Obstacle { .. } =+          -- We want the obstacle being generated to be in a similar position+          -- to the last one generated. So we adjust the last position randomly+          -- by a portion of the last generated obstacle's height.+          ( max (-hh') $ min hh' $ ty + (n' - 0.5) * maxHeight+          , height')++          where+            V2 tx ty = obsTopLeft+            V2 bx by = obsBottomRight+            lastHeight = by - ty+            height' = min maxHeight $ lastHeight + (n' - 0.5) * minHeight++-- | Do nothing.+update model _ = (model, Cmd.none)++subscriptions :: Sub SDLEngine Action+subscriptions = Sub.batch+  [ Mouse.clicks $ \_ _ -> Flap+  , Keyboard.presses $ \key -> (case key of+      Keyboard.SpaceKey -> Restart+      _                 -> DoNothing)+  , Time.fps 60 Animate+  ]++-- | Turn some second value into a pretty pluralized form (for UI).+secondsText :: Time -> String+secondsText t =+  show s ++ if s /= 1 then " seconds" else " second"++  where+    s = round $ Time.inSeconds t++-- | The overlay displayed when the player is dead.+deadOverlay :: Color -> Model -> Form SDLEngine+deadOverlay color Model { ..  } =+ group+   [ move (V2 0 (-25)) $ text $ Text.height 30 $+                                Text.color color $+                                Text.toText "Oops, you're dead."++   , move (V2 0 25) $ text $ Text.height 12 $+                             Text.color color $+                             Text.toText score++   , move (V2 0 50) $ text $ Text.height 12 $+                             Text.color color $+                             Text.toText "Press space to restart"+   ]++  where+    score = "You lasted " ++ secondsText timeScore++-- | The overlay displayed when the player is waiting to play.+waitingOverlay :: Color -> Form SDLEngine+waitingOverlay color =+  group+    [ move (V2 0 (-75)) $ text $ Text.height 30 $+                                 Text.color color $+                                 Text.toText "Ready?"++    , move (V2 0 75) $ text $ Text.height 12 $+                              Text.color color $+                              Text.toText "Click to flap"+    ]++-- | The overlay when playing the game (i.e. HUD).+playingOverlay :: Color -> Model -> Form SDLEngine+playingOverlay color Model { .. } =+  group+    [+      move (V2 0 (-h / 2 + 25)) $ text $ Text.height 12 $+                                         Text.color color $+                                         Text.toText status+    ]++  where+    status = secondsText timeScore ++ " | " ++ printf "%.2fx speed" timeSpeed+    V2 _ h = fromIntegral <$> windowDims++view :: Model -> Graphics SDLEngine+view model@Model { .. } = Graphics2D $+  center (V2 (w / 2) (h / 2)) $ collage+    [ backdrop+    , toForm $ center (V2 (-x) 0) $ collage+        [ move flapperPos flapper+        , group $ map structure $ relevantObs model+        ]++    , lava+    , overlay playerStatus model+    ]++  where+    dims@(V2 w h) = fromIntegral <$> windowDims+    V2 x y = flapperPos+    overlayColor = rgb 1 1 1+    overlay Waiting _ = waitingOverlay overlayColor+    overlay Dead model = deadOverlay overlayColor model+    overlay Playing model = playingOverlay overlayColor model+    flapper = filled (rgb 0.36 0.25 0.22) $ rect flapperDims+    backdrop = filled (rgb 0.13 0.13 0.13) $ rect dims+    lava = move (V2 0 (h / 2 - lavaHeight / 2)) $ filled (rgb 0.72 0.11 0.11) $ rect $ V2 w lavaHeight+    structure NoObstacle = blank+    structure Obstacle { .. } =+      move (V2 ((tx + bx) / 2) ((ty + by) / 2)) $ filled (rgb 0.38 0.49 0.55) $ rect $ V2 (bx - tx) (by - ty)++      where+        V2 tx ty = obsTopLeft+        V2 bx by = obsBottomRight++main :: IO ()+main = do+  engine <- SDL.startupWith $ SDL.defaultConfig+    { SDL.windowIsResizable = False+    , SDL.windowDimensions = windowDims }++  run engine GameConfig+    { initialFn       = initial+    , updateFn        = update+    , subscriptionsFn = subscriptions+    , viewFn          = view+    }
helm.cabal view
@@ -1,5 +1,5 @@ name: helm-version: 0.7.1+version: 1.0.0 synopsis: A functionally reactive game engine. description: A functionally reactive game engine, with headgear to protect you              from the headache of game development provided.@@ -7,12 +7,12 @@ bug-reports: http://github.com/switchface/helm/issues license: MIT license-file: LICENSE-tested-with: GHC == 7.6.3+tested-with: GHC == 7.10.2 extra-source-files: LICENSE, README.md author: Zack Corr maintainer: Zack Corr <zack@z0w0.me> copyright: (c) 2013-2014, Zack Corr-category: Game Engine, FRP+category: Game Engine, .1FRP build-type: Simple cabal-version: >=1.10 @@ -23,58 +23,69 @@ library   hs-source-dirs: src   default-language: Haskell2010-  default-extensions: RecordWildCards, NamedFieldPuns-  ghc-options: -Wall -fno-warn-unused-do-bind+  default-extensions: RecordWildCards, NamedFieldPuns, TypeFamilies+  ghc-options: -Wall    exposed-modules:-    FRP.Helm-    FRP.Helm.Color-    FRP.Helm.Graphics-    FRP.Helm.Engine-    FRP.Helm.Keyboard-    FRP.Helm.Mouse-    FRP.Helm.Random-    FRP.Helm.Sample-    FRP.Helm.Signal-    FRP.Helm.Text-    FRP.Helm.Time-    FRP.Helm.Utilities-    FRP.Helm.Window+    Helm+    Helm.Asset+    Helm.Cmd+    Helm.Color+    Helm.Engine+    Helm.Engine.SDL+    Helm.Engine.SDL.Asset+    Helm.Engine.SDL.Engine+    Helm.Engine.SDL.Graphics2D+    Helm.Engine.SDL.Keyboard+    Helm.Engine.SDL.Mouse+    Helm.Graphics+    Helm.Graphics2D+    Helm.Graphics2D.Text+    Helm.Graphics2D.Transform+    Helm.Keyboard+    Helm.Mouse+    Helm.Sub+    Helm.Time+    Helm.Window    build-depends:-    base >= 4 && < 5,-    cairo > 0.12 && < 0.13,-    pango > 0.12 && < 0.13,+    base == 4.*,+    cairo >= 0.13 && < 0.14,+    pango >= 0.13 && < 0.14,     containers >= 0.5 && < 1,-    elerea >= 2.7 && < 3,-    filepath >= 1.3 && < 2,-    sdl2 >= 1.1 && < 1.3,-    text >= 1.1.1.3,-    time >= 1.4 && < 1.5,-    random >= 1.0.1.1 && < 1.2,-    mtl >= 2.1 && < 2.2,-    transformers >= 0.3.0.0,-    cpu >= 0.1.2 && < 1+    elerea >= 2.9 && < 3,+    sdl2 > 2.1.1 && < 3,+    linear >= 1 && < 2,+    text >= 1.1.1.3 && < 2,+    mtl >= 2.1 && < 3,+    stm >= 2.4 && < 3,+    transformers >= 0.3.0.0 && < 0.6    if impl(ghc < 7.6)     build-depends: ghc-prim -test-suite helm-tests-  type: exitcode-stdio-1.0-  x-uses-tf: true-  ghc-options: -threaded -Wall -rtsopts -O-  hs-source-dirs: tests, src+executable helm-example-flappy   default-language: Haskell2010   main-is: Main.hs+  hs-source-dirs: examples/flappy    build-depends:     base >= 4 && < 5,-    cairo > 0.12 && < 0.13,-    containers >= 0.5 && < 1,-    HUnit >= 1.2 && < 2,-    test-framework >= 0.8 && < 1,-    test-framework-hunit >= 0.3 && < 1,-    test-framework-quickcheck2 >= 0.3 && < 1,-    time >= 1.4 && < 1.5,-    elerea >= 2.7 && < 3,-    sdl2 >= 1.1 && < 1.3+    linear >= 1 && < 2,+    random == 1.*,+    helm++test-suite helm-spec+  type: exitcode-stdio-1.0+  ghc-options: -Wall+  hs-source-dirs: test+  default-language: Haskell2010+  main-is: Spec.hs++  other-modules:+    Helm.TimeSpec++  build-depends:+    base  == 4.*,+    hspec == 2.*,+    helm
− src/FRP/Helm.hs
@@ -1,394 +0,0 @@-{-| Contains miscellaneous utility functions and the main-    functions for interfacing with the engine. -}-module FRP.Helm (-  -- * Types-  Time,-  EngineConfig(..),-  -- * Engine-  run,-  defaultConfig,-  -- * Prelude-  module Color,-  module Graphics,-  module Utilities,-  module Signal,-  FRP.Helm.Signal.lift-) where--import Control.Applicative-import Control.Concurrent (threadDelay)-import Control.Exception-import Control.Monad (when)-import Control.Monad.IO.Class-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.State-import Data.Bits-import Data.Foldable (forM_)-import Foreign.C.String-import Foreign.Marshal.Alloc-import Foreign.Ptr-import Foreign.Storable-import FRP.Elerea.Param hiding (Signal)-import FRP.Helm.Color as Color-import FRP.Helm.Engine-import FRP.Helm.Graphics as Graphics-import FRP.Helm.Utilities as Utilities-import FRP.Helm.Sample-import FRP.Helm.Signal as Signal hiding (lift)-import qualified FRP.Helm.Signal (lift)-import FRP.Helm.Time (Time)-import qualified FRP.Helm.Window as Window-import System.FilePath-import System.Endian-import qualified Data.Map as Map-import qualified Graphics.UI.SDL as SDL-import qualified Graphics.Rendering.Cairo as Cairo-import qualified Graphics.Rendering.Pango as Pango--type Helm a = StateT Engine Cairo.Render a--{-| A data structure holding the main element and information required for-    rendering. -}-data Application = Application {-  mainElement    :: Element,-  mainDimensions :: (Int, Int),-  mainContinue   :: Bool-}--{-| A data structure describing miscellaneous initial configurations of the-    game window and engine. -}-data EngineConfig = EngineConfig {-  windowDimensions :: (Int, Int),-  windowIsFullscreen :: Bool,-  windowIsResizable :: Bool,-  windowTitle :: String-}--{-| Creates the default configuration for the engine. You should change the-    fields where necessary before passing it to 'run'. -}-defaultConfig :: EngineConfig-defaultConfig = EngineConfig {-  windowDimensions = (800, 600),-  windowIsFullscreen = False,-  windowIsResizable = True,-  windowTitle = ""-}--{-| Creates a new engine that can be run later using 'run'. -}-startup :: EngineConfig -> IO Engine-startup (EngineConfig { .. }) = withCAString windowTitle $ \title -> do-    window <- SDL.createWindow title 0 0 (fromIntegral w) (fromIntegral h) wflags-    renderer <- SDL.createRenderer window (-1) rflags--    return Engine { window   = window-                  , renderer = renderer-                  , cache    = Map.empty-                  , continue = True-                  }--  where-    (w, h) = windowDimensions-    wflags = foldl (.|.) 0 $ [SDL.windowFlagShown] ++-                             [SDL.windowFlagResizable | windowIsResizable] ++-                             [SDL.windowFlagFullscreen | windowIsFullscreen]-    rflags = (.|.) SDL.rendererFlagPresentVSync SDL.rendererFlagAccelerated--{-| Initializes and runs the game engine. The supplied signal generator is-    constantly sampled for an element to render until the user quits.--    > import FRP.Helm-    > import qualified FRP.Helm.Window as Window-    >-    > render :: (Int, Int) -> Element-    > render (w, h) = collage w h [rect (fromIntegral w) (fromIntegral h) |> filled red]-    >-    > main :: IO ()-    > main = run defaultConfig $ lift render Window.dimensions- -}-run :: EngineConfig -> Signal Element -> IO ()-run config element = do engine <- startup config-                        run_ engine $ application <~ element-                                                  ~~ Window.dimensions-                                                  ~~ continue'-                                                  ~~ exposed-  where-    application :: Element -> (Int, Int) -> Bool -> () -> Application-    application e d c _ = Application e d c-    run_ eng (Signal gen) = (start gen >>= run' eng) `finally` SDL.quit--{-| An event that triggers when SDL thinks we need to re-draw. -}-exposed :: Signal ()-exposed = Signal getExposed-  where-    getExposed = effectful $ alloca $ \eventptr -> do-      SDL.pumpEvents-      status <- SDL.pollEvent eventptr--      if status == 1 then do-        event <- peek eventptr--        case event of-          SDL.WindowEvent _ _ _ e _ _ -> return $ if e == SDL.windowEventExposed-                                                  then Changed ()-                                                  else Unchanged ()-          _ -> return $ Unchanged ()-      else return $ Unchanged ()--{-| An event that triggers when SDL thinks we need to quit. -}-quit :: Signal ()-quit = Signal getQuit-  where-    getQuit = effectful $ do-      q <- SDL.quitRequested-      return (if q then Changed () else Unchanged ())--continue' :: Signal Bool-continue' = (==0) <~ count quit--{-| A utility function called by 'run' that samples the element-    or quits the entire engine if SDL events say to do so. -}-run' :: Engine -> (Engine -> IO (Sample Application)) -> IO ()-run' engine smp = when (continue engine) $ smp engine >>= renderIfChanged engine-                                                      >>= flip run' smp--{-| Renders when the sample is marked as changed delays the thread otherwise -}-renderIfChanged :: Engine -> Sample Application -> IO Engine-renderIfChanged engine event =  case event of-    Changed   app -> if mainContinue app-                     then render engine (mainElement app) (mainDimensions app)-                     else return engine { continue = False }--    Unchanged _ -> do threadDelay 1000-                      return engine--{-| A utility function that renders a previously sampled element-    using an engine state. -}-render :: Engine -> Element -> (Int, Int) -> IO Engine-render engine@(Engine { .. }) element (w, h) = alloca $ \pixelsptr ->-                                               alloca $ \pitchptr  -> do-  format <- SDL.masksToPixelFormatEnum 32 (fromBE32 0x0000ff00)-              (fromBE32 0x00ff0000) (fromBE32 0xff000000) (fromBE32 0x000000ff)--  texture <- SDL.createTexture renderer format-               SDL.textureAccessStreaming (fromIntegral w) (fromIntegral h)--  SDL.lockTexture texture nullPtr pixelsptr pitchptr--  pixels <- peek pixelsptr-  pitch <- fromIntegral <$> peek pitchptr--  res <- Cairo.withImageSurfaceForData (castPtr pixels)-           Cairo.FormatARGB32 w h pitch $ \surface -> Cairo.renderWith surface-             $ evalStateT (render' w h element) engine--  SDL.unlockTexture texture--  SDL.renderClear renderer-  SDL.renderCopy renderer texture nullPtr nullPtr-  SDL.destroyTexture texture-  SDL.renderPresent renderer--  return res---{-| A utility function called by 'render' that is called by Cairo-    when it's ready to do rendering. -}-render' :: Int -> Int -> Element -> Helm Engine-render' w h element = do-  lift $ do Cairo.setSourceRGB 0 0 0-            Cairo.rectangle 0 0 (fromIntegral w) (fromIntegral h)-            Cairo.fill--  renderElement element-  get--{-| 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 :: FilePath -> Helm (Cairo.Surface, Int, Int)-getSurface src = do-  Engine _ _ cache _ <- get--  case Map.lookup src cache of-    Just surface -> do-      w <- Cairo.imageSurfaceGetWidth surface-      h <- Cairo.imageSurfaceGetHeight surface--      return (surface, w, h)--    Nothing -> do-      -- TODO: Use SDL_image to support more formats. I gave up after it was painful-      -- to convert between the two surface types safely.-      -- FIXME: Does this throw an error?-      surface <- liftIO $ Cairo.imageSurfaceCreateFromPNG src-      w <- liftIO $ Cairo.imageSurfaceGetWidth surface-      h <- liftIO $ Cairo.imageSurfaceGetHeight surface--      modify (\engine -> engine{cache=Map.insert src surface cache})-      return (surface, w, h)--{-| A utility function for rendering a specific element. -}-renderElement :: Element -> Helm ()-renderElement (CollageElement w h center forms) = do-  lift $ do Cairo.save-            Cairo.rectangle 0 0 (fromIntegral w) (fromIntegral h)-            Cairo.clip-            forM_ center $ uncurry Cairo.translate-  mapM_ renderForm forms-  lift Cairo.restore--renderElement (ImageElement (sx, sy) sw sh src stretch) = do-  (surface, w, h) <- getSurface (normalise src)--  lift $ do Cairo.save-            Cairo.translate (-fromIntegral sx) (-fromIntegral sy)--            if stretch then-              Cairo.scale (fromIntegral sw / fromIntegral w)-                (fromIntegral sh / fromIntegral h)-            else-              Cairo.scale 1 1--            Cairo.setSourceSurface surface 0 0-            Cairo.translate (fromIntegral sx) (fromIntegral sy)-            Cairo.rectangle 0 0 (fromIntegral sw) (fromIntegral sh)-            if stretch then-                Cairo.paint-            else-                Cairo.fill-                -            Cairo.restore--renderElement (TextElement (Text { textColor = (Color r g b a), .. })) = do-    lift Cairo.save--    layout <- lift $ Pango.createLayout textUTF8--    Cairo.liftIO $ Pango.layoutSetAttributes layout-      [ Pango.AttrFamily { paStart = i, paEnd = j, paFamily = textTypeface }-      , Pango.AttrWeight { paStart = i, paEnd = j, paWeight = mapFontWeight textWeight }-      , Pango.AttrStyle  { paStart = i, paEnd = j, paStyle = mapFontStyle textStyle }-      , Pango.AttrSize   { paStart = i, paEnd = j, paSize = textHeight }-      ]--    Pango.PangoRectangle x y w h <- fmap snd-      $ Cairo.liftIO $ Pango.layoutGetExtents layout--    lift $ do Cairo.translate ((-w / 2) -x) ((-h / 2) - y)-              Cairo.setSourceRGBA r g b a-              Pango.showLayout layout-              Cairo.restore--  where-    i = 0-    j = length textUTF8--{-| A utility function that maps to a Pango font weight based off our variant. -}-mapFontWeight :: FontWeight -> Pango.Weight-mapFontWeight weight = case weight of-  LightWeight  -> Pango.WeightLight-  NormalWeight -> Pango.WeightNormal-  BoldWeight   -> Pango.WeightBold--{-| A utility function that maps to a Pango font style based off our variant. -}-mapFontStyle :: FontStyle -> Pango.FontStyle-mapFontStyle style = case style of-  NormalStyle  -> Pango.StyleNormal-  ObliqueStyle -> Pango.StyleOblique-  ItalicStyle  -> Pango.StyleItalic--{-| A utility function that goes into a state of transformation and then pops-    it when finished. -}-withTransform :: Double -> Double -> Double -> Double -> Helm () -> Helm ()-withTransform s t x y f = do-  lift $ Cairo.save >> Cairo.scale s s >> Cairo.translate x y >> Cairo.rotate t-  f-  lift Cairo.restore--{-| A utility function that sets the Cairo line cap based off of our version. -}-setLineCap :: LineCap -> Cairo.Render ()-setLineCap cap = case cap of-  FlatCap   -> Cairo.setLineCap Cairo.LineCapButt-  RoundCap  -> Cairo.setLineCap Cairo.LineCapRound-  PaddedCap -> 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-  SmoothJoin    -> Cairo.setLineJoin Cairo.LineJoinRound-  SharpJoin lim -> Cairo.setLineJoin Cairo.LineJoinMiter >> Cairo.setMiterLimit lim-  ClippedJoin   -> 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 :: FillStyle -> Helm ()-setFillStyle (Solid (Color r g b a)) = lift $ do-  Cairo.setSourceRGBA r g b a-  Cairo.fill--setFillStyle (Texture src) = do-  (surface, _, _) <- getSurface (normalise src)-  lift $ do Cairo.setSourceSurface surface 0 0-            Cairo.getSource >>= flip Cairo.patternSetExtend Cairo.ExtendRepeat-            Cairo.fill--setFillStyle (Gradient (Linear (sx, sy) (ex, ey) points)) =-  lift $ Cairo.withLinearPattern sx sy ex ey-       $ \pattern -> setFillStyle' pattern points--setFillStyle (Gradient (Radial (sx, sy) sr (ex, ey) er points)) =-  lift $ Cairo.withRadialPattern sx sy sr ex ey er-       $ \pattern -> setFillStyle' pattern points--{-| A utility function that adds color stops to a pattern and then fills it. -}-setFillStyle' :: Cairo.Pattern -> [(Double, Color)] -> Cairo.Render ()-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 :: Form -> Helm ()-renderForm Form { .. } = withTransform formScale formTheta formX formY $-  case formStyle of-    PathForm style ~ps @ ((hx, hy) : _) -> lift $ do-      Cairo.newPath-      Cairo.moveTo hx hy-      mapM_ (uncurry Cairo.lineTo) ps-      setLineStyle style--    ShapeForm style shape -> do-      lift Cairo.newPath--      case shape of-        PolygonShape ~ps @ ((hx, hy) : _) ->-          lift $ do Cairo.moveTo hx hy-                    mapM_ (uncurry Cairo.lineTo) ps--        RectangleShape (w, h) -> lift $ Cairo.rectangle (-w / 2) (-h / 2) w h--        ArcShape (cx, cy) a1 a2 r (sx, sy) ->-          lift $ do Cairo.scale sx sy-                    Cairo.arc cx cy r a1 a2-                    Cairo.scale 1 1--      either (lift . setLineStyle) setFillStyle style--    ElementForm element -> renderElement element-    GroupForm mayhaps forms -> do-      lift $ do Cairo.save-                forM_ mayhaps Cairo.setMatrix-      mapM_ renderForm forms-      lift Cairo.restore
− src/FRP/Helm/Color.hs
@@ -1,196 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-| Contains all data structures and functions for composing colors. -}-module FRP.Helm.Color (-  -- * Types-  Color(..),-  Gradient(..),-  -- * Composing-  rgba,-  rgb,-  hsva,-  hsv,-  blend,-  complement,-  linear,-  radial,-  -- * Constants-  red,-  lime,-  blue,-  yellow,-  cyan,-  magenta,-  black,-  white,-  gray,-  grey,-  maroon,-  navy,-  green,-  teal,-  purple,-  violet,-  forestGreen-) where--import GHC.Generics--{-| 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, Generic)--{-| Creates an RGB color. -}-rgb :: Double -> Double -> Double -> Color-rgb r g b = rgba r g b 1--{-| Creates an RGB color, with transparency. -}-rgba :: Double -> Double -> Double -> Double -> Color-rgba r g b a-  | r < 0 || r > 1 ||-    g < 0 || g > 1 ||-    b < 0 || b > 1 ||-    a < 0 || a > 1 = error "FRP.Helm.Color.rgba: color components must be between 0 and 1"-  | otherwise = Color r g b a--{-| A bright red color. -}-red :: Color-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--{-| Takes a list of colors and turns it into a single color by-    averaging the color components. -}-blend :: [Color] -> Color-blend colors = (\(Color r g b a) -> Color (r / denom) (g / denom) (b / denom) (a / denom)) $ foldl blend' black colors-  where-    denom = fromIntegral $ length colors--{-| A utility function that adds colors together. -}-blend' :: Color -> Color -> Color-blend' (Color r1 g1 b1 a1) (Color r2 g2 b2 a2) = Color (r1 + r2) (g1 + g2) (b1 + b2) (a1 + a2)--{-| 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/Engine.hs
@@ -1,11 +0,0 @@-module FRP.Helm.Engine where-import qualified Graphics.UI.SDL as SDL-import qualified Graphics.Rendering.Cairo as Cairo-import qualified Data.Map as Map-{-| A data structure describing the current engine state. -}-data Engine = Engine {-  window   :: SDL.Window,-  renderer :: SDL.Renderer,-  cache    :: Map.Map FilePath Cairo.Surface,-  continue :: Bool-}
− src/FRP/Helm/Graphics.hs
@@ -1,303 +0,0 @@-{-| Contains all the data structures and functions for composing-    and rendering graphics. -}-module FRP.Helm.Graphics (-  -- * Types-  Element(..),-  FontWeight(..),-  FontStyle(..),-  Text(..),-  Form(..),-  FormStyle(..),-  FillStyle(..),-  LineCap(..),-  LineJoin(..),-  LineStyle(..),-  Path,-  Shape(..),-  -- * Elements-  image,-  fittedImage,-  croppedImage,-  collage,-  centeredCollage,-  fixedCollage,-  -- * Styles & Forms-  defaultLine,-  solid,-  dashed,-  dotted,-  filled,-  textured,-  gradient,-  outlined,-  traced,-  sprite,-  toForm,-  blank,-  -- * 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)--{-| A data structure describing the weight of a piece of font. -}-data FontWeight = LightWeight |-                  NormalWeight |-                  BoldWeight deriving (Show, Eq, Ord, Enum, Read)--{-| A data structure describing the style of of a piece of font. -}-data FontStyle = NormalStyle |-                 ObliqueStyle |-                 ItalicStyle deriving (Show, Eq, Ord, Enum, Read)--{-| A data structure describing a piece of formatted text. -}-data Text = Text {-  textUTF8 :: String,-  textColor :: Color,-  textTypeface :: String,-  textHeight :: Double,-  textWeight :: FontWeight,-  textStyle :: FontStyle-} deriving (Show, Eq)--{-| 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 (Maybe (Double, Double)) [Form] |-               ImageElement (Int, Int) Int Int FilePath Bool |-               TextElement Text 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 = FlatCap | RoundCap | PaddedCap 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 = SmoothJoin | SharpJoin Double | ClippedJoin 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 = FlatCap,-  lineJoin = SharpJoin 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)--{-| Creates a empty form, useful for having forms rendered only at some state. -}-blank :: Form-blank = group []--{-| 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 Nothing--{-| Like 'collage', but it centers the forms within the supplied dimensions. -}-centeredCollage :: Int -> Int -> [Form] -> Element-centeredCollage w h = CollageElement w h (Just (realToFrac w / 2, realToFrac h / 2))--{-| Like 'centeredCollage', but it centers the forms around a specific point. -}-fixedCollage :: Int -> Int -> (Double, Double) -> [Form] -> Element-fixedCollage w h (x, y) = CollageElement w h (Just (realToFrac w / 2 - x, realToFrac h / 2 - y))--{-| 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/Keyboard.hs
@@ -1,793 +0,0 @@-{-| Contains signals that sample input from the keyboard. -}-module FRP.Helm.Keyboard (-  -- * Types-  Key(..),-  -- * Key State-  isDown, keysDown,-  -- * Directions-  arrows, wasd-) where--import Control.Applicative-import Data.List-import Foreign hiding (shift)-import Foreign.C.Types-import FRP.Elerea.Param hiding (Signal)-import FRP.Helm.Sample-import FRP.Helm.Signal--{-| The SDL bindings for Haskell don't wrap this, so we have to use the FFI ourselves. -}-foreign import ccall unsafe "SDL_GetKeyboardState" sdlGetKeyState :: Ptr CInt -> IO (Ptr Word8)--{-| A utility function for getting a list of SDL keys currently pressed.-    Based on <http://coderepos.org/share/browser/lang/haskell/nario/Main.hs?rev=22646#L49>. -}-getKeyState :: IO [Int]-getKeyState = alloca $ \numkeysPtr -> do-  keysPtr <- sdlGetKeyState numkeysPtr-  numkeys <- peek numkeysPtr--  (map fromIntegral . elemIndices 1) <$> peekArray (fromIntegral numkeys) keysPtr--{-| A data structure describing a physical key on a keyboard. -}-data Key-  = AKey-  | BKey-  | CKey-  | DKey-  | EKey-  | FKey-  | GKey-  | HKey-  | IKey-  | JKey-  | KKey-  | LKey-  | MKey-  | NKey-  | OKey-  | PKey-  | QKey-  | RKey-  | SKey-  | TKey-  | UKey-  | VKey-  | WKey-  | XKey-  | YKey-  | ZKey-  | Number1Key-  | Number2Key-  | Number3Key-  | Number4Key-  | Number5Key-  | Number6Key-  | Number7Key-  | Number8Key-  | Number9Key-  | Number0Key-  | ReturnKey-  | EscapeKey-  | BackspaceKey-  | TabKey-  | SpaceKey-  | MinusKey-  | EqualsKey-  | LeftBracketKey-  | RightBracketKey-  | BackslashKey-  | NonUSHashKey-  | SemicolonKey-  | ApostropheKey-  | GraveKey-  | CommaKey-  | PeriodKey-  | SlashKey-  | CapslockKey-  | F1Key-  | F2Key-  | F3Key-  | F4Key-  | F5Key-  | F6Key-  | F7Key-  | F8Key-  | F9Key-  | F10Key-  | F11Key-  | F12Key-  | PrintScreenKey-  | ScrollLockKey-  | PauseKey-  | InsertKey-  | HomeKey-  | PageUpKey-  | DeleteKey-  | EndKey-  | PageDownKey-  | RightKey-  | LeftKey-  | DownKey-  | UpKey-  | NumLockClearKey-  | KeypadDivideKey-  | KeypadMultiplyKey-  | KeypadMinusKey-  | KeypadPlusKey-  | KeypadEnterKey-  | Keypad1Key-  | Keypad2Key-  | Keypad3Key-  | Keypad4Key-  | Keypad5Key-  | Keypad6Key-  | Keypad7Key-  | Keypad8Key-  | Keypad9Key-  | Keypad0Key-  | KeypadPeriodKey-  | NonUSBackslashKey-  | ApplicationKey-  | PowerKey-  | KeypadEqualsKey-  | F13Key-  | F14Key-  | F15Key-  | F16Key-  | F17Key-  | F18Key-  | F19Key-  | F20Key-  | F21Key-  | F22Key-  | F23Key-  | F24Key-  | ExecuteKey-  | HelpKey-  | MenuKey-  | SelectKey-  | StopKey-  | AgainKey-  | UndoKey-  | CutKey-  | CopyKey-  | PasteKey-  | FindKey-  | MuteKey-  | VolumeUpKey-  | VolumeDownKey-  | KeypadCommaKey-  | KeyPadEqualsAs400Key-  | International1Key-  | International2Key-  | International3Key-  | International4Key-  | International5Key-  | International6Key-  | International7Key-  | International8Key-  | International9Key-  | Lang1Key-  | Lang2Key-  | Lang3Key-  | Lang4Key-  | Lang5Key-  | Lang6Key-  | Lang7Key-  | Lang8Key-  | Lang9Key-  | AltEraseKey-  | SysReqKey-  | CancelKey-  | ClearKey-  | PriorKey-  | Return2Key-  | SeparatorKey-  | OutKey-  | OperKey-  | ClearAgainKey-  | CrSelKey-  | ExSelKey-  | Keypad00Key-  | Keypad000Key-  | ThousandSeparatorKey-  | DecimalSeparatorKey-  | CurrencyUnitKey-  | CurrencySubUnitKey-  | KeypadLeftParenKey-  | KeypadRightParenKey-  | KeypadLeftBraceKey-  | KeypadRightBraceKey-  | KeypadTabKey-  | KeypadBackspaceKey-  | KeypadAKey-  | KeypadBKey-  | KeypadCKey-  | KeypadDKey-  | KeypadEKey-  | KeypadFKey-  | KeypadXORKey-  | KeypadPowerKey-  | KeypadPercentKey-  | KeypadLessKey-  | KeypadGreaterKey-  | KeypadAmpersandKey-  | KeypadDoubleAmpersandKey-  | KeypadVerticalBarKey-  | KeypadDoubleVerticalBarKey-  | KeypadColonKey-  | KeypadHashKey-  | KeypadSpaceKey-  | KeypadAtKey-  | KeypadExclamationKey-  | KeypadMemStoreKey-  | KeypadMemRecallKey-  | KeypadMemClearKey-  | KeypadMemAddKey-  | KeypadMemSubstractKey-  | KeypadMemMultiplyKey-  | KeypadMemDivideKey-  | KeypadPlusMinusKey-  | KeypadClearKey-  | KeypadClearEntryKey-  | KeypadBinaryKey-  | KeypadOctalKey-  | KeypadDecimalKey-  | KeypadHexadecimalKey-  | LeftControlKey-  | LeftShiftKey-  | LeftAltKey-  | LeftMetaKey-  | RightControlKey-  | RightShiftKey-  | RightAltKey-  | RightMetaKey-  | ModeKey-  | AudioNextKey-  | AudioPreviousKey-  | AudioStopKey-  | AudioPlayKey-  | AudioMuteKey-  | MediaSelectKey-  | WWWKey-  | MailKey-  | CalculatorKey-  | ComputerKey-  | ACSearchKey-  | ACHomeKey-  | ACBackKey-  | ACForwardKey-  | ACStopKey-  | ACRefreshKey-  | ACBookmarksKey-  | BrightnessDownKey-  | BrightnessUpKey-  | DisplaySwitchKey-  | KeyboardIllumToggleKey-  | KeyboardIllumDownKey-  | KeyboardIllumUpKey-  | EjectKey-  | SleepKey-  | App1Key-  | App2Key-  deriving (Show, Eq, Ord, Read)--{- All integer values of this enum are equivalent to the SDL scancode enum. -}-instance Enum Key where-  fromEnum AKey = 4-  fromEnum BKey = 5-  fromEnum CKey = 6-  fromEnum DKey = 7-  fromEnum EKey = 8-  fromEnum FKey = 9-  fromEnum GKey = 10-  fromEnum HKey = 11-  fromEnum IKey = 12-  fromEnum JKey = 13-  fromEnum KKey = 14-  fromEnum LKey = 15-  fromEnum MKey = 16-  fromEnum NKey = 17-  fromEnum OKey = 18-  fromEnum PKey = 19-  fromEnum QKey = 20-  fromEnum RKey = 21-  fromEnum SKey = 22-  fromEnum TKey = 23-  fromEnum UKey = 24-  fromEnum VKey = 25-  fromEnum WKey = 26-  fromEnum XKey = 27-  fromEnum YKey = 28-  fromEnum ZKey = 29-  fromEnum Number1Key = 30-  fromEnum Number2Key = 31-  fromEnum Number3Key = 32-  fromEnum Number4Key = 33-  fromEnum Number5Key = 34-  fromEnum Number6Key = 35-  fromEnum Number7Key = 36-  fromEnum Number8Key = 37-  fromEnum Number9Key = 38-  fromEnum Number0Key = 39-  fromEnum ReturnKey = 40-  fromEnum EscapeKey = 41-  fromEnum BackspaceKey = 42-  fromEnum TabKey = 43-  fromEnum SpaceKey = 44-  fromEnum MinusKey = 45-  fromEnum EqualsKey = 46-  fromEnum LeftBracketKey = 47-  fromEnum RightBracketKey = 48-  fromEnum BackslashKey = 49-  fromEnum NonUSHashKey = 50-  fromEnum SemicolonKey = 51-  fromEnum ApostropheKey = 52-  fromEnum GraveKey = 53-  fromEnum CommaKey = 54-  fromEnum PeriodKey = 55-  fromEnum SlashKey = 56-  fromEnum CapslockKey = 57-  fromEnum F1Key = 58-  fromEnum F2Key = 59-  fromEnum F3Key = 60-  fromEnum F4Key = 61-  fromEnum F5Key = 62-  fromEnum F6Key = 63-  fromEnum F7Key = 64-  fromEnum F8Key = 65-  fromEnum F9Key = 66-  fromEnum F10Key = 67-  fromEnum F11Key = 68-  fromEnum F12Key = 69-  fromEnum PrintScreenKey = 70-  fromEnum ScrollLockKey = 71-  fromEnum PauseKey = 72-  fromEnum InsertKey = 73-  fromEnum HomeKey = 74-  fromEnum PageUpKey = 75-  fromEnum DeleteKey = 76-  fromEnum EndKey = 77-  fromEnum PageDownKey = 78-  fromEnum RightKey = 79-  fromEnum LeftKey = 80-  fromEnum DownKey = 81-  fromEnum UpKey = 82-  fromEnum NumLockClearKey = 83-  fromEnum KeypadDivideKey = 84-  fromEnum KeypadMultiplyKey = 85-  fromEnum KeypadMinusKey = 86-  fromEnum KeypadPlusKey = 87-  fromEnum KeypadEnterKey = 88-  fromEnum Keypad1Key = 89-  fromEnum Keypad2Key = 90-  fromEnum Keypad3Key = 91-  fromEnum Keypad4Key = 92-  fromEnum Keypad5Key = 93-  fromEnum Keypad6Key = 94-  fromEnum Keypad7Key = 95-  fromEnum Keypad8Key = 96-  fromEnum Keypad9Key = 97-  fromEnum Keypad0Key = 98-  fromEnum KeypadPeriodKey = 99-  fromEnum NonUSBackslashKey = 100-  fromEnum ApplicationKey = 101-  fromEnum PowerKey = 102-  fromEnum KeypadEqualsKey = 103-  fromEnum F13Key = 104-  fromEnum F14Key = 105-  fromEnum F15Key = 106-  fromEnum F16Key = 107-  fromEnum F17Key = 108-  fromEnum F18Key = 109-  fromEnum F19Key = 110-  fromEnum F20Key = 111-  fromEnum F21Key = 112-  fromEnum F22Key = 113-  fromEnum F23Key = 114-  fromEnum F24Key = 115-  fromEnum ExecuteKey = 116-  fromEnum HelpKey = 117-  fromEnum MenuKey = 118-  fromEnum SelectKey = 119-  fromEnum StopKey = 120-  fromEnum AgainKey = 121-  fromEnum UndoKey = 122-  fromEnum CutKey = 123-  fromEnum CopyKey = 124-  fromEnum PasteKey = 125-  fromEnum FindKey = 126-  fromEnum MuteKey = 127-  fromEnum VolumeUpKey = 128-  fromEnum VolumeDownKey = 129-  fromEnum KeypadCommaKey = 133-  fromEnum KeyPadEqualsAs400Key = 134-  fromEnum International1Key = 135-  fromEnum International2Key = 136-  fromEnum International3Key = 137-  fromEnum International4Key = 138-  fromEnum International5Key = 139-  fromEnum International6Key = 140-  fromEnum International7Key = 141-  fromEnum International8Key = 142-  fromEnum International9Key = 143-  fromEnum Lang1Key = 144-  fromEnum Lang2Key = 145-  fromEnum Lang3Key = 146-  fromEnum Lang4Key = 147-  fromEnum Lang5Key = 148-  fromEnum Lang6Key = 149-  fromEnum Lang7Key = 150-  fromEnum Lang8Key = 151-  fromEnum Lang9Key = 152-  fromEnum AltEraseKey = 153-  fromEnum SysReqKey = 154-  fromEnum CancelKey = 155-  fromEnum ClearKey = 156-  fromEnum PriorKey = 157-  fromEnum Return2Key = 158-  fromEnum SeparatorKey = 159-  fromEnum OutKey = 160-  fromEnum OperKey = 161-  fromEnum ClearAgainKey = 162-  fromEnum CrSelKey = 163-  fromEnum ExSelKey = 164-  fromEnum Keypad00Key = 176-  fromEnum Keypad000Key = 177-  fromEnum ThousandSeparatorKey = 178-  fromEnum DecimalSeparatorKey = 179-  fromEnum CurrencyUnitKey = 180-  fromEnum CurrencySubUnitKey = 181-  fromEnum KeypadLeftParenKey = 182-  fromEnum KeypadRightParenKey = 183-  fromEnum KeypadLeftBraceKey = 184-  fromEnum KeypadRightBraceKey = 185-  fromEnum KeypadTabKey = 186-  fromEnum KeypadBackspaceKey = 187-  fromEnum KeypadAKey = 188-  fromEnum KeypadBKey = 189-  fromEnum KeypadCKey = 190-  fromEnum KeypadDKey = 191-  fromEnum KeypadEKey = 192-  fromEnum KeypadFKey = 193-  fromEnum KeypadXORKey = 194-  fromEnum KeypadPowerKey = 195-  fromEnum KeypadPercentKey = 196-  fromEnum KeypadLessKey = 197-  fromEnum KeypadGreaterKey = 198-  fromEnum KeypadAmpersandKey = 199-  fromEnum KeypadDoubleAmpersandKey = 200-  fromEnum KeypadVerticalBarKey = 201-  fromEnum KeypadDoubleVerticalBarKey = 202-  fromEnum KeypadColonKey = 203-  fromEnum KeypadHashKey = 204-  fromEnum KeypadSpaceKey = 205-  fromEnum KeypadAtKey = 206-  fromEnum KeypadExclamationKey = 207-  fromEnum KeypadMemStoreKey = 208-  fromEnum KeypadMemRecallKey = 209-  fromEnum KeypadMemClearKey = 210-  fromEnum KeypadMemAddKey = 211-  fromEnum KeypadMemSubstractKey = 212-  fromEnum KeypadMemMultiplyKey = 213-  fromEnum KeypadMemDivideKey = 214-  fromEnum KeypadPlusMinusKey = 215-  fromEnum KeypadClearKey = 216-  fromEnum KeypadClearEntryKey = 217-  fromEnum KeypadBinaryKey = 218-  fromEnum KeypadOctalKey = 219-  fromEnum KeypadDecimalKey = 220-  fromEnum KeypadHexadecimalKey = 221-  fromEnum LeftControlKey = 224-  fromEnum LeftShiftKey = 225-  fromEnum LeftAltKey = 226-  fromEnum LeftMetaKey = 227-  fromEnum RightControlKey = 228-  fromEnum RightShiftKey = 299-  fromEnum RightAltKey = 230-  fromEnum RightMetaKey = 231-  fromEnum ModeKey = 257-  fromEnum AudioNextKey = 258-  fromEnum AudioPreviousKey = 259-  fromEnum AudioStopKey = 260-  fromEnum AudioPlayKey = 261-  fromEnum AudioMuteKey = 262-  fromEnum MediaSelectKey = 263-  fromEnum WWWKey = 264-  fromEnum MailKey = 265-  fromEnum CalculatorKey = 266-  fromEnum ComputerKey = 267-  fromEnum ACSearchKey = 268-  fromEnum ACHomeKey = 269-  fromEnum ACBackKey = 270-  fromEnum ACForwardKey = 271-  fromEnum ACStopKey = 272-  fromEnum ACRefreshKey = 273-  fromEnum ACBookmarksKey = 274-  fromEnum BrightnessDownKey = 275-  fromEnum BrightnessUpKey = 276-  fromEnum DisplaySwitchKey = 277-  fromEnum KeyboardIllumToggleKey = 278-  fromEnum KeyboardIllumDownKey = 279-  fromEnum KeyboardIllumUpKey = 280-  fromEnum EjectKey = 281-  fromEnum SleepKey = 282-  fromEnum App1Key = 283-  fromEnum App2Key = 284--  toEnum 4 = AKey-  toEnum 5 = BKey-  toEnum 6 = CKey-  toEnum 7 = DKey-  toEnum 8 = EKey-  toEnum 9 = FKey-  toEnum 10 = GKey-  toEnum 11 = HKey-  toEnum 12 = IKey-  toEnum 13 = JKey-  toEnum 14 = KKey-  toEnum 15 = LKey-  toEnum 16 = MKey-  toEnum 17 = NKey-  toEnum 18 = OKey-  toEnum 19 = PKey-  toEnum 20 = QKey-  toEnum 21 = RKey-  toEnum 22 = SKey-  toEnum 23 = TKey-  toEnum 24 = UKey-  toEnum 25 = VKey-  toEnum 26 = WKey-  toEnum 27 = XKey-  toEnum 28 = YKey-  toEnum 29 = ZKey-  toEnum 30 = Number1Key-  toEnum 31 = Number2Key-  toEnum 32 = Number3Key-  toEnum 33 = Number4Key-  toEnum 34 = Number5Key-  toEnum 35 = Number6Key-  toEnum 36 = Number7Key-  toEnum 37 = Number8Key-  toEnum 38 = Number9Key-  toEnum 39 = Number0Key-  toEnum 40 = ReturnKey-  toEnum 41 = EscapeKey-  toEnum 42 = BackspaceKey-  toEnum 43 = TabKey-  toEnum 44 = SpaceKey-  toEnum 45 = MinusKey-  toEnum 46 = EqualsKey-  toEnum 47 = LeftBracketKey-  toEnum 48 = RightBracketKey-  toEnum 49 = BackslashKey-  toEnum 50 = NonUSHashKey-  toEnum 51 = SemicolonKey-  toEnum 52 = ApostropheKey-  toEnum 53 = GraveKey-  toEnum 54 = CommaKey-  toEnum 55 = PeriodKey-  toEnum 56 = SlashKey-  toEnum 57 = CapslockKey-  toEnum 58 = F1Key-  toEnum 59 = F2Key-  toEnum 60 = F3Key-  toEnum 61 = F4Key-  toEnum 62 = F5Key-  toEnum 63 = F6Key-  toEnum 64 = F7Key-  toEnum 65 = F8Key-  toEnum 66 = F9Key-  toEnum 67 = F10Key-  toEnum 68 = F11Key-  toEnum 69 = F12Key-  toEnum 70 = PrintScreenKey-  toEnum 71 = ScrollLockKey-  toEnum 72 = PauseKey-  toEnum 73 = InsertKey-  toEnum 74 = HomeKey-  toEnum 75 = PageUpKey-  toEnum 76 = DeleteKey-  toEnum 77 = EndKey-  toEnum 78 = PageDownKey-  toEnum 79 = RightKey-  toEnum 80 = LeftKey-  toEnum 81 = DownKey-  toEnum 82 = UpKey-  toEnum 83 = NumLockClearKey-  toEnum 84 = KeypadDivideKey-  toEnum 85 = KeypadMultiplyKey-  toEnum 86 = KeypadMinusKey-  toEnum 87 = KeypadPlusKey-  toEnum 88 = KeypadEnterKey-  toEnum 89 = Keypad1Key-  toEnum 90 = Keypad2Key-  toEnum 91 = Keypad3Key-  toEnum 92 = Keypad4Key-  toEnum 93 = Keypad5Key-  toEnum 94 = Keypad6Key-  toEnum 95 = Keypad7Key-  toEnum 96 = Keypad8Key-  toEnum 97 = Keypad9Key-  toEnum 98 = Keypad0Key-  toEnum 99 = KeypadPeriodKey-  toEnum 100 = NonUSBackslashKey-  toEnum 101 = ApplicationKey-  toEnum 102 = PowerKey-  toEnum 103 = KeypadEqualsKey-  toEnum 104 = F13Key-  toEnum 105 = F14Key-  toEnum 106 = F15Key-  toEnum 107 = F16Key-  toEnum 108 = F17Key-  toEnum 109 = F18Key-  toEnum 110 = F19Key-  toEnum 111 = F20Key-  toEnum 112 = F21Key-  toEnum 113 = F22Key-  toEnum 114 = F23Key-  toEnum 115 = F24Key-  toEnum 116 = ExecuteKey-  toEnum 117 = HelpKey-  toEnum 118 = MenuKey-  toEnum 119 = SelectKey-  toEnum 120 = StopKey-  toEnum 121 = AgainKey-  toEnum 122 = UndoKey-  toEnum 123 = CutKey-  toEnum 124 = CopyKey-  toEnum 125 = PasteKey-  toEnum 126 = FindKey-  toEnum 127 = MuteKey-  toEnum 128 = VolumeUpKey-  toEnum 129 = VolumeDownKey-  toEnum 133 = KeypadCommaKey-  toEnum 134 = KeyPadEqualsAs400Key-  toEnum 135 = International1Key-  toEnum 136 = International2Key-  toEnum 137 = International3Key-  toEnum 138 = International4Key-  toEnum 139 = International5Key-  toEnum 140 = International6Key-  toEnum 141 = International7Key-  toEnum 142 = International8Key-  toEnum 143 = International9Key-  toEnum 144 = Lang1Key-  toEnum 145 = Lang2Key-  toEnum 146 = Lang3Key-  toEnum 147 = Lang4Key-  toEnum 148 = Lang5Key-  toEnum 149 = Lang6Key-  toEnum 150 = Lang7Key-  toEnum 151 = Lang8Key-  toEnum 152 = Lang9Key-  toEnum 153 = AltEraseKey-  toEnum 154 = SysReqKey-  toEnum 155 = CancelKey-  toEnum 156 = ClearKey-  toEnum 157 = PriorKey-  toEnum 158 = Return2Key-  toEnum 159 = SeparatorKey-  toEnum 160 = OutKey-  toEnum 161 = OperKey-  toEnum 162 = ClearAgainKey-  toEnum 163 = CrSelKey-  toEnum 164 = ExSelKey-  toEnum 176 = Keypad00Key-  toEnum 177 = Keypad000Key-  toEnum 178 = ThousandSeparatorKey-  toEnum 179 = DecimalSeparatorKey-  toEnum 180 = CurrencyUnitKey-  toEnum 181 = CurrencySubUnitKey-  toEnum 182 = KeypadLeftParenKey-  toEnum 183 = KeypadRightParenKey-  toEnum 184 = KeypadLeftBraceKey-  toEnum 185 = KeypadRightBraceKey-  toEnum 186 = KeypadTabKey-  toEnum 187 = KeypadBackspaceKey-  toEnum 188 = KeypadAKey-  toEnum 189 = KeypadBKey-  toEnum 190 = KeypadCKey-  toEnum 191 = KeypadDKey-  toEnum 192 = KeypadEKey-  toEnum 193 = KeypadFKey-  toEnum 194 = KeypadXORKey-  toEnum 195 = KeypadPowerKey-  toEnum 196 = KeypadPercentKey-  toEnum 197 = KeypadLessKey-  toEnum 198 = KeypadGreaterKey-  toEnum 199 = KeypadAmpersandKey-  toEnum 200 = KeypadDoubleAmpersandKey-  toEnum 201 = KeypadVerticalBarKey-  toEnum 202 = KeypadDoubleVerticalBarKey-  toEnum 203 = KeypadColonKey-  toEnum 204 = KeypadHashKey-  toEnum 205 = KeypadSpaceKey-  toEnum 206 = KeypadAtKey-  toEnum 207 = KeypadExclamationKey-  toEnum 208 = KeypadMemStoreKey-  toEnum 209 = KeypadMemRecallKey-  toEnum 210 = KeypadMemClearKey-  toEnum 211 = KeypadMemAddKey-  toEnum 212 = KeypadMemSubstractKey-  toEnum 213 = KeypadMemMultiplyKey-  toEnum 214 = KeypadMemDivideKey-  toEnum 215 = KeypadPlusMinusKey-  toEnum 216 = KeypadClearKey-  toEnum 217 = KeypadClearEntryKey-  toEnum 218 = KeypadBinaryKey-  toEnum 219 = KeypadOctalKey-  toEnum 220 = KeypadDecimalKey-  toEnum 221 = KeypadHexadecimalKey-  toEnum 224 = LeftControlKey-  toEnum 225 = LeftShiftKey-  toEnum 226 = LeftAltKey-  toEnum 227 = LeftMetaKey-  toEnum 228 = RightControlKey-  toEnum 299 = RightShiftKey-  toEnum 230 = RightAltKey-  toEnum 231 = RightMetaKey-  toEnum 257 = ModeKey-  toEnum 258 = AudioNextKey-  toEnum 259 = AudioPreviousKey-  toEnum 260 = AudioStopKey-  toEnum 261 = AudioPlayKey-  toEnum 262 = AudioMuteKey-  toEnum 263 = MediaSelectKey-  toEnum 264 = WWWKey-  toEnum 265 = MailKey-  toEnum 266 = CalculatorKey-  toEnum 267 = ComputerKey-  toEnum 268 = ACSearchKey-  toEnum 269 = ACHomeKey-  toEnum 270 = ACBackKey-  toEnum 271 = ACForwardKey-  toEnum 272 = ACStopKey-  toEnum 273 = ACRefreshKey-  toEnum 274 = ACBookmarksKey-  toEnum 275 = BrightnessDownKey-  toEnum 276 = BrightnessUpKey-  toEnum 277 = DisplaySwitchKey-  toEnum 278 = KeyboardIllumToggleKey-  toEnum 279 = KeyboardIllumDownKey-  toEnum 280 = KeyboardIllumUpKey-  toEnum 281 = EjectKey-  toEnum 282 = SleepKey-  toEnum 283 = App1Key-  toEnum 284 = App2Key-  toEnum _ = error "FRP.Helm.Keyboard.Key.toEnum: bad argument"--{-| Whether a key is pressed. -}-isDown :: Key -> Signal Bool-isDown k = Signal $ getDown >>= transfer (pure True) update-  where getDown = effectful $ elem (fromEnum k) <$> getKeyState--{-| A list of keys that are currently being pressed. -}-keysDown :: Signal [Key]-keysDown = Signal $ getDown >>= transfer (pure []) update-  where getDown = 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 :: Signal (Int, Int)-arrows =  arrows' <$> up <*> left <*> down <*> right-  where up    = isDown UpKey-        left  = isDown LeftKey-        down  = isDown DownKey-        right = isDown RightKey---{-| 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 :: Signal (Int, Int)-wasd = arrows' <$> w <*> a <*> s <*> d-  where w = isDown WKey-        a = isDown AKey-        s = isDown SKey-        d = isDown DKey-
− src/FRP/Helm/Mouse.hs
@@ -1,86 +0,0 @@-{-| Contains signals that sample input from the mouse. -}-module FRP.Helm.Mouse-(-  -- * Types-  Mouse(..),-  -- * Position-  position, x, y,-  -- * Mouse State-  isDown,-  isDownButton,-  clicks-) where--import Control.Applicative (pure)-import Data.Bits-import Foreign.Marshal.Alloc-import Foreign.Ptr-import Foreign.Storable-import FRP.Elerea.Param hiding (Signal)-import FRP.Helm.Sample-import FRP.Helm.Signal-import qualified Graphics.UI.SDL as SDL--{-| A data structure describing a button on a mouse. -}-data Mouse-  = LeftMouse-  | MiddleMouse-  | RightMouse-  | X1Mouse-  | X2Mouse deriving (Show, Eq, Ord, Read)--{- All integer values of this enum are equivalent to the SDL key enum. -}-instance Enum Mouse where-  fromEnum LeftMouse   = 1-  fromEnum MiddleMouse = 2-  fromEnum RightMouse  = 3-  fromEnum X1Mouse     = 4-  fromEnum X2Mouse     = 5--  toEnum 1 = LeftMouse-  toEnum 2 = MiddleMouse-  toEnum 3 = RightMouse-  toEnum 4 = X1Mouse-  toEnum 5 = X2Mouse-  toEnum _ = error "FRP.Helm.Mouse.Mouse.toEnum: bad argument"--{-| The current position of the mouse. -}-position :: Signal (Int, Int)-position = Signal $ getPosition >>= transfer (pure (0,0)) update-  where-    getPosition = effectful $ alloca $ \xptr -> alloca $ \yptr -> do-      _ <- SDL.getMouseState xptr yptr-      x_ <- peek xptr-      y_ <- peek yptr--      return (fromIntegral x_, fromIntegral y_)--{-| The current x-coordinate of the mouse. -}-x :: Signal Int-x = fst <~ position--{-| The current y-coordinate of the mouse. -}-y :: Signal Int-y = snd <~ position--{-| The current state of the left mouse-button. True when the button is down,-    and false otherwise. -}-isDown :: Signal Bool-isDown = isDownButton LeftMouse--{-| The current state of a given mouse button. True if down, false otherwise.-    -}-isDownButton :: Mouse -> Signal Bool-isDownButton m = Signal $ getDown >>= transfer (pure False) update-  where-    getDown = effectful $ do-      flags <- SDL.getMouseState nullPtr nullPtr--      return $ (.&.) (fromIntegral flags) (fromEnum m) /= 0--{-| Always equal to unit. Event triggers on every mouse click. -}-clicks :: Signal ()-clicks = Signal $ signalGen isDown >>= transfer (pure ()) update_-  where update_ _ (Changed True) _ = Changed ()-        update_ _ _ _              = Unchanged ()-
− src/FRP/Helm/Random.hs
@@ -1,81 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-module FRP.Helm.Random (-  range,-  float,-  floatList-) where-import Control.Applicative (pure)-import Control.Monad (liftM, join, replicateM)-import FRP.Elerea.Param hiding (Signal)-import qualified FRP.Elerea.Param as Elerea (Signal)-import FRP.Helm.Signal-import FRP.Helm.Sample-import FRP.Helm.Engine-import System.Random (Random, randomRIO)--{-| Given a range from low to high and a signal of values, this produces-a new signal that changes whenever the input signal changes. The new-values are random number between 'low' and 'high' inclusive.--}-range :: Int -> Int -> Signal a -> Signal Int-range x y = rand (x,y)--{-| Produces a new signal that changes whenever the input signal changes.-The new values are random numbers in [0..1).--}-float :: Signal a -> Signal Float-float = rand (0,1)--{-| A utility signal that does the work for 'float' and 'range'. -}-rand :: (Random a, Num a) =>-          (a, a) -> Signal b -> Signal a-rand limits s = Signal $ do-  s' <- signalGen s-  rs :: Elerea.Signal (SignalGen Engine (Elerea.Signal a))-     <- randomGens limits s'-  r  :: Elerea.Signal (Elerea.Signal a)-     <- generator rs-  transfer2 (pure 0) update_ s' (join r)-  where-    update_ :: (Random a, Num a) => p ->-                  Sample b -> a -> Sample a -> Sample a-    update_ _ new random old = case new of-      Changed   _ -> Changed random-      Unchanged _ -> Unchanged $ value old-    randomGens :: (Random a, Num a) =>-                    (a,a) -> Elerea.Signal (Sample b)-                          -> SignalGen p (Elerea.Signal-                               (SignalGen p (Elerea.Signal a)))-    randomGens l = transfer (return (return 0)) (makeGen l)-    makeGen ::(Random a, Num a) => (a,a) -> p -> Sample b-                -> SignalGen p (Elerea.Signal a)-                -> SignalGen p (Elerea.Signal a)-    makeGen l _ new _ = case new of-      Changed   _ -> effectful $ randomRIO l-      Unchanged _ -> return $ return 0--{-| Produces a new signal of lists that changes whenever the input signal-changes. The input signal specifies the length of the random list. Each value is-a random number in [0..1).--}-floatList :: Signal Int -> Signal [Float]-floatList s = Signal $ do-  s' <- signalGen s-  fl :: Elerea.Signal (SignalGen Engine (Elerea.Signal [Float]))-     <- floatListGens s'-  ss :: Elerea.Signal (Elerea.Signal [Float])-     <- generator fl-  transfer2 (pure []) update_ s' (join ss)-  where-    floatListGens :: Elerea.Signal (Sample Int)-                       -> SignalGen p (Elerea.Signal-                            (SignalGen p (Elerea.Signal [Float])))-    floatListGens = transfer (return (return [])) makeGen-    makeGen _ new _ = case new of-            Changed   n -> liftM sequence $ replicateM n-                                          $ effectful-                                          $ randomRIO (0,1)-            Unchanged _ -> return (return [])-    update_ _ int new old = case int of-            Changed   _ -> Changed new-            Unchanged _ -> Unchanged $ value old
− src/FRP/Helm/Sample.hs
@@ -1,29 +0,0 @@-module FRP.Helm.Sample (-  Sample(..),-  value,-  update-) where--import Control.Applicative--data Sample a = Changed a | Unchanged a-  deriving (Show, Eq)--instance Functor Sample where-  fmap = liftA--instance Applicative Sample where-  pure = Unchanged-  (Changed   f) <*> (Changed   x) = Changed (f x)-  (Changed   f) <*> (Unchanged x) = Changed (f x)-  (Unchanged f) <*> (Changed   x) = Changed (f x)-  (Unchanged f) <*> (Unchanged x) = Unchanged (f x)--value :: Sample a -> a-value (Changed   x) = x-value (Unchanged x) = x--update :: Eq a => p -> a -> Sample a -> Sample a-update _ new old = if new == value old-                   then Unchanged $ value old-                   else Changed new
− src/FRP/Helm/Signal.hs
@@ -1,127 +0,0 @@-module FRP.Helm.Signal(-  Signal(..),-  -- * Composing-  constant,-  combine,-  lift,-  lift2,-  lift3,-  (<~),-  (~~),-  -- * Accumulating-  foldp,-  count,-  countIf,-  -- * DYEL?-  lift4,-  lift5,-  lift6,-  lift7,-  lift8-) where-import Control.Applicative-import Data.Traversable (sequenceA)-import FRP.Elerea.Param hiding (Signal)-import qualified FRP.Elerea.Param as Elerea (Signal)-import FRP.Helm.Sample-import FRP.Helm.Engine--newtype Signal a = Signal {signalGen :: SignalGen Engine (Elerea.Signal (Sample a))}--instance Functor Signal where-  fmap = liftA--instance Applicative Signal where-  pure = Signal . pure . pure . pure-  (Signal f) <*> (Signal x) = Signal $ liftA2 (liftA2 (<*>)) f x--{-| Creates a signal that never changes. -}-constant :: a -> Signal a-constant x = Signal $ stateful (Changed x) (\_ _ -> Unchanged x)--{-| Combines a list of signals into a signal of lists. -}-combine :: [Signal a] -> Signal [a]-combine = sequenceA--{-| Applies a function to a signal producing a new signal. This is a synonym of-   'fmap'. It automatically binds the input signal out of the signal generator.--    > lift render Window.dimensions- -}-lift :: (a -> b) -> Signal a -> Signal b-lift = fmap--{-| Applies a function to two signals. -}-lift2 :: (a -> b -> c) -> Signal a -> Signal b -> Signal c-lift2 f a b = f <~ a ~~ b--{-| Applies a function to three signals. -}-lift3 :: (a -> b -> c -> d) -> Signal a -> Signal b -> Signal c -> Signal d-lift3 f a b c = f <~ a ~~ b ~~ c--{-| Applies a function to four signals. -}-lift4 :: (a -> b -> c -> d -> e) -> Signal a -> Signal b -> Signal c -> Signal d-                                 -> 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) -> Signal a -> Signal b -> Signal c -> Signal d-                                      -> Signal e -> 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) -> Signal a -> Signal b -> Signal c -> Signal d-                                           -> Signal e -> Signal f -> 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) -> Signal a -> Signal b -> Signal c -> Signal d-                                                -> Signal e -> Signal f -> Signal g -> 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) -> Signal a -> Signal b -> Signal c -> Signal d-                                                     -> Signal e -> Signal f -> Signal g -> Signal h-                                                     -> 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) -> Signal a -> Signal b-(<~) = lift--infixl 4 <~--{-| Applies a function within a signal to a signal. This is a synonym of <*>.-    It automatically binds the input signal out of the signal generator.--    > render <~ Window.dimensions ~~ Window.position- -}-(~~) :: Signal (a -> b) -> Signal a -> Signal b-(~~) = (<*>)--infixl 4 ~~--{-| 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.-    -    > playerPosition :: (Int, Int) -> SignalGen (Signal (Int, Int))-    > playerPosition initial = foldp update initial arrows-    >     where update (dx, dy) (x, y) = (x + dx, y + dy)---}-foldp :: (a -> b -> b) -> b -> Signal a -> Signal b-foldp f ini (Signal gen) =-  Signal $ gen >>= transfer (pure ini) update_-               >>= delay (Changed ini)-    where update_ _ (Unchanged _) y = Unchanged (value y)-          update_ _ (Changed   x) y = Changed $ f x (value y)--{-| Count the number of events that have occurred.-}-count :: Signal a -> Signal Int-count = foldp (\_ y -> y + 1) 0--{-| Count the number of events that have occurred that satisfy a given predicate.-}-countIf :: (a -> Bool) -> Signal a -> Signal Int-countIf f = foldp (\v c -> c + fromEnum (f v)) 0
− src/FRP/Helm/Text.hs
@@ -1,98 +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-  light,-  bold,-  italic,-  oblique,-  color,-  monospace,-  typeface,-  header,-  height-) where--import FRP.Helm.Color (Color, black)-import FRP.Helm.Graphics (Element(TextElement), Text(..), FontWeight(..), FontStyle(..))--{-| Creates the default text. By default the text is black sans-serif-    with a height of 14pt. -}-defaultText :: Text-defaultText = Text {-  textUTF8 = "",-  textColor = black,-  textTypeface = "sans-serif",-  textHeight = 14,-  textWeight = NormalWeight,-  textStyle = NormalStyle-}--{-| 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 = BoldWeight }--{-| Sets the weight of a piece of text to light. -}-light :: Text -> Text-light txt = txt { textWeight = LightWeight }--{-| Sets the slant of a piece of text to italic. -}-italic :: Text -> Text-italic txt = txt { textStyle = ItalicStyle }--{-| Sets the slant of a piece of text to oblique. -}-oblique :: Text -> Text-oblique txt = txt { textStyle = ObliqueStyle }--{-| 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. -}-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
@@ -1,148 +0,0 @@-{-| Contains functions for composing units of time and signals that sample from the game clock. -}-module FRP.Helm.Time (-  -- * Units-  Time,-  millisecond,-  second,-  minute,-  hour,-  inMilliseconds,-  inSeconds,-  inMinutes,-  inHours,-  -- * Tickers-  fps,-  fpsWhen,-  every,-  -- * Timing-  timestamp,-  delay,-  since-) where--import Control.Applicative-import Control.Monad-import FRP.Elerea.Param hiding (delay, Signal, until)-import qualified FRP.Elerea.Param as Elerea (Signal, until)-import Data.Time.Clock.POSIX (getPOSIXTime)-import FRP.Helm.Signal-import FRP.Helm.Sample-import System.IO.Unsafe (unsafePerformIO)--{-| 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--{-| Takes desired number of frames per second (fps). The resulting signal gives-   a sequence of time deltas as quickly as possible until it reaches the-   desired FPS. A time delta is the time between the last frame and the current-   frame. -}-fps :: Double -> Signal Time-fps n = snd <~ every' t-  where --Ain't nobody got time for infinity-    t = if n == 0 then 0 else second / n--{-| Same as the fps function, but you can turn it on and off. Allows you to do-   brief animations based on user input without major inefficiencies. The first-   time delta after a pause is always zero, no matter how long the pause was.-   This way summing the deltas will actually give the amount of time that the-   output signal has been running. -}-fpsWhen :: Double -> Signal Bool -> Signal Time-fpsWhen n sig = Signal $ do c <- signalGen sig-                            f <- signalGen (fps n)-                            transfer2 (pure 0) update_ f c-  where update_ _ new (Unchanged cont) old = if cont-                                             then new-                                             else Unchanged $ value old-        update_ _ _   (Changed   cont) old = if cont-                                             then Changed 0-                                             else Unchanged $ value old-{-| Takes a time interval t. The resulting signal is the current time, updated-    every t. -}-every :: Time -> Signal Time-every t = fst <~ every' t--{-| A utility signal used by 'fps' and 'every' that returns the current time-    and a delta every t. -}-every' :: Time -> Signal (Time, Time)-every' t = Signal $ every'' t >>= transfer (pure (0,0)) update--{-| Another utility signal that does all the magic for 'every'' by working on-    the Elerea SignalGen level -}-every'' :: Time -> SignalGen p (Elerea.Signal (Time, Time))-every'' t = do-    it <- execute getTime-    effectful getTime >>= transfer (it,0) update_-  where-    getTime = liftM ((second *) . realToFrac) getPOSIXTime-    update_ _ new old = let delta = new - fst old-                        in if delta >= t then (new, delta) else old--{-| Add a timestamp to any signal. Timestamps increase monotonically. When you-    create (timestamp Mouse.x), an initial timestamp is produced. The timestamp-    updates whenever Mouse.x updates.--    Unlike in Elm the timestamps are not tied to the underlying signals so the-    timestamps for Mouse.x and  Mouse.y will be slightly different. -}-timestamp :: Signal a -> Signal (Time, a)-timestamp = lift2 (,) pure_time-  where pure_time = fst <~ (Signal $ (fmap . fmap) pure (every'' millisecond))--{-| Delay a signal by a certain amount of time. So (delay second Mouse.clicks)-    will update one second later than any mouse click. -}-delay :: Time -> Signal a -> Signal a-delay t (Signal gen) = Signal $ (fmap . fmap) fst $-                         do s <- gen-                            w <- timeout-                            e <- snapshot =<< input-                            transfer2 (makeInit e, []) update_ w s-  where-     -- XXX uses unsafePerformIO, is there a better way?-    makeInit e = pure $ value $ unsafePerformIO (start gen >>= (\f -> f e))-    update_ _ waiting new (old, olds) = if waiting then (old, new:olds)-                                        else (last olds, new:init olds)-    timeout = every'' t >>= transfer False (\_ (time,delta) _ -> time /= delta)-                        -- 'Elerea.until' will lose the reference to the input so-                        -- we don't keep looking up the time even though the-                        -- output can never change again-                        >>= Elerea.until-                        >>= transfer True (\_ new old -> old && not new)--{-| Takes a time t and any signal. The resulting boolean signal is true for-    time t after every event on the input signal. So (second `since`-    Mouse.clicks) would result in a signal that is true for one second after-    each mouse click and false otherwise. -}-since :: Time -> Signal a -> Signal Bool-since t s = lift2 (/=) (count s) (count (delay t s))
− src/FRP/Helm/Utilities.hs
@@ -1,32 +0,0 @@-{-| Contains miscellaneous utility functions such as functions for working with signals and signal generators. -}-module FRP.Helm.Utilities (-  -- * Angles-  radians,-  degrees,-  turns,-  -- * Applying-  (<|),-  (|>),-) where--{-| 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--{-| Forward function application, think of it as a inverted '($)'. Provided for easy porting from Elm. -}-(|>) :: a -> (a -> b) -> b-(|>) = flip ($)--{-| Exactly the same as '($)', only there to make code using '(|>)'-    more consistent. -}-(<|) :: (a -> b) -> a -> b-(<|) = ($)
− src/FRP/Helm/Window.hs
@@ -1,53 +0,0 @@-{-| Contains signals that sample input from the game window. -}-module FRP.Helm.Window (-  -- * Dimensions-  dimensions,-  width,-  height,-  position-) where--import Control.Applicative (pure)-import Foreign.Marshal.Alloc-import Foreign.Storable-import FRP.Elerea.Param hiding (Signal)-import FRP.Helm.Engine-import FRP.Helm.Sample-import FRP.Helm.Signal-import qualified Graphics.UI.SDL as SDL--{-| The current dimensions of the window. -}-dimensions :: Signal (Int, Int)-dimensions =-  Signal $ input >>= getDimensions >>= transfer (pure (0,0)) update-  where-    getDimensions = effectful1 action-    action engine = alloca $ \wptr -> alloca $ \hptr -> do-	  SDL.getWindowSize (window engine) wptr hptr--	  w <- peek wptr-	  h <- peek hptr--	  return (fromIntegral w, fromIntegral h)--{-| The current position of the window. -}-position :: Signal (Int, Int)-position =-  Signal $ input >>= getPosition >>= transfer (pure (0,0)) update-  where-    getPosition = effectful1 action-    action engine = alloca $ \xptr -> alloca $ \yptr -> do-	  SDL.getWindowPosition (window engine) xptr yptr--	  x <- peek xptr-	  y <- peek yptr--	  return (fromIntegral x, fromIntegral y)--{-| The current width of the window. -}-width :: Signal Int-width = fst <~ dimensions--{-| The current height of the window. -}-height :: Signal Int-height = snd <~ dimensions
+ src/Helm.hs view
@@ -0,0 +1,98 @@+-- | Contains the main functions for interfacing with the engine.+-- This can be thought of Helm's own Prelude.+module Helm+  (+    -- * Types+    Cmd(..)+  , Engine+  , GameConfig(..)+  , Graphics(..)+  , Image+  , Sub(..)+    -- * Engine+  , run+  ) where++import Control.Exception (finally)+import Control.Monad (foldM, void)+import Control.Monad.Trans.State.Lazy (evalStateT)+import FRP.Elerea.Param (start, embed)++import Helm.Asset (Image)+import Helm.Engine (Cmd(..), Sub(..), GameConfig(..), Engine(..))+import Helm.Graphics++-- | A data structure describing a game's state (that is running under an engine).+data Game e m a = Game+  { gameConfig :: GameConfig e m a  -- ^ The configuration of the game, passed by a user.+  , gameModel :: m                  -- ^ The current game model state.+  , actionSmp :: e -> IO [a]        -- ^ A feedable monad that returns actions from mapped subscriptions.+  }++-- | Prepare the game state from an engine and some game configuration.+prepare :: Engine e => e -> GameConfig e m a -> IO (Game e m a)+prepare engine config = do+  {- The call to 'embed' here is a little bit hacky, but seems necessary+     to get this working. This is because 'start' actually computes the signal+     gen passed to it, and all of our signal gens try to fetch+     the 'input' value within the top layer signal gen (rather than in the+     contained signal). But we haven't sampled with the input value yet, so it'll+     be undefined unless we 'embed'. -}+  smp <- start $ embed (return engine) gen++  return Game+    { gameConfig = config+    , gameModel = fst initialFn+    , actionSmp = smp+    }++  where+    GameConfig { initialFn, subscriptionsFn = Sub gen } = config++-- | Runs a Helm game using an engine and some configuration for a game.+-- An engine should first be initialized separately to Helm, and then passed+-- to this function. Helm is written this way so that library users can+-- choose what backend engine they want to use (and hence Helm is engine-agnostic).+--+-- The best engine to get started with is the SDL implementation of Helm,+-- which is currently bundled with the engine (although it will eventually be moved+-- to its own package). See 'Helm.Engine.SDL.startup' for how+-- to startup the SDL engine, which can then be run by this function.+run :: Engine e => e -> GameConfig e m a -> IO ()+run engine config@GameConfig { initialFn } =+  void $ (prepare engine config >>= stepInitial >>= step engine) `finally` cleanup engine++  where+    Cmd monad = snd initialFn+    stepInitial game@Game { gameModel } = do+      actions <- evalStateT monad engine+      model <- foldM (stepModel engine game) gameModel actions++      return game { gameModel = model }++-- | Step the game state forward.+step :: Engine e => e -> Game e m a -> IO ()+step engine game = do+  mayhaps <- tick engine++  case mayhaps of+    Nothing -> return ()++    Just sunkEngine -> do+      actions <- actionSmp sunkEngine+      model <- foldM (stepModel sunkEngine game) gameModel actions++      render sunkEngine $ viewFn model+      step sunkEngine $ game { gameModel = model }++  where+    Game { actionSmp, gameModel, gameConfig = GameConfig { viewFn } } = game++-- | Step the game model forward with a specific game action.+stepModel :: Engine e => e -> Game e m a -> m -> a -> IO m+stepModel engine game model action =+  evalStateT monad engine >>= foldM (stepModel engine game) upModel++  where+    Game { gameConfig = GameConfig { updateFn } } = game+    (upModel, Cmd monad) = updateFn model action
+ src/Helm/Asset.hs view
@@ -0,0 +1,18 @@+-- | Contains the file asset types.+module Helm.Asset+  (+    -- * Type Families+    Image+  ) where++-- | Represents an image asset loaded by an engine instance.+--+-- This is a type family, where the instance+-- types are the specific internal representations of an image+-- for an engine. Hence the e type variable here should refer+-- to an 'Engine' instance, but that is not strictly required.+--+-- Having the image type be a family allows us to separate the internal+-- representation of the image assets for each engine from+-- the core Helm library.+data family Image e
+ src/Helm/Cmd.hs view
@@ -0,0 +1,43 @@+-- | Contains the command type and related utilities.+module Helm.Cmd (+  -- * Types+  Cmd(..),+  -- * Utilities+  batch,+  none,+  execute+) where++import Control.Monad.Trans.Class (lift)++import Helm.Engine (Engine, Cmd(..))++-- | Combine a list of commands into a single one.+batch+  :: Engine e+  => [Cmd e a]  -- ^ The list of commands to combine.+  -> Cmd e a    -- ^ The accumulated command.+batch cmds = Cmd $ do+  lists <- mapM (\(Cmd m) -> m) cmds++  return $ concat lists++-- | A command that does nothing. When returned in a Helm+-- game's update or initial functions, it will not produce+-- any game actions.+none :: Engine e => Cmd e a+none = Cmd $ return []++-- | Execute an IO monad and then map its result to a game action.+-- This can be used as a kind of 'liftIO', however to keep+-- things consistent with the rest of the library, you+-- must map the monad result a game action.+execute+  :: Engine e+  => IO b      -- ^ The IO monad to execute.+  -> (b -> a)  -- ^ The function to map the monad result to an action.+  -> Cmd e a   -- ^ The mapped command.+execute monad f = Cmd $ do+  result <- f <$> lift monad++  return [result]
+ src/Helm/Color.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE DeriveGeneric #-}+-- | Contains all data structures and functions for composing colors.+module Helm.Color (+  -- * Types+  Color(..),+  Gradient(..),+  -- * Composing+  rgba,+  rgb,+  hsva,+  hsv,+  blend,+  complement,+  linear,+  radial+) where++import GHC.Generics++-- | Represents 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, Generic)++-- | Create an RGB color.+rgb :: Double -> Double -> Double -> Color+rgb r g b = rgba r g b 1++-- | Create an RGBA color.+rgba :: Double -> Double -> Double -> Double -> Color+rgba r g b a+  | r < 0 || r > 1 ||+    g < 0 || g > 1 ||+    b < 0 || b > 1 ||+    a < 0 || a > 1 = error "Helm.Color.rgba: color components must be between 0 and 1"+  | otherwise = Color r g b a++-- | Blends colors together by averaging out their color components.+blend :: [Color] -> Color+blend colors =+  (\(Color r g b a) -> Color (r / denom) (g / denom) (b / denom) (a / denom)) $ foldl blend' black colors++  where+    black = rgb 0 0 0+    denom = fromIntegral $ length colors++-- | Adds colors together.+blend' :: Color -> Color -> Color+blend' (Color r1 g1 b1 a1) (Color r2 g2 b2 a2) = Color (r1 + r2) (g1 + g2) (b1 + b2) (a1 + a2)++-- | Calculate the complementary color for a color provided color.+-- This is 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++-- | Represents a gradient.+--+-- Helm supports radial and linear gradients.+-- 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)] -- ^ A linear gradient.+  | Radial !(Double, Double) !Double !(Double, Double) !Double ![(Double, Color)] -- ^ A radial gradient.+  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/Helm/Engine.hs view
@@ -0,0 +1,408 @@+-- | Contains the core engine types and classes.+module Helm.Engine (+  -- * Typeclasses+  Engine(..),+  -- * Types+  Cmd(..),+  GameConfig(..),+  Sub(..),+  MouseButton(..),+  Key(..)+) where++import Control.Monad.Trans.State (StateT)++import FRP.Elerea.Param (SignalGen, Signal)+import Linear.V2 (V2)++import Helm.Graphics (Graphics)++-- | Represents a backend engine that can run a Helm game.+--+-- Helm separates the logic for running a game from the actual interaction with the user -+-- window management, event management (key presses, mouse presses, etc.) are all handled by a specific instance+-- of the engine typeclass. Meanwhile, the game loop and other core features are handled independently+-- by the Helm library itself.+class Engine e where+  -- | Renders a graphics element to the engine's game window.+  render :: e -> Graphics e -> IO ()++  -- | Ticks (or steps) the engine forward. Generally, an engine should use this method to+  -- gather any new input events from the underlying engine and sink them into the signals it provides below.+  -- Depending on the implementation of the engine, it might be necessary to do other things here too.+  tick :: e -> IO (Maybe e)++  -- | Cleans up all resources loaded by the engine. This will be run when the engine has stopped execution,+  -- hence it should do everything required to free any resources allocated by the engine.+  cleanup :: e -> IO ()++  -- | Get the game window size.+  windowSize :: e -> IO (V2 Int)++  -- | Get the current game running time.+  runningTime :: e -> IO Double++  -- | The mouse move signal, with events provided by the engine.+  mouseMoveSignal :: e -> SignalGen e (Signal [V2 Int])++  -- | The mouse down signal, with events provided by the engine.+  mouseDownSignal :: e -> SignalGen e (Signal [(MouseButton, V2 Int)])++  -- | The mouse up signal, with events provided by the engine.+  mouseUpSignal :: e -> SignalGen e (Signal [(MouseButton, V2 Int)])++  -- | The mouse click signal, with events provided by the engine.+  mouseClickSignal :: e -> SignalGen e (Signal [(MouseButton, V2 Int)])++  -- | The keyboard down signal, with events provided by the engine.+  keyboardDownSignal :: e -> SignalGen e (Signal [Key])++  -- | The keyboard up signal, with events provided by the engine.+  keyboardUpSignal :: e -> SignalGen e (Signal [Key])++  -- | The keyboard press signal, with events provided by the engine.+  keyboardPressSignal :: e -> SignalGen e (Signal [Key])++  -- | The window resize signal, with events provided by the engine.+  windowResizeSignal :: e -> SignalGen e (Signal [V2 Int])++-- | Represents a subscription to a stream of events captured from a user's interaction with the engine.+-- A subscription is best thought of as a collection of events over time - which is the nature of+-- functional reactive programming (the paradigm that Helm bases it's concepts on).+-- Although Helm uses a departed version of the traditional FRP paradigm, it still follows the+-- concept closely and hence an understanding of FRP will allow you to understnad the library easily.+--+-- Functions throughout the Helm library that return a subscription will first let you map the data+-- related to the event you're subscribing to into another form (specifically, a game action).+-- These game actions are then sent to the update function of your game, i.e. the mapped+-- subscription specifies exactly how game events will interact with your game state.+--+-- Here the type variable e is an instance of the 'Engine' typeclass+-- and the variable a is the game action data type used by your game.+newtype Sub e a = Sub (SignalGen e (Signal [a]))++-- | Represents an IO-like monad with knowledge about the state of the game engine. Each command+-- contains a collection of game actions that will be applied to your game's update function to update+-- the game state. This is similar to a subscription in a way, with the difference being that+-- a command does not change over time, but rather is a lazy monad and hence contains a value that+-- from the time of the execution. A good example of the usage of a command vs. a subscription is the game+-- window size - a command would allow you to map the current window size into an action, whereas+-- a subscription would let you subscribe to when the window is resized and then map that event into+-- a game action.+--+-- Just like a subscription, any function that returns a command in the Helm library will+-- first let you map from the original contained value to a game action. It's important+-- to note that commands are **evaluated on the main-thread** - which means they can+-- block the rendering process. *Don't execute long-running monads under commands!*+--+-- Here the type variable e is an instance of the 'Engine' typeclass+-- and the variable a is the game action data type used by your game.+newtype Cmd e a = Cmd (StateT e IO [a])++-- | Represents the configuration for a Helm game.+--+-- The type variable e refers to an instance of the 'Engine' class,+-- m refers to a game model type and a refers to a game action type.+data GameConfig e m a = GameConfig {+  -- | Called when the game starts up. The first value in the tuple+  -- is the initial game model state and then the second value is an optional+  -- command to be run. The command allows you to execute some monads+  -- during game startup and build up some game actions before the game begins+  -- rendering. A good example would be loading a game configuration file,+  -- parsing the file contents and then mapping the parsed contents+  -- to relevant game actions.+  --+  -- If no initial command is required, simply pass 'Cmd.none'+  -- for the second tuple value. Alternatively, if there are a number of commands+  -- to run, call 'Cmd.batch' to combine them into one.+  initialFn :: (m, Cmd e a),++  -- | Called whenever a game action is mapped from a command or subscription.+  -- This is where the actual implementation of a Helm game is done.+  -- The function is given a game model and the mapped action type,+  -- and should produce the new game model state based off of the action.+  --+  -- The first tuple value is the new model state, and then the second+  -- is a command that can be run to produce more game actions.+  -- By having this command returnable here, you can run additional IO logic+  -- based off the game action, and produce more game actions from the result.+  --+  -- Be very careful with what commands you run in the game update function - most importantly,+  -- don't execute long-winding commands or it will block the rendering process!.+  -- Helm will try to intelligently queue recursive commands to prevent blocking rendering.+  -- However, having a game action that returns a specific command from the update function,+  -- which in turn is executed and returns that same game action (which will then in turn return the same command,+  -- and so on) is not recommend. The best way to return commands from the update function is to+  -- to hide them behind conditionals based off your game state, so that they're not run every update function.+  updateFn :: m -> a -> (m, Cmd e a),++  -- | The subscriptions for a game. All the input sources required+  -- to make the game work should be subscribed to and mapped to the relevant+  -- game action type variant.+  --+  -- If no subscriptions are required (i.e. no user input is required),+  -- pass 'Sub.none'. Alternatively, if multiple subscriptions are required+  -- use 'Sub.batch' to combine them.+  subscriptionsFn :: Sub e a,++  -- | Called when the engine is ready to render the game.+  -- The function is given the current state of the game model+  -- and should produce a graphics value to be rendered to the+  -- screen.+  --+  -- Do not rely on this function being called every game tick -+  -- the engine will figure out whether it needs to be called+  -- based off window exposure and whether or not the game model+  -- has changed since the last render.+  viewFn :: m -> Graphics e+}++-- | Represents a mouse button that can be pressed on a mouse.+data MouseButton+  = LeftButton+  | MiddleButton+  | RightButton+  | X1Button+  | X2Button+  | UnknownButton+  deriving (Eq, Ord, Read, Show)++-- | Represents a key that can be pressed on the keyboard.+data Key+  = ReturnKey+  | EscapeKey+  | BackspaceKey+  | TabKey+  | SpaceKey+  | ExclaimKey+  | QuoteDblKey+  | HashKey+  | PercentKey+  | DollarKey+  | AmpersandKey+  | QuoteKey+  | LeftParenKey+  | RightParenKey+  | AsteriskKey+  | PlusKey+  | CommaKey+  | MinusKey+  | PeriodKey+  | SlashKey+  | Number0Key+  | Number1Key+  | Number2Key+  | Number3Key+  | Number4Key+  | Number5Key+  | Number6Key+  | Number7Key+  | Number8Key+  | Number9Key+  | 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+  | CapsLockKey+  | F1Key+  | F2Key+  | F3Key+  | F4Key+  | F5Key+  | F6Key+  | F7Key+  | F8Key+  | F9Key+  | F10Key+  | F11Key+  | F12Key+  | PrintScreenKey+  | ScrollLockKey+  | PauseKey+  | InsertKey+  | HomeKey+  | PageUpKey+  | DeleteKey+  | EndKey+  | PageDownKey+  | RightKey+  | LeftKey+  | DownKey+  | UpKey+  | NumLockClearKey+  | KeypadDivideKey+  | KeypadMultiplyKey+  | KeypadMinusKey+  | KeypadPlusKey+  | KeypadEnterKey+  | KeypadNumber1Key+  | KeypadNumber2Key+  | KeypadNumber3Key+  | KeypadNumber4Key+  | KeypadNumber5Key+  | KeypadNumber6Key+  | KeypadNumber7Key+  | KeypadNumber8Key+  | KeypadNumber9Key+  | KeypadNumber0Key+  | KeypadPeriodKey+  | ApplicationKey+  | PowerKey+  | KeypadEqualsKey+  | F13Key+  | F14Key+  | F15Key+  | F16Key+  | F17Key+  | F18Key+  | F19Key+  | F20Key+  | F21Key+  | F22Key+  | F23Key+  | F24Key+  | ExecuteKey+  | HelpKey+  | MenuKey+  | SelectKey+  | StopKey+  | AgainKey+  | UndoKey+  | CutKey+  | CopyKey+  | PasteKey+  | FindKey+  | MuteKey+  | VolumeUpKey+  | VolumeDownKey+  | KeypadCommaKey+  | KeypadEqualsAS400Key+  | AltEraseKey+  | SysReqKey+  | CancelKey+  | ClearKey+  | PriorKey+  | Return2Key+  | SeparatorKey+  | OutKey+  | OperKey+  | ClearAgainKey+  | CrSelKey+  | ExSelKey+  | Keypad00Key+  | Keypad000Key+  | ThousandsSeparatorKey+  | DecimalSeparatorKey+  | CurrencyUnitKey+  | CurrencySubunitKey+  | KeypadLeftParenKey+  | KeypadRightParenKey+  | KeypadLeftBraceKey+  | KeypadRightBraceKey+  | KeypadTabKey+  | KeypadBackspaceKey+  | KeypadAKey+  | KeypadBKey+  | KeypadCKey+  | KeypadDKey+  | KeypadEKey+  | KeypadFKey+  | KeypadXorKey+  | KeypadPowerKey+  | KeypadPercentKey+  | KeypadLessKey+  | KeypadGreaterKey+  | KeypadAmpersandKey+  | KeypadDblAmpersandKey+  | KeypadVerticalBarKey+  | KeypadDblVerticalBarKey+  | KeypadColonKey+  | KeypadHashKey+  | KeypadSpaceKey+  | KeypadAtKey+  | KeypadExclamKey+  | KeypadMemStoreKey+  | KeypadMemRecallKey+  | KeypadMemClearKey+  | KeypadMemAddKey+  | KeypadMemSubtractKey+  | KeypadMemMultiplyKey+  | KeypadMemDivideKey+  | KeypadPlusMinusKey+  | KeypadClearKey+  | KeypadClearEntryKey+  | KeypadBinaryKey+  | KeypadOctalKey+  | KeypadDecimalKey+  | KeypadHexadecimalKey+  | LeftCtrlKey+  | LeftShiftKey+  | LeftAltKey+  | LeftGUIKey+  | RightCtrlKey+  | RightShiftKey+  | RightAltKey+  | RightGUIKey+  | ModeKey+  | AudioNextKey+  | AudioPrevKey+  | AudioStopKey+  | AudioPlayKey+  | AudioMuteKey+  | MediaSelectKey+  | WWWKey+  | MailKey+  | CalculatorKey+  | ComputerKey+  | ACSearchKey+  | ACHomeKey+  | ACBackKey+  | ACForwardKey+  | ACStopKey+  | ACRefreshKey+  | ACBookmarksKey+  | BrightnessDownKey+  | BrightnessUpKey+  | DisplaySwitchKey+  | KeyboardIllumToggleKey+  | KeyboardIllumDownKey+  | KeyboardIllumUpKey+  | EjectKey+  | SleepKey+  | UnknownKey+  deriving (Eq, Ord, Read, Show)
+ src/Helm/Engine/SDL.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE TypeFamilies #-}+-- | Contains the SDL engine implementation of Helm.+module Helm.Engine.SDL+  (+    -- * Types+    SDLEngine+  , SDLEngineConfig(..)+    -- * Startup+  , defaultConfig+  , startup+  , startupWith+    -- * Asset Loading+  , withImage+  ) where++import           Control.Monad (when)+import qualified Data.Text as T++import           FRP.Elerea.Param+import           Linear.Affine (Point(P))+import           Linear.Metric (distance)+import           Linear.V2 (V2(V2))++import qualified SDL+import qualified SDL.Event as Event+import qualified SDL.Init as Init+import           SDL.Input.Keyboard (Keysym(..))+import qualified SDL.Time as Time+import qualified SDL.Video as Video+import           SDL.Video (WindowConfig(..))+import qualified SDL.Video.Renderer as Renderer++import           Helm.Engine (Engine(..))+import           Helm.Engine.SDL.Asset (withImage)+import           Helm.Engine.SDL.Engine (SDLEngine(..), SDLEngineConfig(..))+import qualified Helm.Engine.SDL.Graphics2D as Graphics2D+import           Helm.Engine.SDL.Keyboard (mapKey)+import           Helm.Engine.SDL.Mouse (mapMouseButton)+import           Helm.Graphics (Graphics(..))+import           Helm.Graphics2D (Collage)++-- FIXME: Find a nice and easy way to have this instance with the SDLEngine type.+-- Can't avoid the orphan instance without dependency hell right now.+instance Engine SDLEngine where+  render engine (Graphics2D coll) = render2d engine coll+  cleanup SDLEngine { window, renderer, texture } = do+    Renderer.destroyTexture texture+    Video.destroyWindow window+    Video.destroyRenderer renderer+    Init.quit++  tick engine = do+    mayhaps <- Event.pumpEvents >> Event.pollEvent++    case mayhaps of+      -- Handle the quit event exclusively first to simplify our code+      Just Event.Event { eventPayload = Event.QuitEvent } ->+        return Nothing++      Just Event.Event { .. } ->+        sinkEvent engine eventPayload >>= tick++      Nothing -> return $ Just engine++  mouseMoveSignal = mouseMoveEventSignal+  mouseDownSignal = mouseDownEventSignal+  mouseUpSignal = mouseUpEventSignal+  mouseClickSignal = mouseClickEventSignal++  keyboardDownSignal = keyboardDownEventSignal+  keyboardUpSignal = keyboardUpEventSignal+  keyboardPressSignal = keyboardPressEventSignal++  windowResizeSignal = windowResizeEventSignal++  runningTime _ = fromIntegral <$> Time.ticks+  windowSize SDLEngine { window } = fmap (fmap fromIntegral) . SDL.get $ Video.windowSize window++-- | The default configuration for the engine. You should change the values where necessary.+defaultConfig :: SDLEngineConfig+defaultConfig = SDLEngineConfig+  { windowDimensions = V2 800 600+  , windowIsFullscreen = False+  , windowIsResizable = True+  , windowTitle = "Helm"+  }++-- | Initialize a new engine with default configuration. The engine can then be run later using 'run'.+startup :: IO SDLEngine+startup = startupWith defaultConfig++-- | Prepare a texture for streamed rendering based of a window size.+prepTexture :: V2 Int -> Video.Renderer -> IO Renderer.Texture+prepTexture dims renderer =+  Renderer.createTexture renderer mode access $ fromIntegral <$> dims++  where+    mode = Renderer.ARGB8888+    access = Renderer.TextureAccessStreaming++-- | Initialize a new engine with some configration, ready to be 'run'.+startupWith :: SDLEngineConfig -> IO SDLEngine+startupWith config@SDLEngineConfig { .. } = do+  Init.initializeAll++  window <- Video.createWindow (T.pack windowTitle) windowConfig+  renderer <- Video.createRenderer window (-1) rendererConfig+  texture <- prepTexture windowDimensions renderer++  mouseMoveEvent <- externalMulti+  mouseDownEvent <- externalMulti+  mouseUpEvent <- externalMulti+  mouseClickEvent <- externalMulti+  keyboardDownEvent <- externalMulti+  keyboardUpEvent <- externalMulti+  keyboardPressEvent <- externalMulti+  windowResizeEvent <- externalMulti++  Video.showWindow window++  return SDLEngine+    { window = window+    , renderer = renderer+    , texture = texture+    , engineConfig = config+    , lastMousePress = Nothing++    , mouseMoveEventSignal = fst mouseMoveEvent+    , mouseMoveEventSink = snd mouseMoveEvent+    , mouseDownEventSignal = fst mouseDownEvent+    , mouseDownEventSink = snd mouseDownEvent+    , mouseUpEventSignal = fst mouseUpEvent+    , mouseUpEventSink = snd mouseUpEvent+    , mouseClickEventSignal = fst mouseClickEvent+    , mouseClickEventSink = snd mouseClickEvent++    , keyboardDownEventSignal = fst keyboardDownEvent+    , keyboardDownEventSink = snd keyboardDownEvent+    , keyboardUpEventSignal = fst keyboardUpEvent+    , keyboardUpEventSink = snd keyboardUpEvent+    , keyboardPressEventSignal = fst keyboardPressEvent+    , keyboardPressEventSink = snd keyboardPressEvent++    , windowResizeEventSignal = fst windowResizeEvent+    , windowResizeEventSink = snd windowResizeEvent+    }+  where+    rendererConfig = Video.RendererConfig Video.AcceleratedVSyncRenderer False+    windowConfig = Video.defaultWindow+      { windowInitialSize = fromIntegral <$> windowDimensions+      , windowMode = if windowIsFullscreen+                     then Video.Fullscreen+                     else Video.Windowed+      , windowResizable = windowIsResizable+      }++-- | Renders a 2D element to the engine screen.+render2d :: SDLEngine -> Collage SDLEngine -> IO ()+render2d SDLEngine { window, renderer, texture } element = do+  dims <- SDL.get $ Video.windowSize window++  Graphics2D.render texture dims element+  Renderer.clear renderer+  Renderer.copy renderer texture Nothing Nothing+  Renderer.present renderer++-- | Turns a point containing a vector into a regular vector.+depoint :: Point f a -> f a+depoint (P x) = x++-- | Sink an SDL event into the Elerea sinks initialized at startup of the SDL engine.+-- These sinks then provide the data for the Elerea signals, which will be in+-- turn will provide the Helm subscriptions with events.+sinkEvent :: SDLEngine -> Event.EventPayload -> IO SDLEngine+sinkEvent engine (Event.WindowResizedEvent Event.WindowResizedEventData { .. }) = do+  windowResizeEventSink engine dims+  Renderer.destroyTexture texture++  resized <- prepTexture dims renderer++  return engine { texture = resized }++  where+    dims = fromIntegral <$> windowResizedEventSize+    SDLEngine { texture, renderer } = engine++sinkEvent engine (Event.MouseMotionEvent Event.MouseMotionEventData { .. }) = do+  mouseMoveEventSink engine $ fromIntegral <$> depoint mouseMotionEventPos++  return engine++sinkEvent engine (Event.KeyboardEvent Event.KeyboardEventData { .. }) =+  case keyboardEventKeyMotion of+    Event.Pressed -> do+      keyboardDownEventSink engine key++      if keyboardEventRepeat+      then keyboardPressEventSink engine key >> return engine+      else return engine++    Event.Released -> do+      keyboardUpEventSink engine key+      keyboardPressEventSink engine key++      return engine++  where+    Keysym { .. } = keyboardEventKeysym+    key = mapKey keysymKeycode++sinkEvent engine (Event.MouseButtonEvent Event.MouseButtonEventData { .. }) =+  case mouseButtonEventMotion of+    Event.Pressed -> do+      ticks <- Time.ticks+      mouseDownEventSink engine tup++      return engine { lastMousePress = Just (ticks, dubPos) }++    Event.Released -> do+      mouseUpEventSink engine tup++      -- Weirdly enough, SDL provides a value that says how many clicks there+      -- were, but this value is always set to one even if it's just a regular+      -- mouse up event. Note that here we're defining a click as a mouse up+      -- event being in a very close proximity to a previous mouse down event.+      -- We manually calculate whether this was a click or not.+      case lastMousePress of+        Just (lastTicks, lastPos) -> do+          ticks <- Time.ticks++          -- Check that it's a expected amount of time for a click and that the mouse+          -- has basically stayed in place+          when (distance dubPos lastPos <= clickRadius && ticks - lastTicks < clickMs)+               (mouseClickEventSink engine tup)++        Nothing -> return ()++      return engine++  where+    SDLEngine { lastMousePress } = engine+    clickMs = 500    -- How long between mouse down/up to recognise clicks+    clickRadius = 3  -- The pixel radius to be considered a click.+    pos = depoint mouseButtonEventPos+    dubPos = fromIntegral <$> pos+    tup = (mapMouseButton mouseButtonEventButton, fromIntegral <$> pos)++sinkEvent engine _ = return engine
+ src/Helm/Engine/SDL/Asset.hs view
@@ -0,0 +1,41 @@+-- | Contains the SDL asset types.+module Helm.Engine.SDL.Asset+  (+    -- * Types+    Image(..)+    -- * Loading+  , withImage+  ) where++import qualified Graphics.Rendering.Cairo as Cairo+import           Linear.V2 (V2(..))++import           Helm.Asset (Image)+import           Helm.Engine.SDL.Engine (SDLEngine)++-- | Represents an 'Image' for the SDL engine.+data instance Image SDLEngine = SDLImage+  { cairoSurface :: Cairo.Surface -- ^ The Cairo surface for the image.+  , imageDims    :: V2 Int        -- ^ The image dimensions of the image (when it was loaded).+  }++-- | Load an  image asset using the SDL engine and do+-- something with it. The image will be cleaned up+-- once the provided monad completes.+--+-- Currently, the only supported image file format is PNG.+--+-- The expected usage would be to use 'withImage'+-- for each image you need to load before+-- running the engine, and then use the images with+-- graphics. Once the engine stops running, the image+-- will then be automatically cleaned up.+withImage :: SDLEngine -> FilePath -> (Image SDLEngine -> IO a) -> IO a+withImage _ path f = Cairo.withImageSurfaceFromPNG path $ \surface -> do+  width  <- Cairo.imageSurfaceGetWidth surface+  height <- Cairo.imageSurfaceGetHeight surface++  f SDLImage+    { cairoSurface = surface+    , imageDims    = V2 width height+    }
+ src/Helm/Engine/SDL/Engine.hs view
@@ -0,0 +1,53 @@+-- | Contains the SDL engine types.+module Helm.Engine.SDL.Engine+  (+    -- * Types+    SDLEngine(..)+  , SDLEngineConfig(..)+  ) where++import           Data.Word (Word32)++import           FRP.Elerea.Param (Signal, SignalGen)+import           Linear.V2 (V2)+import qualified SDL.Video as Video+import qualified SDL.Video.Renderer as Renderer++import           Helm.Engine (MouseButton, Key)++-- | Represents the configuration to run the SDL engine with.+-- Use 'defaultConfig' and then only change the necessary fields.+data SDLEngineConfig = SDLEngineConfig+  { windowDimensions :: V2 Int+  , windowIsFullscreen :: !Bool+  , windowIsResizable :: !Bool+  , windowTitle :: !String+  }++-- | Represents the SDL engine's internal state.+data SDLEngine = SDLEngine+  { window :: Video.Window+  , renderer :: Video.Renderer+  , texture :: !Renderer.Texture+  , engineConfig :: SDLEngineConfig+  , lastMousePress :: Maybe (Word32, V2 Double)++  , mouseMoveEventSignal :: SignalGen SDLEngine (Signal [V2 Int])+  , mouseMoveEventSink :: V2 Int -> IO ()+  , mouseDownEventSignal :: SignalGen SDLEngine (Signal [(MouseButton, V2 Int)])+  , mouseDownEventSink :: (MouseButton, V2 Int) -> IO ()+  , mouseUpEventSignal :: SignalGen SDLEngine (Signal [(MouseButton, V2 Int)])+  , mouseUpEventSink :: (MouseButton, V2 Int) -> IO ()+  , mouseClickEventSignal :: SignalGen SDLEngine (Signal [(MouseButton, V2 Int)])+  , mouseClickEventSink :: (MouseButton, V2 Int) -> IO ()++  , keyboardDownEventSignal :: SignalGen SDLEngine (Signal [Key])+  , keyboardDownEventSink :: Key -> IO ()+  , keyboardUpEventSignal :: SignalGen SDLEngine (Signal [Key])+  , keyboardUpEventSink :: Key -> IO ()+  , keyboardPressEventSignal :: SignalGen SDLEngine (Signal [Key])+  , keyboardPressEventSink :: Key -> IO ()++  , windowResizeEventSignal :: SignalGen SDLEngine (Signal [V2 Int])+  , windowResizeEventSink :: V2 Int -> IO ()+  }
+ src/Helm/Engine/SDL/Graphics2D.hs view
@@ -0,0 +1,214 @@+-- | Contains the SDL implementation 2D graphics rendering implementation.+--+-- The SDL engine uses Cairo for its 2D vector graphics, which is hardware accelerated+-- and generally pretty fast.+module Helm.Engine.SDL.Graphics2D (render) where++import           Data.Foldable (forM_)+import           Foreign.C.Types (CInt)+import           Foreign.Ptr (castPtr)++import qualified Data.Text as T+import qualified Graphics.Rendering.Cairo as Cairo+import qualified Graphics.Rendering.Pango as Pango+import           Graphics.Rendering.Cairo.Matrix (Matrix(..))+import           Linear.V2 (V2(V2))+import           Linear.V3 (V3(V3))+import qualified SDL.Video.Renderer as Renderer++import           Helm.Color (Color(..), Gradient(..))+import           Helm.Engine.SDL.Asset (Image(..))+import           Helm.Engine.SDL.Engine (SDLEngine)+import           Helm.Graphics2D+import           Helm.Graphics2D.Text++-- | Render a 2D element to an SDL texture (with a width and height).+render :: Renderer.Texture -> V2 CInt -> Collage SDLEngine -> IO ()+render tex (V2 w h) coll = do+  (pixels, pitch) <- Renderer.lockTexture tex Nothing++  Cairo.withImageSurfaceForData (castPtr pixels) Cairo.FormatARGB32 (fromIntegral w) (fromIntegral h) (fromIntegral pitch) $ \surface ->+    Cairo.renderWith surface $ do+      Cairo.setSourceRGB 0 0 0+      Cairo.rectangle 0 0 (fromIntegral w) (fromIntegral h)+      Cairo.fill++      renderCollage coll++  Renderer.unlockTexture tex++-- | Render a collage (a group of forms with context).+renderCollage :: Collage SDLEngine -> Cairo.Render ()+renderCollage Collage { .. } = do+  Cairo.save++  forM_ collageDims $ \(V2 w h) -> do+    Cairo.rectangle 0 0 w h+    Cairo.clip++  forM_ collageCenter $ \(V2 x y) -> Cairo.translate x y+  mapM_ renderForm collageForms++  Cairo.restore++-- | Map a 'FontWeight' to a Pango font weight.+mapFontWeight :: FontWeight -> Pango.Weight+mapFontWeight weight = case weight of+  LightWeight  -> Pango.WeightLight+  NormalWeight -> Pango.WeightNormal+  BoldWeight   -> Pango.WeightBold++-- | Map a 'FontStyle' variant to a Pango font style.+mapFontStyle :: FontStyle -> Pango.FontStyle+mapFontStyle style = case style of+  NormalStyle  -> Pango.StyleNormal+  ObliqueStyle -> Pango.StyleOblique+  ItalicStyle  -> Pango.StyleItalic++-- | Setup a transformation state, render something with it, and then restore the old state.+withTransform+  :: Double           -- ^ The x and y scale factor of the state.+  -> Double           -- ^ The theta rotation of the state, in radians.+  -> Double           -- ^ The x translation value for the state.+  -> Double           -- ^ The y translation value for the state.+  -> Cairo.Render ()  -- ^ The render monad to run with the transformation state.+  -> Cairo.Render ()  -- ^ The final render monad.+withTransform s t x y f = do+  Cairo.save+  Cairo.scale s s+  Cairo.translate x y+  Cairo.rotate t+  f+  Cairo.restore++-- | Set the Cairo line cap from a 'LineCap'.+setLineCap :: LineCap -> Cairo.Render ()+setLineCap cap = case cap of+  FlatCap   -> Cairo.setLineCap Cairo.LineCapButt+  RoundCap  -> Cairo.setLineCap Cairo.LineCapRound+  PaddedCap -> Cairo.setLineCap Cairo.LineCapSquare++-- | Set the Cairo line join from a 'LineJoin'.+setLineJoin :: LineJoin -> Cairo.Render ()+setLineJoin join = case join of+  SmoothJoin    -> Cairo.setLineJoin Cairo.LineJoinRound+  ClippedJoin   -> Cairo.setLineJoin Cairo.LineJoinBevel+  SharpJoin lim -> do Cairo.setLineJoin Cairo.LineJoinMiter+                      Cairo.setMiterLimit lim++-- | Set up all the necessary settings with Cairo+-- to render with a line style (and then stroke the line). 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++-- | Set up all the necessary settings with Cairo+-- to render with a fill style (and then fill the line). Assumes+-- that all drawing paths have already been setup before being called.+setFillStyle :: FillStyle SDLEngine -> Cairo.Render ()+setFillStyle (Solid (Color r g b a)) = do+  Cairo.setSourceRGBA r g b a+  Cairo.fill++setFillStyle (Texture SDLImage { cairoSurface }) = do+  Cairo.setSourceSurface cairoSurface 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 $ \ptn ->+    setGradientFill ptn points++setFillStyle (Gradient (Radial (sx, sy) sr (ex, ey) er points)) =+  Cairo.withRadialPattern sx sy sr ex ey er $ \ptn ->+    setGradientFill ptn points++-- | Add color stops to a pattern and then fill it.+setGradientFill :: Cairo.Pattern -> [(Double, Color)] -> Cairo.Render ()+setGradientFill ptn points = do+  Cairo.setSource ptn+  mapM_ (\(o, Color r g b a) -> Cairo.patternAddColorStopRGBA ptn o r g b a) points+  Cairo.fill++-- | Render a form.+renderForm :: Form SDLEngine -> Cairo.Render ()+renderForm Form { formPos = V2 x y, .. } = withTransform formScale formTheta x y $ do+  Cairo.save++  case formStyle of+    PathForm style (Path (~ps @ (V2 hx hy : _))) -> do+      Cairo.newPath+      Cairo.moveTo hx hy+      mapM_ (\(V2 lx ly) -> Cairo.lineTo lx ly) ps+      setLineStyle style++    ShapeForm style shape -> do+      Cairo.newPath++      case shape of+        PolygonShape (Path (~ps @ (V2 hx hy : _))) -> do+          Cairo.moveTo hx hy+          mapM_ (\(V2 lx ly) -> Cairo.lineTo lx ly) ps++        RectangleShape (V2 w h) ->+          Cairo.rectangle (-w / 2) (-h / 2) w h++        ArcShape (V2 cx cy) a1 a2 r (V2 sx sy) -> do+          Cairo.scale sx sy+          Cairo.arc cx cy r a1 a2++      case style of+        OutlinedShape ls -> setLineStyle ls+        FilledShape fs -> setFillStyle fs++    TextForm Text { textColor = Color r g b a, .. } -> do+      layout <- Pango.createLayout textString++      Cairo.liftIO $ Pango.layoutSetAttributes layout+        [ Pango.AttrFamily { paStart = i, paEnd = j, paFamily = T.pack textTypeface }+        , Pango.AttrWeight { paStart = i, paEnd = j, paWeight = mapFontWeight textWeight }+        , Pango.AttrStyle  { paStart = i, paEnd = j, paStyle = mapFontStyle textStyle }+        , Pango.AttrSize   { paStart = i, paEnd = j, paSize = textHeight }+        ]++      Pango.PangoRectangle tx ty w h <- fmap snd $ Cairo.liftIO $ Pango.layoutGetExtents layout++      Cairo.translate ((-w / 2) - tx) ((-h / 2) - ty)+      Cairo.setSourceRGBA r g b a+      Pango.showLayout layout++      where+        i = 0+        j = length textString++    ImageForm SDLImage { imageDims = V2 w h, .. } (V2 sx sy) (V2 sw sh) stretch -> do+      Cairo.translate (-sx) (-sy)++      if stretch then+        Cairo.scale (sw / fromIntegral w)+                    (sh / fromIntegral h)+      else+        Cairo.scale 1 1++      Cairo.setSourceSurface cairoSurface 0 0+      Cairo.translate sx sy+      Cairo.rectangle 0 0 sw sh++      if stretch then+        Cairo.paint+      else+        Cairo.fill++    GroupForm (Transform (V3 (V3 a b lx) (V3 c d ly) _)) forms -> do+      Cairo.transform $ Matrix a b c d lx ly+      mapM_ renderForm forms++    CollageForm coll -> renderCollage coll++  Cairo.restore
+ src/Helm/Engine/SDL/Keyboard.hs view
@@ -0,0 +1,245 @@+-- | Contains the SDL keyboard mappings.+module Helm.Engine.SDL.Keyboard (mapKey) where++import qualified SDL.Input.Keyboard.Codes as Codes++import           Helm.Engine (Key(..))++-- | Map an SDL keycode to a Helm key.+mapKey :: Codes.Keycode -> Key+mapKey Codes.KeycodeReturn = ReturnKey+mapKey Codes.KeycodeEscape = EscapeKey+mapKey Codes.KeycodeBackspace = BackspaceKey+mapKey Codes.KeycodeTab = TabKey+mapKey Codes.KeycodeSpace = SpaceKey+mapKey Codes.KeycodeExclaim = ExclaimKey+mapKey Codes.KeycodeQuoteDbl = QuoteDblKey+mapKey Codes.KeycodeHash = HashKey+mapKey Codes.KeycodePercent = PercentKey+mapKey Codes.KeycodeDollar = DollarKey+mapKey Codes.KeycodeAmpersand = AmpersandKey+mapKey Codes.KeycodeQuote = QuoteKey+mapKey Codes.KeycodeLeftParen = LeftParenKey+mapKey Codes.KeycodeRightParen = RightParenKey+mapKey Codes.KeycodeAsterisk = AsteriskKey+mapKey Codes.KeycodePlus = PlusKey+mapKey Codes.KeycodeComma = CommaKey+mapKey Codes.KeycodeMinus = MinusKey+mapKey Codes.KeycodePeriod = PeriodKey+mapKey Codes.KeycodeSlash = SlashKey+mapKey Codes.Keycode0 = Number0Key+mapKey Codes.Keycode1 = Number1Key+mapKey Codes.Keycode2 = Number2Key+mapKey Codes.Keycode3 = Number3Key+mapKey Codes.Keycode4 = Number4Key+mapKey Codes.Keycode5 = Number5Key+mapKey Codes.Keycode6 = Number6Key+mapKey Codes.Keycode7 = Number7Key+mapKey Codes.Keycode8 = Number8Key+mapKey Codes.Keycode9 = Number9Key+mapKey Codes.KeycodeColon = ColonKey+mapKey Codes.KeycodeSemicolon = SemicolonKey+mapKey Codes.KeycodeLess = LessKey+mapKey Codes.KeycodeEquals = EqualsKey+mapKey Codes.KeycodeGreater = GreaterKey+mapKey Codes.KeycodeQuestion = QuestionKey+mapKey Codes.KeycodeAt = AtKey+mapKey Codes.KeycodeLeftBracket = LeftKey+mapKey Codes.KeycodeBackslash = BackslashKey+mapKey Codes.KeycodeRightBracket = RightBracketKey+mapKey Codes.KeycodeCaret = CaretKey+mapKey Codes.KeycodeUnderscore = UnderscoreKey+mapKey Codes.KeycodeBackquote = BackquoteKey+mapKey Codes.KeycodeA = AKey+mapKey Codes.KeycodeB = BKey+mapKey Codes.KeycodeC = CKey+mapKey Codes.KeycodeD = DKey+mapKey Codes.KeycodeE = EKey+mapKey Codes.KeycodeF = FKey+mapKey Codes.KeycodeG = GKey+mapKey Codes.KeycodeH = HKey+mapKey Codes.KeycodeI = IKey+mapKey Codes.KeycodeJ = JKey+mapKey Codes.KeycodeK = KKey+mapKey Codes.KeycodeL = LKey+mapKey Codes.KeycodeM = MKey+mapKey Codes.KeycodeN = NKey+mapKey Codes.KeycodeO = OKey+mapKey Codes.KeycodeP = PKey+mapKey Codes.KeycodeQ = QKey+mapKey Codes.KeycodeR = RKey+mapKey Codes.KeycodeS = SKey+mapKey Codes.KeycodeT = TKey+mapKey Codes.KeycodeU = UKey+mapKey Codes.KeycodeV = VKey+mapKey Codes.KeycodeW = WKey+mapKey Codes.KeycodeX = XKey+mapKey Codes.KeycodeY = YKey+mapKey Codes.KeycodeZ = ZKey+mapKey Codes.KeycodeCapsLock = CapsLockKey+mapKey Codes.KeycodeF1 = F1Key+mapKey Codes.KeycodeF2 = F2Key+mapKey Codes.KeycodeF3 = F3Key+mapKey Codes.KeycodeF4 = F4Key+mapKey Codes.KeycodeF5 = F5Key+mapKey Codes.KeycodeF6 = F6Key+mapKey Codes.KeycodeF7 = F7Key+mapKey Codes.KeycodeF8 = F8Key+mapKey Codes.KeycodeF9 = F9Key+mapKey Codes.KeycodeF10 = F10Key+mapKey Codes.KeycodeF11 = F11Key+mapKey Codes.KeycodeF12 = F12Key+mapKey Codes.KeycodePrintScreen = PrintScreenKey+mapKey Codes.KeycodeScrollLock = ScrollLockKey+mapKey Codes.KeycodePause = PauseKey+mapKey Codes.KeycodeInsert = InsertKey+mapKey Codes.KeycodeHome = HomeKey+mapKey Codes.KeycodePageUp = PageUpKey+mapKey Codes.KeycodeDelete = DeleteKey+mapKey Codes.KeycodeEnd = EndKey+mapKey Codes.KeycodePageDown = PageDownKey+mapKey Codes.KeycodeRight = RightKey+mapKey Codes.KeycodeLeft = LeftKey+mapKey Codes.KeycodeDown = DownKey+mapKey Codes.KeycodeUp = UpKey+mapKey Codes.KeycodeNumLockClear = NumLockClearKey+mapKey Codes.KeycodeKPDivide = KeypadDivideKey+mapKey Codes.KeycodeKPMultiply = KeypadMultiplyKey+mapKey Codes.KeycodeKPMinus = KeypadMinusKey+mapKey Codes.KeycodeKPPlus = KeypadPlusKey+mapKey Codes.KeycodeKPEnter = KeypadEnterKey+mapKey Codes.KeycodeKP1 = KeypadNumber1Key+mapKey Codes.KeycodeKP2 = KeypadNumber2Key+mapKey Codes.KeycodeKP3 = KeypadNumber3Key+mapKey Codes.KeycodeKP4 = KeypadNumber4Key+mapKey Codes.KeycodeKP5 = KeypadNumber5Key+mapKey Codes.KeycodeKP6 = KeypadNumber6Key+mapKey Codes.KeycodeKP7 = KeypadNumber7Key+mapKey Codes.KeycodeKP8 = KeypadNumber8Key+mapKey Codes.KeycodeKP9 = KeypadNumber9Key+mapKey Codes.KeycodeKP0 = KeypadNumber0Key+mapKey Codes.KeycodeKPPeriod = KeypadPeriodKey+mapKey Codes.KeycodeApplication = ApplicationKey+mapKey Codes.KeycodePower = PowerKey+mapKey Codes.KeycodeKPEquals = KeypadEqualsKey+mapKey Codes.KeycodeF13 = F13Key+mapKey Codes.KeycodeF14 = F14Key+mapKey Codes.KeycodeF15 = F15Key+mapKey Codes.KeycodeF16 = F16Key+mapKey Codes.KeycodeF17 = F17Key+mapKey Codes.KeycodeF18 = F18Key+mapKey Codes.KeycodeF19 = F19Key+mapKey Codes.KeycodeF20 = F20Key+mapKey Codes.KeycodeF21 = F21Key+mapKey Codes.KeycodeF22 = F22Key+mapKey Codes.KeycodeF23 = F23Key+mapKey Codes.KeycodeF24 = F24Key+mapKey Codes.KeycodeExecute = ExecuteKey+mapKey Codes.KeycodeHelp = HelpKey+mapKey Codes.KeycodeMenu = MenuKey+mapKey Codes.KeycodeSelect = SelectKey+mapKey Codes.KeycodeStop = StopKey+mapKey Codes.KeycodeAgain = AgainKey+mapKey Codes.KeycodeUndo = UndoKey+mapKey Codes.KeycodeCut = CutKey+mapKey Codes.KeycodeCopy = CopyKey+mapKey Codes.KeycodePaste = PasteKey+mapKey Codes.KeycodeFind = FindKey+mapKey Codes.KeycodeMute = MuteKey+mapKey Codes.KeycodeVolumeUp = VolumeUpKey+mapKey Codes.KeycodeVolumeDown = VolumeDownKey+mapKey Codes.KeycodeKPComma = KeypadCommaKey+mapKey Codes.KeycodeKPEqualsAS400 = KeypadEqualsAS400Key+mapKey Codes.KeycodeAltErase = AltEraseKey+mapKey Codes.KeycodeSysReq = SysReqKey+mapKey Codes.KeycodeCancel = CancelKey+mapKey Codes.KeycodeClear = ClearKey+mapKey Codes.KeycodePrior = PriorKey+mapKey Codes.KeycodeReturn2 = Return2Key+mapKey Codes.KeycodeSeparator = SeparatorKey+mapKey Codes.KeycodeOut = OutKey+mapKey Codes.KeycodeOper = OperKey+mapKey Codes.KeycodeClearAgain = ClearAgainKey+mapKey Codes.KeycodeCrSel = CrSelKey+mapKey Codes.KeycodeExSel = ExSelKey+mapKey Codes.KeycodeKP00 = Keypad00Key+mapKey Codes.KeycodeKP000 = Keypad000Key+mapKey Codes.KeycodeThousandsSeparator = ThousandsSeparatorKey+mapKey Codes.KeycodeDecimalSeparator = DecimalSeparatorKey+mapKey Codes.KeycodeCurrencyUnit = CurrencyUnitKey+mapKey Codes.KeycodeCurrencySubunit = CurrencySubunitKey+mapKey Codes.KeycodeKPLeftParen = KeypadLeftParenKey+mapKey Codes.KeycodeKPRightParen = KeypadRightParenKey+mapKey Codes.KeycodeKPLeftBrace = KeypadLeftBraceKey+mapKey Codes.KeycodeKPRightBrace = KeypadRightBraceKey+mapKey Codes.KeycodeKPTab = KeypadTabKey+mapKey Codes.KeycodeKPBackspace = KeypadBackspaceKey+mapKey Codes.KeycodeKPA = KeypadAKey+mapKey Codes.KeycodeKPB = KeypadBKey+mapKey Codes.KeycodeKPC = KeypadCKey+mapKey Codes.KeycodeKPD = KeypadDKey+mapKey Codes.KeycodeKPE = KeypadEKey+mapKey Codes.KeycodeKPF = KeypadFKey+mapKey Codes.KeycodeKPXor = KeypadXorKey+mapKey Codes.KeycodeKPPower = KeypadPowerKey+mapKey Codes.KeycodeKPPercent = KeypadPercentKey+mapKey Codes.KeycodeKPLess = KeypadLessKey+mapKey Codes.KeycodeKPGreater = KeypadGreaterKey+mapKey Codes.KeycodeKPAmpersand = KeypadAmpersandKey+mapKey Codes.KeycodeKPDblAmpersand = KeypadDblAmpersandKey+mapKey Codes.KeycodeKPVerticalBar = KeypadVerticalBarKey+mapKey Codes.KeycodeKPDblVerticalBar = KeypadDblVerticalBarKey+mapKey Codes.KeycodeKPColon = KeypadColonKey+mapKey Codes.KeycodeKPHash = KeypadHashKey+mapKey Codes.KeycodeKPSpace = KeypadSpaceKey+mapKey Codes.KeycodeKPAt = KeypadAtKey+mapKey Codes.KeycodeKPExclam = KeypadExclamKey+mapKey Codes.KeycodeKPMemStore = KeypadMemStoreKey+mapKey Codes.KeycodeKPMemRecall = KeypadMemRecallKey+mapKey Codes.KeycodeKPMemClear = KeypadMemClearKey+mapKey Codes.KeycodeKPMemAdd = KeypadMemAddKey+mapKey Codes.KeycodeKPMemSubtract = KeypadMemSubtractKey+mapKey Codes.KeycodeKPMemMultiply = KeypadMemMultiplyKey+mapKey Codes.KeycodeKPMemDivide = KeypadMemDivideKey+mapKey Codes.KeycodeKPPlusMinus = KeypadPlusMinusKey+mapKey Codes.KeycodeKPClear = KeypadClearKey+mapKey Codes.KeycodeKPClearEntry = KeypadClearEntryKey+mapKey Codes.KeycodeKPBinary = KeypadBinaryKey+mapKey Codes.KeycodeKPOctal = KeypadOctalKey+mapKey Codes.KeycodeKPDecimal = KeypadDecimalKey+mapKey Codes.KeycodeKPHexadecimal = KeypadHexadecimalKey+mapKey Codes.KeycodeLCtrl = LeftCtrlKey+mapKey Codes.KeycodeLShift = LeftShiftKey+mapKey Codes.KeycodeLAlt = LeftAltKey+mapKey Codes.KeycodeLGUI = LeftGUIKey+mapKey Codes.KeycodeRCtrl = RightCtrlKey+mapKey Codes.KeycodeRShift = RightShiftKey+mapKey Codes.KeycodeRAlt = RightAltKey+mapKey Codes.KeycodeRGUI = RightGUIKey+mapKey Codes.KeycodeMode = ModeKey+mapKey Codes.KeycodeAudioNext = AudioNextKey+mapKey Codes.KeycodeAudioPrev = AudioPrevKey+mapKey Codes.KeycodeAudioStop = AudioStopKey+mapKey Codes.KeycodeAudioPlay = AudioPlayKey+mapKey Codes.KeycodeAudioMute = AudioMuteKey+mapKey Codes.KeycodeMediaSelect = MediaSelectKey+mapKey Codes.KeycodeWWW = WWWKey+mapKey Codes.KeycodeMail = MailKey+mapKey Codes.KeycodeCalculator = CalculatorKey+mapKey Codes.KeycodeComputer = ComputerKey+mapKey Codes.KeycodeACSearch = ACSearchKey+mapKey Codes.KeycodeACHome = ACHomeKey+mapKey Codes.KeycodeACBack = ACBackKey+mapKey Codes.KeycodeACForward = ACForwardKey+mapKey Codes.KeycodeACStop = ACStopKey+mapKey Codes.KeycodeACRefresh = ACRefreshKey+mapKey Codes.KeycodeACBookmarks = ACBookmarksKey+mapKey Codes.KeycodeBrightnessDown = BrightnessDownKey+mapKey Codes.KeycodeBrightnessUp = BrightnessUpKey+mapKey Codes.KeycodeDisplaySwitch = DisplaySwitchKey+mapKey Codes.KeycodeKbdIllumToggle = KeyboardIllumToggleKey+mapKey Codes.KeycodeKbdIllumDown = KeyboardIllumDownKey+mapKey Codes.KeycodeKbdIllumUp = KeyboardIllumUpKey+mapKey Codes.KeycodeEject = EjectKey+mapKey Codes.KeycodeSleep = SleepKey+mapKey _ = UnknownKey
+ src/Helm/Engine/SDL/Mouse.hs view
@@ -0,0 +1,15 @@+-- | Contains the SDL mouse button mappings.+module Helm.Engine.SDL.Mouse (mapMouseButton) where++import qualified SDL.Event as Event++import           Helm.Engine (MouseButton(..))++-- | Map an SDL mouse button to a Helm mouse button.+mapMouseButton :: Event.MouseButton -> MouseButton+mapMouseButton Event.ButtonLeft = LeftButton+mapMouseButton Event.ButtonMiddle = MiddleButton+mapMouseButton Event.ButtonRight = RightButton+mapMouseButton Event.ButtonX1 = X1Button+mapMouseButton Event.ButtonX2 = X2Button+mapMouseButton _ = UnknownButton
+ src/Helm/Graphics.hs view
@@ -0,0 +1,14 @@+-- | Contains the graphics type.+module Helm.Graphics+  (+    -- * Types+    Graphics(..)+  ) where++import Helm.Graphics2D (Collage)++-- | Represents any form of structure that produces visual+-- graphics to the screen, e.g. 2D or 3D graphics.+--+-- The type variable e should refer to an 'Engine' instance.+data Graphics e = Graphics2D (Collage e)
+ src/Helm/Graphics2D.hs view
@@ -0,0 +1,375 @@+-- | Contains all the types and functions for composing+-- and rendering 2D graphics.+module Helm.Graphics2D+  (+    -- * Types+    Collage(..)+  , Form(..)+  , FormStyle(..)+  , FillStyle(..)+  , LineCap(..)+  , LineJoin(..)+  , LineStyle(..)+  , Path(..)+  , Shape(..)+  , ShapeStyle(..)+  , Transform(..)+  , Text(..)+  -- * Collages+  , collage+  , clip+  , center+  , toForm+  -- * Styles & Forms+  , defaultLine+  , solid+  , dashed+  , dotted+  , filled+  , textured+  , gradient+  , outlined+  , traced+  , image+  , fittedImage+  , croppedImage+  , blank+  , alpha+  , text+  -- * Grouping+  , group+  , groupTransform+  -- * Transforming+  , rotate+  , scale+  , move+  -- * Paths+  , path+  -- * Shapes+  , polygon+  , rect+  , square+  , oval+  , circle+  , ngon+  ) where++import Linear.V2 (V2(V2))++import Helm.Asset (Image)+import Helm.Color (Color, rgb, Gradient)+import Helm.Graphics2D.Text (Text(..))+import Helm.Graphics2D.Transform (Transform(..), identity)++-- | Represents a collection of forms, which in turn are rendereable+-- shapes and lines. In Helm, the collage is the main structure+-- representing 2D graphics and is passed directly to the engine+-- to be rendered by your view function. It's best to think of a collage+-- as a fancy version of a game screen, with the difference being that the+-- collage itself knows nothing about the window state. It only knows+-- what will be rendered to the screen (which in this case, is a series of forms)+-- and the order in which they will be rendered.+data Collage e = Collage+  { collageDims :: Maybe (V2 Double)    -- ^ The optional dimensions of the collage. It will be clipped to these dims.+  , collageForms :: [Form e]            -- ^ The collection of forms under the collage.+  , collageCenter :: Maybe (V2 Double)  -- ^ The optional center of the collage.+  }++-- | Create a collage from a list of forms.+-- By default, the collage will not be clipped+-- and will not be centered. The origin point of the contained+-- forms will be the top-left of the collage (which in the case of rendering+-- a collage to the screen, is coincidently the top-left of the game window).+-- See 'center' and 'clip'.+collage :: [Form e] -> Collage e+collage forms = Collage+  { collageDims = Nothing+  , collageForms = forms+  , collageCenter = Nothing+  }++-- | Center a collage around a fixed point. This is useful to implement+-- 2D game cameras - usually, you have the center of the screen+-- at the position of the game camera (which in a 2D platformer,+-- is usually your game character). Note that this will center+-- the forms themselves, i.e. their original point will change from being+-- the top left of the collage to+center ::+     V2 Double  -- ^ The position to center the collage at.+  -> Collage e  -- ^ The source collage.+  -> Collage e  -- ^ The centered collage.+center pos col = col { collageCenter = Just pos }++-- | Clip a collage by provided dimensions. Note that by default,+-- a collage will not be clipped and anything beyond the window dimensions+-- will still technically be rendered (although obviously it will not appear+-- on the game screen). By composing a collage with this function,+-- when the collage is rendered its contents will be clipped by these dimensions.+-- Not only will this generally speed up performance, it can be used for certain+-- cases where you don't want the forms in the collage to spill over+-- to other collages near it (but that's a very rare use-case).+--+-- Something to note, that this is absolutely not an ensurance that your 2D graphics+-- will be rendered quickly if you're doing a lot of graphics work. The clip merely+-- prevents things being drawn outside the dimensions, which in most cases will+-- indeed speed up the performance, but it is down to the engine implementation for how much+-- this actually helps.+--+-- In that sense, it's up to the library user to make sure they're not rendering huge amounts+-- of forms that aren't even in the screen's bounds.+clip ::+     V2 Double  -- ^ The dimensions to clip the collage with.+  -> Collage e  -- ^ The source collage.+  -> Collage e  -- ^ The clipped collage.+clip dims col = col { collageDims = Just dims }++-- | Create a form from a collage. This might seem a little strange (as+-- a collage is generally what you provide to the engine to render the 2D graphics)+-- but by allowing this functionality, you can compose collages from other collages.+toForm :: Collage e -> Form e+toForm = defaultForm . CollageForm++-- | Represents the styles of forms available. The form style holds data specific+-- to a variation of form, and the 'Form' is instead a general version of this+-- with positioning information, rotation, scale, etc.+data FormStyle e+  = PathForm LineStyle Path                           -- ^ A form composed of a path+  | ShapeForm (ShapeStyle e) Shape                    -- ^ A form composed of a shape.+  | TextForm Text                                     -- ^ A form composed of a piece of text, including string and style info.+  | ImageForm (Image e) (V2 Double) (V2 Double) Bool  -- ^ A form composed of an image+  | GroupForm Transform [Form e]                      -- ^ A form composed of a group of forms, with a transformation.+  | CollageForm (Collage e)                           -- ^ A form composed of a collage (which in turn is a collection of forms).++-- | Represents something that can be rendered to the screen (+-- contained under a collage). There are many different types of forms, which can be composed+-- below but are generally represented by the 'FormStyle' type.+--+-- A form might be an image, or a rectangle, or a circle, or even a collection+-- of forms (which in turn can be those same things).+data Form e = Form+  { formTheta :: Double       -- ^ The rotation of the form (in radians).+  , formScale :: Double       -- ^ The scale factor of the form.+  , formPos :: V2 Double      -- ^ The position of the form. This will be rendered relative to the collage origin.+  , formAlpha :: Double       -- ^ The alpha channel of the form.+  , formStyle :: FormStyle e  -- ^ The style of form.+  }++-- | Represents the style of shape filling available.+data FillStyle e+  = Solid Color        -- ^ The shape will be filled with a solid color.+  | Texture (Image e)  -- ^ The shape will be filled with a texture (a.k.a. image).+  | Gradient Gradient  -- ^ The shape will be filled with a gradient (which can be linear or radial).++-- | Represents the shape of the ends of a line.+data LineCap+  = FlatCap+  | RoundCap+  | PaddedCap+    deriving (Show, Eq, Ord, Read)++-- | Represents the shape of the joints between line segments.+data LineJoin+  = SmoothJoin+  | SharpJoin Double+  | ClippedJoin+    deriving (Show, Eq, Ord, Read)++-- | Represents the style used for drawing lines. It's best+-- to use 'defaultLine' and then only change the fields+-- you need to.+data LineStyle = LineStyle+  { lineColor :: Color+  , lineWidth :: Double+  , lineCap :: LineCap+  , lineJoin :: LineJoin+  , lineDashing :: [Double]+  , lineDashOffset :: Double+  } deriving (Show, Eq)++-- | Represents a series of 2D points which will be drawn in sequence.+-- Like a 'Shape', a path on its own holds no styling information.+data Path = Path [V2 Double] deriving (Show, Eq, Ord, Read)++-- | Create a path from a sequence of points (represented as 2D vectors).+path :: [V2 Double] -> Path+path = Path++-- | Represents a collection of points that when drawn in order+-- will result in a closed polygon. They have no style information -+-- rather, you compose shapes into a form with fill or line style+-- and that affects their appearance.+--+-- Note that realistically, a shape could be represented as+-- a path only. However, we add extra variants here as drawing backends+-- usually provide optimized forms of drawing circles (and perhaps rectangles,+-- although that is less likely) hence it's better to fall to those+-- if our shape is circular.+data Shape+  = PolygonShape Path+  | RectangleShape (V2 Double)+  | ArcShape (V2 Double) Double Double Double (V2 Double)+    deriving (Show, Eq, Ord, Read)++-- | Create an arbitary-sided polygon from a path.+-- The points provided should refer to each corner of the -gon,+-- however the points do not need to loop around (i.e. the final point+-- will automatically connect to the first point).+polygon :: Path -> Shape+polygon = PolygonShape++-- | Create a rectangular shape from a 2D vector, with+-- x and y representing width and height, respectively.+rect :: V2 Double -> Shape+rect = RectangleShape++-- | Create a square shape with a side length.+square :: Double -> Shape+square n = rect (V2 n n)++-- | Create an oval shape with a width and height.+oval :: Double -> Double -> Shape+oval w h = ArcShape (V2 0 0) 0 (2 * pi) 1 (V2 (w / 2) (h / 2))++-- | Create a circle shape with a radius.+circle :: Double -> Shape+circle r = ArcShape (V2 0 0) 0 (2 * pi) r (V2 1 1)++-- | Create a generic n-sided polygon (e.g. octagon, pentagon, etc) with+-- a side count and radius.+ngon :: Int -> Double -> Shape+ngon n r = polygon $ path $ map point series+  where+    point i = V2 (r * cos (t * i)) (r * sin (t * i))+    series = [0 .. fromIntegral (n - 1)]+    m = fromIntegral n+    t = 2 * pi / m++-- | Create 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 = rgb 0 0 0+  , lineWidth = 1+  , lineCap = FlatCap+  , lineJoin = SharpJoin 10+  , lineDashing = []+  , lineDashOffset = 0+  }++-- | Create a initial form from a specific form style.+-- The form will be at the origin point (0, 0).+defaultForm :: FormStyle e -> Form e+defaultForm style = Form+  { formTheta = 0+  , formScale = 1+  , formPos = V2 0 0+  , formAlpha = 1+  , formStyle = style+  }++-- | Represents the style used for drawing a shape.+data ShapeStyle e+  = OutlinedShape LineStyle    -- ^ Stroke/outline the shape, with a specific line style.+  | FilledShape (FillStyle e)  -- ^ Fill the shape, with a specific fill style.++-- | 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] }++-- | Fill a shape with a specific fill style.+fill :: FillStyle e -> Shape -> Form e+fill style shape = defaultForm (ShapeForm (FilledShape style) shape)++-- | Fill a shape with a color.+filled :: Color -> Shape -> Form e+filled color = fill (Solid color)++-- | Fill a shape with a texture. The texture should+-- be an image loaded by the engine.+textured :: Image e -> Shape -> Form e+textured img = fill (Texture img)++-- | Fill a shape with a gradient (either 'linear' or 'radial').+gradient :: Gradient -> Shape -> Form e+gradient grad = fill (Gradient grad)++-- | Create a form from a shape by outlining it with a specific line style.+outlined :: LineStyle -> Shape -> Form e+outlined style shape = defaultForm (ShapeForm (OutlinedShape style) shape)++-- | Create a form from a path by tracing it with a specific line style.+traced :: LineStyle -> Path -> Form e+traced style p = defaultForm (PathForm style p)++-- | Create an empty form, useful for having forms rendered only at some state.+blank :: Form e+blank = group []++-- | Create a form from an image. If the image dimensions are not the+-- same as provided, then it will stretch/shrink to fit.+image :: V2 Double -> Image e -> Form e+image dims img = defaultForm $ ImageForm img (V2 0 0) dims True++-- | Create a form from an image with a 2D vector describing its dimensions.+-- 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 :: V2 Double -> Image e -> Form e+fittedImage dims img = defaultForm $ ImageForm img (V2 0 0) dims False++-- | Create a form 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 (+-- for example, drawing a single sprite from a sprite sheet).+croppedImage :: V2 Double -> V2 Double -> Image e -> Form e+croppedImage pos dims img = defaultForm $ ImageForm img pos dims False++-- | Group a list of forms into one. They will be drawn in their+-- sequential order within the list.+group :: [Form e] -> Form e+group forms = defaultForm (GroupForm identity forms)++-- | Group a list of forms into one, while also applying a matrix+-- transformation.+groupTransform :: Transform -> [Form e] -> Form e+groupTransform matrix forms = defaultForm (GroupForm matrix forms)++-- | Move a form by a given 2D vector. The movement is relative,+-- i.e. the translation vector provided will be added to the form's+-- current position.+move :: V2 Double -> Form e -> Form e+move trans form = form { formPos = formPos form + trans }++-- | Scale a form by a scalar factor. Scaling by 2 will double the size+-- of the form, and scaling by 0.5 will half the size. Note that like+-- 'move', the scale function is relative - i.e. if you scaled by 0.5+-- and then scaled by 0.5 a gain, the final scale would be 0.25 or+-- a quarter of the form's initial scale.+scale :: Double -> Form e -> Form e+scale factor form = form { formScale = factor * formScale form }++-- | Rotate a form by a given angle (in radians).+-- Like 'move' and 'scale', the rotation is relative.+rotate :: Double -> Form e -> Form e+rotate theta form = form { formTheta = formTheta form + theta }++-- | Change the alpha value of a form (i.e. its transparency).+-- By default, forms will have an alpha value of 1, in other words,+-- they are fully opaque. Alternatively, a value of 0 will mean the+-- form is completely hidden.+alpha :: Double -> Form e -> Form e+alpha x form = form { formAlpha = x }++-- | Create a form from a `Text` structure, which in turn+-- contains all of the text values and styling. This allows+-- you to render a the text graphically (and in turn it's a regular old+-- form, so it can be translated, rotated, etc.).+text :: Text -> Form e+text = defaultForm . TextForm
+ src/Helm/Graphics2D/Text.hs view
@@ -0,0 +1,97 @@+-- | Contains all the data structures and functions for composing+-- pieces of graphical text.+module Helm.Graphics2D.Text+  (+    -- * Types+    Text(..)+  , FontWeight(..)+  , FontStyle(..)+    -- * Composing+  , defaultText+  , toText+  , showText+    -- * Formatting+  , light+  , bold+  , italic+  , oblique+  , color+  , typeface+  , height+  ) where++import Helm.Color (Color(..), rgb)++-- | Represents the weight for a text's font.+data FontWeight+  = LightWeight+  | NormalWeight+  | BoldWeight+    deriving (Show, Eq, Ord, Enum, Read)++-- | Represents the style for a text's font.+data FontStyle+  = NormalStyle+  | ObliqueStyle+  | ItalicStyle+    deriving (Show, Eq, Ord, Enum, Read)++-- | Represents a graphical piece of text,+-- containing a UTF-8 string and any relevant style fields.+data Text = Text+  { textString :: String+  , textColor :: Color+  , textTypeface :: String+  , textHeight :: Double+  , textWeight :: FontWeight+  , textStyle :: FontStyle+  } deriving (Show, Eq)++-- | Create the default text. By default it is is black sans-serif+-- with a height of 14pt.+defaultText :: Text+defaultText = Text {+  textString = "",+  textColor = rgb 0 0 0,+  textTypeface = "sans-serif",+  textHeight = 14,+  textWeight = NormalWeight,+  textStyle = NormalStyle+}++-- | Create a text from a string. By default, this text will be 14pt,+-- black and unstyled.+toText :: String -> Text+toText str = defaultText { textString = str }++-- | Create a text from a type instancing 'Show'.+showText :: Show a => a -> Text+showText a = toText $ show a++-- | Set the weight of a text to bold.+bold :: Text -> Text+bold txt = txt { textWeight = BoldWeight }++-- | Set the weight of a piece of text to light.+light :: Text -> Text+light txt = txt { textWeight = LightWeight }++-- | Set the slant of a piece of text to italic.+italic :: Text -> Text+italic txt = txt { textStyle = ItalicStyle }++-- | Set the slant of a piece of text to oblique.+oblique :: Text -> Text+oblique txt = txt { textStyle = ObliqueStyle }++-- | Set the color of a piece of text.+color :: Color -> Text -> Text+color col txt = txt { textColor = col }++-- | Set the typeface of the text.+typeface :: String -> Text -> Text+typeface face txt = txt { textTypeface = face }++-- | Set the size of a piece of text.+height :: Double -> Text -> Text+height size txt = txt { textHeight = size }
+ src/Helm/Graphics2D/Transform.hs view
@@ -0,0 +1,85 @@+-- | Contains the 2D transform matrix type and functions for composing+-- transformation matricies.+module Helm.Graphics2D.Transform+  (+    -- * Types+    Transform(..)+    -- * Composing+  , identity+  , matrix+  , rotation+  , translation+  , scale+  , multiply+  ) where++import qualified Linear.Matrix as Matrix+import           Linear.V2 (V2(V2))+import           Linear.V3 (V3(V3))++-- | Represents a transformation matrix that can be used to transform+-- forms. This is more useful than just using the composing methods+-- in the graphics API, as it can perform skewing and other+-- complex transformation techniques.+data Transform = Transform (Matrix.M33 Double) deriving (Show, Eq, Ord, Read)++instance Num Transform where+  (*) (Transform a) (Transform b) = Transform $ a * b+  (+) (Transform a) (Transform b) = Transform $ a + b+  (-) (Transform a) (Transform b) = Transform $ a - b++  negate (Transform a) = Transform $ negate a+  abs (Transform a) = Transform $ abs a+  signum (Transform a) = Transform $ signum a+  fromInteger n = Transform $ V3 (V3 (fromInteger n) 0 0) (V3 (fromInteger n) 0 0) (V3 0 0 1)++-- | Construct an identity transformation matrix. Anything transformed by this matrix+-- will remain the same.+identity :: Transform+identity = Transform Matrix.identity++-- | Construct a transformation matrix with specific row/column values.+--+-- > matrix a b c d x y+--+-- / a b x \+-- \ c d y /+matrix :: Double -> Double -> Double -> Double -> Double -> Double -> Transform+matrix a b c d x y = Transform $ V3 (V3 a b x) (V3 c d y) (V3 0 0 1)++-- | Construct a counter-clockwise rotating transformation matrix.+--+-- > rotation t+--+-- / cos t  -sin t  0 \+-- \ sin t   cos t  0 /+rotation :: Double -> Transform+rotation t = Transform $ V3 (V3 c (-s) 0) (V3 s c 0) (V3 0 0 1)+  where+    s = sin t+    c = cos t++-- | Construct a translating transformation matrix.+--+-- > translation (V2 x y)+--+-- / 1 0 x \+-- \ 0 1 y /+translation :: V2 Double -> Transform+translation (V2 x y) = Transform $ V3 (V3 1 0 x) (V3 0 1 y) (V3 0 0 1)++-- | Construction a scaling transformation matrix. To scale in all directions,+-- simply have the x and y values the same. Alternatively,+-- to scale by only one direction, keep the excluded dimenion's+-- vector component as 1.+--+-- > scale (V2 x y)+--+-- / x 0 0 \+-- \ 0 y 0 /+scale :: V2 Double -> Transform+scale (V2 x y) = Transform $ V3 (V3 x 0 0) (V3 y 0 0) (V3 0 0 1)++-- | Multiply two transformatio nmatrices together..+multiply :: Transform -> Transform -> Transform+multiply (Transform a) (Transform b) = Transform $ a * b
+ src/Helm/Keyboard.hs view
@@ -0,0 +1,46 @@+-- | Contains subscriptions to events from the keyboard.+module Helm.Keyboard+  (+    -- * Types+    Key(..)+    -- * Subscriptions+  , presses+  , downs+  , ups+  ) where++import FRP.Elerea.Param (input, snapshot)++import Helm.Engine (Engine(..), Sub(..), Key(..))++-- | Subscribe to keyboard press events and map to a game action.+-- A key press event is produced whenever a key is either released+-- or continously held down.+presses+  :: Engine e+  => (Key -> a)  -- ^ The function to map the key pressed to an action.+  -> Sub e a     -- ^ The mapped subscription.+presses f = Sub $ do+  engine <- input >>= snapshot++  fmap (fmap f) <$> keyboardPressSignal engine++-- | Subscribe to keyboard down events and map to a game action.+downs+  :: Engine e+  => (Key -> a)  -- ^ The function to map the key held down to an action.+  -> Sub e a     -- ^ The mapped subscription.+downs f = Sub $ do+  engine <- input >>= snapshot++  fmap (fmap f) <$> keyboardDownSignal engine++-- | Subscribe to keyboard up events and map to a game action.+ups+  :: Engine e+  => (Key -> a)  -- ^ The function to map the key released to an action.+  -> Sub e a     -- ^ The mapped subscription.+ups f = Sub $ do+  engine <- input >>= snapshot++  fmap (fmap f) <$> keyboardUpSignal engine
+ src/Helm/Mouse.hs view
@@ -0,0 +1,62 @@+{-| Contains subscriptions to events from the mouse. -}+module Helm.Mouse+  (+    -- * Types+    MouseButton(..)+    -- * Subscriptions+  , moves+  , clicks+  , downs+  , ups+  ) where++import FRP.Elerea.Param (input, snapshot)+import Linear.V2 (V2)++import Helm.Engine (Sub(..), Engine(..), MouseButton(..))++-- | Subscribe to mouse movement events and map to a game action.+moves+  :: Engine e+  => (V2 Int -> a)  -- ^ The function to map a mouse position to an action.+  -> Sub e a        -- ^ The mapped subscription.+moves f = Sub $ do+  engine <- input >>= snapshot++  fmap (fmap f) <$> mouseMoveSignal engine++-- | Subscribe to mouse click events and map to a game action.+-- This subscription is for all mouse buttons - you'll need to+-- match over a mouse button if you want to capture a specific one.+--+-- Note that Helm defines a mouse click as a mouse up event which+-- came after a very recent mouse down event in a close radius+-- of the mouse down event.+clicks+  :: Engine e+  => (MouseButton -> V2 Int -> a)  -- ^ The function to map a mouse button and position to an action.+  -> Sub e a                       -- ^ The mapped subscription.+clicks f = Sub $ do+  engine <- input >>= snapshot++  fmap (fmap (uncurry f)) <$> mouseClickSignal engine++-- | Subscribe to mouse button down events and map to a game action.+downs+  :: Engine e+  => (MouseButton -> V2 Int -> a)  -- ^ The function to map a mouse button and position to an action.+  -> Sub e a                       -- ^ The mapped subscription.+downs f = Sub $ do+  engine <- input >>= snapshot++  fmap (fmap (uncurry f)) <$> mouseDownSignal engine++-- | Subscribe to mouse button up events and map to a game action.+ups+  :: Engine e+  => (MouseButton -> V2 Int -> a)  -- ^ The function to map a mouse button and position to an action.+  -> Sub e a                       -- ^ The mapped subscription.+ups f = Sub $ do+  engine <- input >>= snapshot++  fmap (fmap (uncurry f)) <$> mouseUpSignal engine
+ src/Helm/Sub.hs view
@@ -0,0 +1,33 @@+-- | Contains the subscription type and related utilities.+module Helm.Sub+  (+    -- * Types+    Sub(..)+    -- * Utilities+  , batch+  , none+  ) where++import Helm.Engine (Engine, Sub(..))++-- | Combine a list of subscriptions into a single one.+-- This is allows for subscriptions to multiple input events to be+-- combined into one subscription that encompasses all the actions+-- mapped from events.+batch+  :: Engine e+  => [Sub e a]  -- ^ The list of subscriptions.+  -> Sub e a    -- ^ The subscriptions accumulated.+batch subs = Sub $ do+  signals <- mapM (\(Sub gen) -> gen) subs++  return $ do+    lists <- sequence signals++    return $ concat lists++-- | A subscription that does nothing. If user input events+-- aren't required for a game, return this in the subscriptions function+-- of the game.+none :: Engine e => Sub e a+none = Sub . return $ return []
+ src/Helm/Time.hs view
@@ -0,0 +1,116 @@+-- | Contains functions for composing units of time and+-- subscriptions to events from the game clock.+module Helm.Time+  (+    -- * Types+    Time+    -- * Units+  , millisecond+  , second+  , minute+  , hour+  , inMilliseconds+  , inSeconds+  , inMinutes+  , inHours+    -- * Commands+  , now+    -- * Subscriptions+  , every+  , fps+  ) where++import Control.Monad.State (get)+import Control.Monad.IO.Class (liftIO)++import FRP.Elerea.Param (transfer, input, snapshot, effectful)++import Helm.Engine (Cmd(..), Sub(..), Engine(..))++-- | Represents an amount of time in an arbitary unit.+-- This type can then be composed with the relevant utility functions.+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++-- | Map the running time of the engine to a game action.+-- Note that this is not the current clock time but rather the engine time,+-- i.e. when the engine first starts running, the applied value will be zero.+now+  :: Engine e+  => (Time -> a)  -- ^ The function to map the running time to an action.+  -> Cmd e a      -- ^ The mapped command.+now f = Cmd $ do+  engine <- get+  ticks <- liftIO $ f <$> runningTime engine++  return [ticks]++-- | Generic subscription for time interval-based events.+every' :: Engine e => (e -> Time -> (Time, [Double]) -> (Time, [Double])) -> (Time -> a) -> Sub e a+every' step f = Sub $ do+  engine <- input >>= snapshot+  time <- effectful $ runningTime engine+  sig <- transfer (0, []) step time++  return $ map f . snd <$> sig++-- | Subscribe to the running time of the engine and map to a game action,+-- producing events at a provided interval.+every+  :: Engine e+  => Time         -- ^ The interval of time to produce events at.+  -> (Time -> a)  -- ^ The function to map the running time to an action.+  -> Sub e a      -- ^ The mapped subscription.+every interval = every' step+  where+    step _ t (lt, _) =+      if t - lt >= interval+      then (t, [t])  -- Use new t value with t event+      else (lt, [])  -- Use old t value with no event++-- | Subscribe to events that emit at a provided frames per second and map to a game action,+-- producing events at a provided interval. The time value applied is the delta between+-- the current and last event emission time.+fps+  :: Engine e+  => Int          -- ^ The frames per second.+  -> (Time -> a)  -- ^ The function to map the time delta to an action.+  -> Sub e a      -- ^ The mapped subscription.+fps frames = every' step+  where+    interval = 1000 / fromIntegral frames+    step _ t (lt, _) =+      if t - lt >= interval+      then (t, [t - lt])  -- Use new t value with t event+      else (lt, [])  -- Use old t value with no event
+ src/Helm/Window.hs view
@@ -0,0 +1,37 @@+-- | Contains signals that sample input from the game window.+module Helm.Window+  (+    -- * Commands+    size+    -- * Subscriptions+  , resizes+  ) where++import Control.Monad.State (get)+import Control.Monad.IO.Class (liftIO)++import FRP.Elerea.Param (input, snapshot)+import Linear.V2 (V2)++import Helm.Engine (Engine(..), Cmd(..), Sub(..))++-- | Map the game window size to a game action.+size+  :: Engine e+  => (V2 Int -> a)  -- ^ The function to map the window size to an action.+  -> Cmd e a        -- ^ The mapped command.+size f = Cmd $ do+  engine <- get+  sized <- liftIO $ f <$> windowSize engine++  return [sized]++-- | Subscribe to the resize events from the game window and map to a game action.+resizes+  :: Engine e+  => (V2 Int -> a)  -- ^ The function to map the changed window size to an action.+  -> Sub e a        -- ^ The mapped subscription.+resizes f = Sub $ do+  engine <- input >>= snapshot++  fmap (map f) <$> windowResizeSignal engine
+ test/Helm/TimeSpec.hs view
@@ -0,0 +1,16 @@+module Helm.TimeSpec where++import Helm.Time+import Test.Hspec++spec :: Spec+spec =+  describe "units" $ do+    it "represents 1 ms the same as (1/1000) s" $+      inSeconds millisecond `shouldBe` (1/1000)++    it "represents 1 s the same as (1/60) min" $+      inMinutes second `shouldBe` (1/60.0)++    it "represents 1 min as (1/60) hrs" $+      inHours minute `shouldBe` (1/60.0)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
− tests/Main.hs
@@ -1,9 +0,0 @@-module Main where--import Test.Framework (defaultMain, testGroup)-import qualified Color-import qualified Time--main :: IO ()-main = defaultMain [testGroup "Color" Color.tests,-                    testGroup "Time" Time.tests]