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 +1/−1
- README.md +75/−96
- examples/flappy/Main.hs +402/−0
- helm.cabal +55/−44
- src/FRP/Helm.hs +0/−394
- src/FRP/Helm/Color.hs +0/−196
- src/FRP/Helm/Engine.hs +0/−11
- src/FRP/Helm/Graphics.hs +0/−303
- src/FRP/Helm/Keyboard.hs +0/−793
- src/FRP/Helm/Mouse.hs +0/−86
- src/FRP/Helm/Random.hs +0/−81
- src/FRP/Helm/Sample.hs +0/−29
- src/FRP/Helm/Signal.hs +0/−127
- src/FRP/Helm/Text.hs +0/−98
- src/FRP/Helm/Time.hs +0/−148
- src/FRP/Helm/Utilities.hs +0/−32
- src/FRP/Helm/Window.hs +0/−53
- src/Helm.hs +98/−0
- src/Helm/Asset.hs +18/−0
- src/Helm/Cmd.hs +43/−0
- src/Helm/Color.hs +116/−0
- src/Helm/Engine.hs +408/−0
- src/Helm/Engine/SDL.hs +248/−0
- src/Helm/Engine/SDL/Asset.hs +41/−0
- src/Helm/Engine/SDL/Engine.hs +53/−0
- src/Helm/Engine/SDL/Graphics2D.hs +214/−0
- src/Helm/Engine/SDL/Keyboard.hs +245/−0
- src/Helm/Engine/SDL/Mouse.hs +15/−0
- src/Helm/Graphics.hs +14/−0
- src/Helm/Graphics2D.hs +375/−0
- src/Helm/Graphics2D/Text.hs +97/−0
- src/Helm/Graphics2D/Transform.hs +85/−0
- src/Helm/Keyboard.hs +46/−0
- src/Helm/Mouse.hs +62/−0
- src/Helm/Sub.hs +33/−0
- src/Helm/Time.hs +116/−0
- src/Helm/Window.hs +37/−0
- test/Helm/TimeSpec.hs +16/−0
- test/Spec.hs +1/−0
- tests/Main.hs +0/−9
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]