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