diff --git a/FRP/Helm.hs b/FRP/Helm.hs --- a/FRP/Helm.hs +++ b/FRP/Helm.hs @@ -1,8 +1,13 @@ +{-| Contains miscellaneous utility functions and the main + functions for interfacing with the engine. -} module FRP.Helm ( + -- * Engine + run, + -- * Utilities radians, degrees, turns, - run, + -- * Prelude module FRP.Helm.Color, module FRP.Helm.Graphics, ) where @@ -20,6 +25,7 @@ {-| 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. -} +-- TODO: userland version of this requestDimensions :: Int -> Int -> IO SDL.Surface requestDimensions w h = do mayhaps <- SDL.trySetVideoMode w h 32 [SDL.HWSurface, SDL.DoubleBuf, SDL.Resizable] @@ -28,19 +34,22 @@ Just screen -> return screen Nothing -> SDL.setVideoMode w h 32 [SDL.SWSurface, SDL.Resizable] --- |Converts radians into the standard angle measurement (radians). -radians :: Float -> Float +{-| Converts radians into the standard angle measurement (radians). -} +radians :: Double -> Double radians n = n --- |Converts degrees into the standard angle measurement (radians). -degrees :: Float -> Float +{-| 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 :: Float -> Float +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) @@ -51,6 +60,7 @@ 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 @@ -58,16 +68,34 @@ 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. -} + 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] >> 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 @@ -78,9 +106,13 @@ 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 @@ -94,6 +126,8 @@ 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 @@ -102,37 +136,53 @@ renderElement state element -getSurface :: EngineState -> FilePath -> IO Cairo.Surface +{-| 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 -> return surface + 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 - - writeIORef cache (Map.insert src surface cached) >> return surface + 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) = mapM (renderForm state) forms >> return () -renderElement state (ImageElement (sx, sy) sw sh src _) = do - surface <- Cairo.liftIO $ getSurface state (normalise src) +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 +{-| 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 @@ -140,6 +190,7 @@ 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 @@ -147,15 +198,21 @@ 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) + (surface, w, h) <- Cairo.liftIO $ getSurface state (normalise src) Cairo.setSourceSurface surface 0 0 >> Cairo.getSource >>= (flip Cairo.patternSetExtend) Cairo.ExtendRepeat Cairo.fill @@ -168,6 +225,7 @@ Cairo.withRadialPattern sx sy sr ex ey er $ \pattern -> 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 _ (Form { style = PathForm style p, .. }) = withTransform scalar theta x y $ @@ -176,16 +234,34 @@ where (hx, hy) = head p -renderForm state (Form { style = ShapeForm style shape, .. }) = +renderForm state (Form { style = ShapeForm style (PolygonShape points), .. }) = withTransform scalar theta x y $ do - Cairo.newPath >> Cairo.moveTo hx hy >> mapM (\(x_, y_) -> Cairo.lineTo x_ y_) shape >> Cairo.closePath + Cairo.newPath >> Cairo.moveTo hx hy >> mapM (\(x_, y_) -> Cairo.lineTo x_ y_) points >> Cairo.closePath case style of Left lineStyle -> setLineStyle lineStyle Right fillStyle -> setFillStyle state fillStyle where - (hx, hy) = head shape + (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 $ Cairo.setMatrix m >> mapM (renderForm state) forms >> return () diff --git a/FRP/Helm/Color.hs b/FRP/Helm/Color.hs --- a/FRP/Helm/Color.hs +++ b/FRP/Helm/Color.hs @@ -1,83 +1,177 @@ -module FRP.Helm.Color where +{-| 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 } --- |Creates an RGB color. +{-| Creates an RGB color. -} rgb :: Double -> Double -> Double -> Color rgb r g b = Color r g b 1 --- |Creates an RGB color, with transparency. +{-| 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 -{- TODO: - +{-| 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)] --- |Creates a linear gradient. Takes an +{-| 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. +{-| 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 diff --git a/FRP/Helm/Graphics.hs b/FRP/Helm/Graphics.hs --- a/FRP/Helm/Graphics.hs +++ b/FRP/Helm/Graphics.hs @@ -1,17 +1,26 @@ +{-| Contains all the data structures and functions for composing + and rendering graphics. -} module FRP.Helm.Graphics ( + -- * Types Element(..), - image, - croppedImage, Form(..), + FormStyle(..), FillStyle(..), LineCap(..), LineJoin(..), LineStyle(..), + Path, + Shape(..), + -- * Elements + image, + fittedImage, + croppedImage, + collage, + -- * Styles & Forms defaultLine, solid, dashed, dotted, - FormStyle(..), filled, textured, gradient, @@ -19,18 +28,19 @@ traced, sprite, toForm, + -- * Grouping group, groupTransform, + -- * Transforming rotate, scale, move, moveX, moveY, - collage, - Path, + -- * Paths path, segment, - Shape, + -- * Shapes polygon, rect, square, @@ -42,6 +52,13 @@ import FRP.Helm.Color as Color import Graphics.Rendering.Cairo.Matrix (Matrix, identity) +{-| 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 @@ -51,19 +68,21 @@ image :: Int -> Int -> FilePath -> Element image w h src = ImageElement (0, 0) w h src True -{- TODO: {-| 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 width instead of scaling). If the given dimensions are bigger than + (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 -} +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, @@ -71,9 +90,19 @@ y :: Double, style :: FormStyle } + +{-| A data structure describing how a shape or path looks when filled. -} data FillStyle = Solid Color | Texture String | Gradient Gradient + +{-| A data structure describing the shape of the ends of a line. -} data LineCap = Flat | Round | Padded + +{-| 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 + +{-| A data structure describing how a shape or path looks when stroked. -} data LineStyle = LineStyle { color :: Color, width :: Double, @@ -95,46 +124,50 @@ dashOffset = 0 } --- |Create a solid line style with a color. +{-| Create a solid line style with a color. -} solid :: Color -> LineStyle solid color = defaultLine { color = color } --- |Create a dashed line style with a 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. +{-| 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] +{-| 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. +{-| Creates a form from a shape by filling it with a specific color. -} filled :: Color -> Shape -> Form filled color shape = fill (Solid color) shape --- |Creates a form from a shape with a tiled texture and image file path. +{-| Creates a form from a shape with a tiled texture and image file path. -} textured :: String -> Shape -> Form textured src shape = fill (Texture src) shape --- |Creates a form from a shape filled with a gradient. +{-| Creates a form from a shape filled with a gradient. -} gradient :: Gradient -> Shape -> Form gradient grad shape = fill (Gradient grad) shape --- |Creates a form from a shape by outlining it with a specific line style. +{-| 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. +{-| 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) @@ -143,88 +176,86 @@ 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. +{-| Creates a form from an element. -} toForm :: Element -> Form toForm element = form (ElementForm element) --- |Groups a collection of forms into a single one. +{-| 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. +{-| 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). +{-| 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 will double the size. +{-| 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. +{-| 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. +{-| Moves a form's x-coordinate relative to its current position. -} moveX :: Double -> Form -> Form moveX x f = move (x, 0) f --- |Moves a form's y-coordinate relative to its current position. +{-| Moves a form's y-coordinate relative to its current position. -} moveY :: Double -> Form -> Form moveY y f = move (0, y) f -{-| Create an element from a collection of forms. - Can be used to directly render a collection of forms. -} +{-| 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 w h forms = CollageElement w h forms +{-| 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. +{-| 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. +{-| 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] +segment p1 p2 = [p1, p2] -type Shape = [(Double, Double)] +{-| 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) --- |Creates a shape from a set of points. -polygon :: [(Double, Double)] -> Shape -polygon points = points +{-| Creates a shape from a path (a set of points). -} +polygon :: Path -> Shape +polygon points = PolygonShape points --- |Creates a rectangular shape with a specific width and height. +{-| Creates a rectangular shape with a width and height. -} rect :: Double -> Double -> Shape -rect w h = [(-hw, -hh), (-hw, hh), (hw, hh), (hw, -hh)] - where - hw = w / 2 - hh = h / 2 +rect w h = RectangleShape (w, h) --- |Creates a square shape with a specific side length. +{-| Creates a square shape with a side length. -} square :: Double -> Shape square n = rect n n --- |Creates an oval shape with a specific width and height. +{-| Creates an oval shape with a width and height. -} oval :: Double -> Double -> Shape -oval w h = map (\i -> (hw * cos (t * i), hh * sin (t * i))) [0 .. n - 1] - where - n = 50 - t = 2 * pi / n - hw = w / 2 - hh = h / 2 +oval w h = ArcShape (0, 0) 0 (2 * pi) 1 (w / 2, h / 2) --- |Creates an oval shape with a specific radius. -{- TODO: Make a separate variant of a shape that is based on an arc. - as this sort of thing is going to be pretty unaccurate and slower. -} +{-| Creates a circle shape with a radius. -} circle :: Double -> Shape -circle r = oval (2 * r) (2 * r) +circle r = ArcShape (0, 0) 0 (2 * pi) r (1, 1) --- |Creates a generic n-sided polygon (e.g. octagon) with a specific amount of sides and radius. +{-| 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 = map (\i -> (r * cos (t * i), r * sin (t * i))) [0 .. fromIntegral (n - 1)] +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 diff --git a/FRP/Helm/Keyboard.hs b/FRP/Helm/Keyboard.hs --- a/FRP/Helm/Keyboard.hs +++ b/FRP/Helm/Keyboard.hs @@ -1,11 +1,12 @@ +{-| Contains signals that sample input from the keyboard. -} module FRP.Helm.Keyboard ( - shift, - ctrl, - enter, + -- * Types Key(..), - space, - arrows, - wasd + -- * Key State + shift, ctrl, enter, + space, isDown, keysDown, + -- * Directions + arrows, wasd ) where import Control.Applicative @@ -14,18 +15,19 @@ import Foreign.C.Types import FRP.Elerea.Simple import qualified Graphics.UI.SDL as SDL -import qualified Graphics.UI.SDL.Utilities as Utilities --- The SDL bindings for Haskell don't wrap this, so we have to use the FFI ourselves. +{-| 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) --- Based on http://coderepos.org/share/browser/lang/haskell/nario/Main.hs?rev=22646#L49 -getKeyState :: IO [SDL.SDLKey] +{-| A utility function for getting a list of SDL keys currently pressed. + Based on . -} +getKeyState :: IO [Int] getKeyState = alloca $ \numkeysPtr -> do keysPtr <- sdlGetKeyState numkeysPtr numkeys <- peek numkeysPtr - (map Utilities.toEnum . map fromIntegral . findIndices (== 1)) <$> peekArray (fromIntegral numkeys) keysPtr + (map fromIntegral . findIndices (== 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 | @@ -34,187 +36,325 @@ Num9Key | ColonKey | SemicolonKey | LessKey | EqualsKey | GreaterKey | QuestionKey | AtKey | LeftBracketKey | BackslashKey | RightBracketKey | CaretKey | UnderscoreKey | BackquoteKey | AKey | BKey | CKey | DKey | - EKey | FKey | GKey | HKey | IKey | JKey | + EKey | FKey | GKey | HKey | IKey | JKey | KKey | LKey | MKey | NKey | OKey | PKey | QKey | RKey | SKey | TKey | UKey | VKey | WKey | - XKey | YKey | ZKey | DeleteKey | Keypad0Key | Keypad1Key | - Keypad2Key | Keypad3Key | Keypad4Key | Keypad5Key | Keypad6Key | Keypad7Key | - Keypad8Key | Keypad9Key | KeypadPeriodKey | KeypadDivideKey | KeypadMultiplyKey | KeypadMinusKey | + 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 | ComposeKey | HelpKey | + RMetaKey | LMetaKey | RSuperKey | LSuperKey | ModeKey | ComposeKey | HelpKey | PrintKey | SysReqKey | BreakKey | MenuKey | PowerKey | EuroKey | UndoKey -mapKey :: Key -> SDL.SDLKey -mapKey k = - case k of - BackspaceKey -> SDL.SDLK_BACKSPACE - TabKey -> SDL.SDLK_TAB - ClearKey -> SDL.SDLK_CLEAR - EnterKey -> SDL.SDLK_RETURN - PauseKey -> SDL.SDLK_PAUSE - EscapeKey -> SDL.SDLK_ESCAPE - SpaceKey -> SDL.SDLK_SPACE - ExclaimKey -> SDL.SDLK_EXCLAIM - QuotedBlKey -> SDL.SDLK_QUOTEDBL - HashKey -> SDL.SDLK_HASH - DollarKey -> SDL.SDLK_DOLLAR - AmpersandKey -> SDL.SDLK_AMPERSAND - QuoteKey -> SDL.SDLK_QUOTE - LeftParenKey -> SDL.SDLK_LEFTPAREN - RightParenKey -> SDL.SDLK_RIGHTPAREN - AsteriskKey -> SDL.SDLK_ASTERISK - PlusKey -> SDL.SDLK_PLUS - CommaKey -> SDL.SDLK_COMMA - MinusKey -> SDL.SDLK_MINUS - PeriodKey -> SDL.SDLK_PERIOD - SlashKey -> SDL.SDLK_SLASH - Num0Key -> SDL.SDLK_0 - Num1Key -> SDL.SDLK_1 - Num2Key -> SDL.SDLK_2 - Num3Key -> SDL.SDLK_3 - Num4Key -> SDL.SDLK_4 - Num5Key -> SDL.SDLK_5 - Num6Key -> SDL.SDLK_6 - Num7Key -> SDL.SDLK_7 - Num8Key -> SDL.SDLK_8 - Num9Key -> SDL.SDLK_9 - ColonKey -> SDL.SDLK_COLON - SemicolonKey -> SDL.SDLK_SEMICOLON - LessKey -> SDL.SDLK_LESS - EqualsKey -> SDL.SDLK_EQUALS - GreaterKey -> SDL.SDLK_GREATER - QuestionKey -> SDL.SDLK_QUESTION - AtKey -> SDL.SDLK_AT - LeftBracketKey -> SDL.SDLK_LEFTBRACKET - BackslashKey -> SDL.SDLK_BACKSLASH - RightBracketKey -> SDL.SDLK_RIGHTBRACKET - CaretKey -> SDL.SDLK_CARET - UnderscoreKey -> SDL.SDLK_UNDERSCORE - BackquoteKey -> SDL.SDLK_BACKQUOTE - AKey -> SDL.SDLK_a - BKey -> SDL.SDLK_b - CKey -> SDL.SDLK_c - DKey -> SDL.SDLK_d - EKey -> SDL.SDLK_e - FKey -> SDL.SDLK_f - GKey -> SDL.SDLK_g - HKey -> SDL.SDLK_h - IKey -> SDL.SDLK_i - JKey -> SDL.SDLK_j - LKey -> SDL.SDLK_l - MKey -> SDL.SDLK_m - NKey -> SDL.SDLK_n - OKey -> SDL.SDLK_o - PKey -> SDL.SDLK_p - QKey -> SDL.SDLK_q - RKey -> SDL.SDLK_r - SKey -> SDL.SDLK_s - TKey -> SDL.SDLK_t - UKey -> SDL.SDLK_u - VKey -> SDL.SDLK_v - WKey -> SDL.SDLK_w - XKey -> SDL.SDLK_x - YKey -> SDL.SDLK_y - ZKey -> SDL.SDLK_z - DeleteKey -> SDL.SDLK_DELETE - Keypad0Key -> SDL.SDLK_KP0 - Keypad1Key -> SDL.SDLK_KP1 - Keypad2Key -> SDL.SDLK_KP2 - Keypad3Key -> SDL.SDLK_KP3 - Keypad4Key -> SDL.SDLK_KP4 - Keypad5Key -> SDL.SDLK_KP5 - Keypad6Key -> SDL.SDLK_KP6 - Keypad7Key -> SDL.SDLK_KP7 - Keypad8Key -> SDL.SDLK_KP8 - Keypad9Key -> SDL.SDLK_KP9 - KeypadPeriodKey -> SDL.SDLK_KP_PERIOD - KeypadDivideKey -> SDL.SDLK_KP_DIVIDE - KeypadMultiplyKey -> SDL.SDLK_KP_MULTIPLY - KeypadMinusKey -> SDL.SDLK_KP_MINUS - KeypadPlusKey -> SDL.SDLK_KP_PLUS - KeypadEnterKey -> SDL.SDLK_KP_ENTER - KeypadEqualsKey -> SDL.SDLK_KP_EQUALS - UpKey -> SDL.SDLK_UP - DownKey -> SDL.SDLK_DOWN - RightKey -> SDL.SDLK_RIGHT - LeftKey -> SDL.SDLK_LEFT - InsertKey -> SDL.SDLK_INSERT - HomeKey -> SDL.SDLK_HOME - EndKey -> SDL.SDLK_END - PageUpKey -> SDL.SDLK_PAGEUP - PageDownKey -> SDL.SDLK_PAGEDOWN - F1Key -> SDL.SDLK_F1 - F2Key -> SDL.SDLK_F2 - F3Key -> SDL.SDLK_F3 - F4Key -> SDL.SDLK_F4 - F5Key -> SDL.SDLK_F5 - F6Key -> SDL.SDLK_F6 - F7Key -> SDL.SDLK_F7 - F8Key -> SDL.SDLK_F8 - F9Key -> SDL.SDLK_F9 - F10Key -> SDL.SDLK_F10 - F11Key -> SDL.SDLK_F11 - F12Key -> SDL.SDLK_F12 - F13Key -> SDL.SDLK_F13 - F14Key -> SDL.SDLK_F14 - F15Key -> SDL.SDLK_F15 - NumLockKey -> SDL.SDLK_NUMLOCK - CapsLockKey -> SDL.SDLK_CAPSLOCK - ScrollLockKey -> SDL.SDLK_SCROLLOCK - RShiftKey -> SDL.SDLK_RSHIFT - LShiftKey -> SDL.SDLK_LSHIFT - RCtrlKey -> SDL.SDLK_RCTRL - LCtrlKey -> SDL.SDLK_LCTRL - RAltKey -> SDL.SDLK_RALT - LAltKey -> SDL.SDLK_LALT - RMetaKey -> SDL.SDLK_RMETA - LMetaKey -> SDL.SDLK_LMETA - RSuperKey -> SDL.SDLK_RSUPER - LSuperKey -> SDL.SDLK_LSUPER - ComposeKey -> SDL.SDLK_COMPOSE - HelpKey -> SDL.SDLK_HELP - PrintKey -> SDL.SDLK_PRINT - SysReqKey -> SDL.SDLK_SYSREQ - BreakKey -> SDL.SDLK_BREAK - MenuKey -> SDL.SDLK_MENU - PowerKey -> SDL.SDLK_POWER - EuroKey -> SDL.SDLK_EURO - UndoKey -> SDL.SDLK_UNDO +{- 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 --- |Whether either shift key is pressed. + 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. +{-| Whether either control key is pressed. -} ctrl :: SignalGen (Signal Bool) ctrl = effectful $ (elem SDL.KeyModCtrl) <$> SDL.getModState --- |Whether a specific key is pressed. +{-| Whether a key is pressed. -} isDown :: Key -> SignalGen (Signal Bool) -isDown k = effectful $ (elem (mapKey k)) <$> getKeyState +isDown k = effectful $ (elem $ fromEnum k) <$> getKeyState --- |Whether the shift key is pressed. +{-| Whether the enter (a.k.a. return) key is pressed. -} enter :: SignalGen (Signal Bool) enter = isDown EnterKey --- |Whether the space key is pressed. +{-| Whether the space key is pressed. -} space :: SignalGen (Signal Bool) space = isDown SpaceKey -{- TODO: +{-| A list of keys that are currently being pressed. -} keysDown :: SignalGen (Signal [Key]) --} +keysDown = effectful $ (map toEnum) <$> getKeyState -{-| A unit vector combined from the arrow keys. When no keys are being pressed - this signal samples to (0, 0), otherwise it samples to a specific direction - based on which keys are pressed. For example, pressing the left key results - in (-1, 0), the down key (0, 1), etc. -} +{-| 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 @@ -224,10 +364,11 @@ 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 W, A, S and D keys instead. +{-| Similar to the 'arrows' signal, but uses the popular WASD movement controls instead. -} wasd :: SignalGen (Signal (Int, Int)) wasd = do w <- isDown WKey diff --git a/FRP/Helm/Mouse.hs b/FRP/Helm/Mouse.hs --- a/FRP/Helm/Mouse.hs +++ b/FRP/Helm/Mouse.hs @@ -1,24 +1,33 @@ -module FRP.Helm.Mouse (position, x, y, isDown, Mouse(..)) where +{-| 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 +{-| A data structure describing a button on a mouse. -} data Mouse = LeftMouse | MiddleMouse | RightMouse --- |The current mouse position. +{-| 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. +{-| The current x-coordinate of the mouse. -} x :: SignalGen (Signal Int) x = effectful $ (\(x_, _, _) -> x_) <$> SDL.getMouseState --- |The current y-coordinate of the mouse. +{-| The current y-coordinate of the mouse. -} y :: SignalGen (Signal Int) y = effectful $ (\(_, y_, _) -> y_) <$> SDL.getMouseState - +{-| Maps our mouse type into SDL's one. -} mapMouse :: Mouse -> SDL.MouseButton mapMouse m = case m of @@ -30,7 +39,3 @@ True if the mouse is down, false otherwise. -} isDown :: Mouse -> SignalGen (Signal Bool) isDown m = effectful $ (\(_, _, b_) -> elem (mapMouse m) b_) <$> SDL.getMouseState - -{- TODO: -isClicked :: SignalGen (Signal Bool) - -} diff --git a/FRP/Helm/Window.hs b/FRP/Helm/Window.hs --- a/FRP/Helm/Window.hs +++ b/FRP/Helm/Window.hs @@ -1,4 +1,8 @@ -module FRP.Helm.Window (dimensions, width, height) where +{-| Contains signals that sample input from the game window. -} +module FRP.Helm.Window ( + -- * Dimensions + dimensions, width, height +) where import Control.Applicative import FRP.Elerea.Simple diff --git a/helm.cabal b/helm.cabal --- a/helm.cabal +++ b/helm.cabal @@ -1,5 +1,5 @@ name: helm -version: 0.1.0 +version: 0.2.0 synopsis: A functionally reactive game engine. description: A functionally reactive game engine, with headgear to protect you from the headache of game development provided.