diff --git a/FRP/Helm.hs b/FRP/Helm.hs new file mode 100644 --- /dev/null +++ b/FRP/Helm.hs @@ -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 () diff --git a/FRP/Helm/Color.hs b/FRP/Helm/Color.hs new file mode 100644 --- /dev/null +++ b/FRP/Helm/Color.hs @@ -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 diff --git a/FRP/Helm/Graphics.hs b/FRP/Helm/Graphics.hs new file mode 100644 --- /dev/null +++ b/FRP/Helm/Graphics.hs @@ -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 diff --git a/FRP/Helm/Keyboard.hs b/FRP/Helm/Keyboard.hs new file mode 100644 --- /dev/null +++ b/FRP/Helm/Keyboard.hs @@ -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 diff --git a/FRP/Helm/Mouse.hs b/FRP/Helm/Mouse.hs new file mode 100644 --- /dev/null +++ b/FRP/Helm/Mouse.hs @@ -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) + -} diff --git a/FRP/Helm/Window.hs b/FRP/Helm/Window.hs new file mode 100644 --- /dev/null +++ b/FRP/Helm/Window.hs @@ -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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/helm.cabal b/helm.cabal new file mode 100644 --- /dev/null +++ b/helm.cabal @@ -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 +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