helm (empty) → 0.1.0
raw patch · 10 files changed
+965/−0 lines, 10 filesdep +SDLdep +basedep +cairosetup-changed
Dependencies added: SDL, base, cairo, containers, elerea, filepath
Files
- FRP/Helm.hs +191/−0
- FRP/Helm/Color.hs +83/−0
- FRP/Helm/Graphics.hs +230/−0
- FRP/Helm/Keyboard.hs +238/−0
- FRP/Helm/Mouse.hs +36/−0
- FRP/Helm/Window.hs +17/−0
- LICENSE +19/−0
- README.md +108/−0
- Setup.hs +3/−0
- helm.cabal +40/−0
+ FRP/Helm.hs view
@@ -0,0 +1,191 @@+module FRP.Helm (+ radians,+ degrees,+ turns,+ run,+ module FRP.Helm.Color,+ module FRP.Helm.Graphics,+) where++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 :: Float -> Float+radians n = n++-- |Converts degrees into the standard angle measurement (radians).+degrees :: Float -> Float+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 n = 2 * pi * n++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)+}++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. -}+run :: SignalGen (Signal Element) -> IO ()+run gen = SDL.init [SDL.InitVideo] >> requestDimensions 800 600 >> start gen >>= newEngineState >>= run'++run' :: EngineState -> IO ()+run' state = do+ continue <- run''++ if continue then smp state >>= render state >> run' state else SDL.quit++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''++render :: EngineState -> Element -> IO ()+render state element = SDL.getVideoSurface >>= render' state element++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++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++getSurface :: EngineState -> FilePath -> IO Cairo.Surface+getSurface (EngineState { cache }) src = do+ cached <- Cairo.liftIO (readIORef cache)++ case Map.lookup src cached of+ Just surface -> return surface+ 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+++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)++ Cairo.save+ Cairo.translate (-fromIntegral sx) (-fromIntegral sy)+ Cairo.setSourceSurface surface 0 0+ Cairo.translate (fromIntegral sx) (fromIntegral sy)+ Cairo.rectangle 0 0 (fromIntegral sw) (fromIntegral sh)+ Cairo.fill+ Cairo.restore++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++setLineCap :: LineCap -> Cairo.Render ()+setLineCap cap = + case cap of+ Flat -> Cairo.setLineCap Cairo.LineCapButt+ Round -> Cairo.setLineCap Cairo.LineCapRound+ Padded -> Cairo.setLineCap Cairo.LineCapSquare++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++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++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)) = do+ Cairo.withLinearPattern sx sy ex ey $ \pattern -> do+ 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)) = do+ 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++renderForm :: EngineState -> Form -> Cairo.Render ()+renderForm _ (Form { style = PathForm style p, .. }) =+ withTransform scalar theta x y $ + setLineStyle style >> Cairo.moveTo hx hy >> mapM (\(x_, y_) -> Cairo.lineTo x_ y_) p >> return ()++ where+ (hx, hy) = head p++renderForm state (Form { style = ShapeForm style shape, .. }) =+ withTransform scalar theta x y $ do+ Cairo.newPath >> Cairo.moveTo hx hy >> mapM (\(x_, y_) -> Cairo.lineTo x_ y_) shape >> Cairo.closePath++ case style of+ Left lineStyle -> setLineStyle lineStyle+ Right fillStyle -> setFillStyle state fillStyle++ where+ (hx, hy) = head shape++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 ()
+ FRP/Helm/Color.hs view
@@ -0,0 +1,83 @@+module FRP.Helm.Color where++data Color = Color { r :: !Double, g :: !Double, b :: !Double, a :: !Double }++-- |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++red :: Color+red = rgb 1 0 0++lime :: Color+lime = rgb 0 1 0++blue :: Color+blue = rgb 0 0 1++yellow :: Color+yellow = rgb 1 1 0++cyan :: Color+cyan = rgb 0 1 1++magenta :: Color+magenta = rgb 1 0 1++black :: Color+black = rgb 0 0 0++white :: Color+white = rgb 1 1 1++gray :: Color+gray = rgb 0.5 0.5 0.5++grey :: Color+grey = gray++maroon :: Color+maroon = rgb 0.5 0 0++navy :: Color+navy = rgb 0 0 0.5++green :: Color+green = rgb 0 0.5 0++teal :: Color+teal = rgb 0 0.5 0.5++purple :: Color+purple = rgb 0.5 0 0.5++violet :: Color+violet = rgb 0.923 0.508 0.923++forestGreen :: Color+forestGreen = rgb 0.133 0.543 0.133++{- TODO:++complement :: Color -> Color++hsva :: Double -> Double -> Double -> Double -> Color++hsv :: Double -> Double -> Double -> Color+-}++data Gradient = Linear (Double, Double) (Double, Double) [(Double, Color)] |+ Radial (Double, Double) Double (Double, Double) Double [(Double, Color)]+++-- |Creates a linear gradient. Takes an +linear :: (Double, Double) -> (Double, Double) -> [(Double, Color)] -> Gradient+linear = Linear++-- |Creates a radial gradient.+radial :: (Double, Double) -> Double -> (Double, Double) -> Double -> [(Double, Color)] -> Gradient+radial = Radial
+ FRP/Helm/Graphics.hs view
@@ -0,0 +1,230 @@+module FRP.Helm.Graphics (+ Element(..),+ image,+ croppedImage,+ Form(..),+ FillStyle(..),+ LineCap(..),+ LineJoin(..),+ LineStyle(..),+ defaultLine,+ solid,+ dashed,+ dotted,+ FormStyle(..),+ filled,+ textured,+ gradient,+ outlined,+ traced,+ sprite,+ toForm,+ group,+ groupTransform,+ rotate,+ scale,+ move,+ moveX,+ moveY,+ collage,+ Path,+ path,+ segment,+ Shape,+ polygon,+ rect,+ square,+ oval,+ circle,+ ngon+) where++import FRP.Helm.Color as Color+import Graphics.Rendering.Cairo.Matrix (Matrix, identity)++data Element = CollageElement Int Int [Form] |+ ImageElement (Int, Int) Int Int FilePath Bool++{-| 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++{- 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+ 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++data Form = Form {+ theta :: Double,+ scalar :: Double,+ x :: Double,+ y :: Double,+ style :: FormStyle+}+data FillStyle = Solid Color | Texture String | Gradient Gradient+data LineCap = Flat | Round | Padded+data LineJoin = Smooth | Sharp Double | Clipped+data LineStyle = LineStyle {+ color :: Color,+ width :: Double,+ cap :: LineCap,+ join :: LineJoin,+ dashing :: [Double],+ dashOffset :: Double+}++{-| 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 = 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] }++data FormStyle = PathForm LineStyle Path |+ ShapeForm (Either LineStyle FillStyle) Shape |+ ElementForm Element |+ GroupForm Matrix [Form]++form :: FormStyle -> Form+form style = Form { theta = 0, scalar = 1, x = 0, y = 0, style = style }++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 shape = fill (Solid color) shape++-- |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.+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.+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 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 f = move (x, 0) f++-- |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. -}+collage :: Int -> Int -> [Form] -> Element+collage w h forms = CollageElement w h forms++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]++type Shape = [(Double, Double)]++-- |Creates a shape from a set of points.+polygon :: [(Double, Double)] -> Shape+polygon points = points++-- |Creates a rectangular shape with a specific 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++-- |Creates a square shape with a specific side length.+square :: Double -> Shape+square n = rect n n++-- |Creates an oval shape with a specific 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++-- |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. -}+circle :: Double -> Shape+circle r = oval (2 * r) (2 * r)++-- |Creates a generic n-sided polygon (e.g. octagon) with a specific 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)]+ where + m = fromIntegral n+ t = 2 * pi / m
+ FRP/Helm/Keyboard.hs view
@@ -0,0 +1,238 @@+module FRP.Helm.Keyboard (+ shift,+ ctrl,+ enter,+ Key(..),+ space,+ 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+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.+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]+getKeyState = alloca $ \numkeysPtr -> do+ keysPtr <- sdlGetKeyState numkeysPtr+ numkeys <- peek numkeysPtr+ (map Utilities.toEnum . map fromIntegral . findIndices (== 1)) <$> peekArray (fromIntegral numkeys) keysPtr++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 |+ 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 |+ 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 |+ 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++-- |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 specific key is pressed.+isDown :: Key -> SignalGen (Signal Bool)+isDown k = effectful $ (elem (mapKey k)) <$> getKeyState++-- |Whether the shift key is pressed.+enter :: SignalGen (Signal Bool)+enter = isDown EnterKey++-- |Whether the space key is pressed.+space :: SignalGen (Signal Bool)+space = isDown SpaceKey++{- TODO:+keysDown :: SignalGen (Signal [Key])+-}++{-| 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. -}+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++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.+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 view
@@ -0,0 +1,36 @@+module FRP.Helm.Mouse (position, x, y, isDown, Mouse(..)) where++import Control.Applicative+import FRP.Elerea.Simple+import qualified Graphics.UI.SDL as SDL++data Mouse = LeftMouse | MiddleMouse | RightMouse++-- |The current mouse position.+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+++mapMouse :: Mouse -> SDL.MouseButton+mapMouse m =+ case m of+ LeftMouse -> SDL.ButtonLeft+ MiddleMouse -> SDL.ButtonMiddle+ RightMouse -> SDL.ButtonRight++{-| 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 (mapMouse m) b_) <$> SDL.getMouseState++{- TODO:+isClicked :: SignalGen (Signal Bool)+ -}
+ FRP/Helm/Window.hs view
@@ -0,0 +1,17 @@+module FRP.Helm.Window (dimensions, width, height) where++import Control.Applicative+import FRP.Elerea.Simple+import qualified Graphics.UI.SDL as SDL++-- |The current dimensions of the window.+dimensions :: SignalGen (Signal (Int, Int))+dimensions = effectful $ (\s -> (SDL.surfaceGetWidth s, SDL.surfaceGetHeight s)) <$> 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
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (C) 2013, Zack Corr++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to+deal in the Software without restriction, including without limitation the+rights to use, copy, modify, merge, publish, distribute, sublicense,+and/or sell copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN+NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,+DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR+OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR+THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,108 @@+# Helm++## Introduction++Helm is a functionally reactive game engine written in Haskell and built around+the [Elerea](https://github.com/cobbpg/elerea) FRP framework. 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. This may 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.++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.++## Features++* Allows you to express game logic dependent on input in a straightforward manner,+ treating events as (almost) first class objects (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.+* Straightforward API heavily inspired by the Elm programming language.++## Future Work++* 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, text rendering, joysticks and loading a larger range of+ image formats.+* 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.+* Optimizations and testing. This is the first 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.+* 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.++## Example++The following examples is the barebones of a game. It shows how to create+an accumulated state that depends on the values sampled from signals (e.g. mouse input and such).+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+import qualified FRP.Helm.Keyboard as Keyboard+import qualified FRP.Helm.Window as Window++data State = State { mx :: Double, my :: Double }++step :: (Int, Int) -> State -> State+step (dx, dy) state = state { mx = (realToFrac dx) + mx state, my = (realToFrac dy) + my state }++render :: (Int, Int) -> State -> Element+render (w, h) (State { .. }) = collage 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++ return $ render <$> dims <*> stepper+```++## Installing and Building++Helm requires GHC 7.6 (Elerea doesn't work with older versions due to a compiler bug).+To install the latest (stable) version from the Hackage repository, use:++```+cabal install helm+```++Alternatively to get the latest development version, you can clone this repository and then run:++```+cabal install+```++You may need to jump a few hoops to install the Cairo bindings (which are a dependency),+which unfortunately is out of my hands.++## License++Helm is licensed under the MIT license. See the `LICENSE` file for more details.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ helm.cabal view
@@ -0,0 +1,40 @@+name: helm+version: 0.1.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.+homepage: http://github.com/z0w0/helm+bug-reports: http://github.com/z0w0/helm/issues+license: MIT+license-file: LICENSE+tested-with: GHC == 7.6.3+extra-source-files: LICENSE, README.md+author: Zack Corr+maintainer: Zack Corr <zack@z0w0.me>+copyright: (c) 2013, Zack Corr+category: Game Engine+build-type: Simple+cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/z0w0/helm.git++library+ exposed-modules:+ FRP.Helm+ FRP.Helm.Color+ FRP.Helm.Graphics+ FRP.Helm.Keyboard+ FRP.Helm.Mouse+ FRP.Helm.Window+ build-depends:+ base >= 4 && < 5,+ cairo >= 0.12.4 && < 1,+ containers >= 0.5.0.0 && < 1,+ elerea >= 2.7.0.1 && < 3,+ filepath >= 1.3.0.1 && < 2,+ SDL >= 0.6.4 && < 1+ default-language: Haskell2010+ default-extensions: RecordWildCards, NamedFieldPuns+ ghc-options: -Wall