helm 0.6.0 → 0.6.1
raw patch · 5 files changed
+41/−36 lines, 5 filesdep +cpudep +textdep ~cairodep ~pango
Dependencies added: cpu, text
Dependency ranges changed: cairo, pango
Files
- helm.cabal +7/−5
- src/FRP/Helm.hs +28/−25
- src/FRP/Helm/Mouse.hs +3/−3
- src/FRP/Helm/Time.hs +1/−1
- src/FRP/Helm/Window.hs +2/−2
helm.cabal view
@@ -1,5 +1,5 @@ name: helm-version: 0.6.0+version: 0.6.1 synopsis: A functionally reactive game engine. description: A functionally reactive game engine, with headgear to protect you from the headache of game development provided.@@ -24,7 +24,7 @@ hs-source-dirs: src default-language: Haskell2010 default-extensions: RecordWildCards, NamedFieldPuns- ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O2+ ghc-options: -Wall -fno-warn-unused-do-bind exposed-modules: FRP.Helm@@ -41,15 +41,17 @@ build-depends: base >= 4 && < 5,- cairo >= 0.12 && < 1,- pango >= 0.12 && < 1,+ cairo > 0.12 && < 0.13,+ pango > 0.12 && < 0.13, containers >= 0.5 && < 1, elerea >= 2.7 && < 3, filepath >= 1.3 && < 2, sdl2 >= 1.1 && < 2,+ text >= 1.1.1.3, random >= 1.0.1.1 && < 1.2, mtl >= 2.1 && < 2.2,- transformers >= 0.3.0.0+ transformers >= 0.3.0.0,+ cpu >= 0.1.2 && < 1 if impl(ghc < 7.6) build-depends: ghc-prim
src/FRP/Helm.hs view
@@ -35,6 +35,7 @@ import qualified FRP.Helm.Utilities (lift) import FRP.Helm.Time (Time) import System.FilePath+import System.Endian import qualified Data.Map as Map import qualified Graphics.UI.SDL as SDL import qualified Graphics.Rendering.Cairo as Cairo@@ -79,7 +80,7 @@ wflags = foldl (.|.) 0 $ [SDL.windowFlagShown] ++ [SDL.windowFlagResizable | windowIsResizable] ++ [SDL.windowFlagFullscreen | windowIsFullscreen]- rflags = (.|.) (SDL.rendererFlagPresentVSync) (SDL.rendererFlagAccelerated)+ rflags = (.|.) SDL.rendererFlagPresentVSync SDL.rendererFlagAccelerated {-| Initializes and runs the game engine. The supplied signal generator is constantly sampled for an element to render until the user quits.@@ -102,9 +103,7 @@ run' engine smp = do continue <- run'' - when continue $ do- smp >>= render engine- run' engine smp+ when continue $ smp >>= render engine >>= flip run' smp {-| A utility function called by 'run\'' that polls all SDL events off the stack, returning true if the game should keep running,@@ -122,9 +121,10 @@ else return True + {-| A utility function that renders a previously sampled element using an engine state. -}-render :: Engine -> Element -> IO ()+render :: Engine -> Element -> IO Engine render engine@(Engine { .. }) element = alloca $ \wptr -> alloca $ \hptr -> alloca $ \pixelsptr ->@@ -134,34 +134,37 @@ w <- fromIntegral <$> peek wptr h <- fromIntegral <$> peek hptr - -- We have to use a temporary constant here because the low-level SDL2 bindings- -- don't seem to expose pixel format constants- texture <- SDL.createTexture renderer 372645892 SDL.textureAccessStreaming (fromIntegral w) (fromIntegral h)+ format <- SDL.masksToPixelFormatEnum 32 (fromBE32 0x0000ff00) (fromBE32 0x00ff0000) (fromBE32 0xff000000) (fromBE32 0x000000ff)+ texture <- SDL.createTexture renderer format SDL.textureAccessStreaming (fromIntegral w) (fromIntegral h) SDL.lockTexture texture nullPtr pixelsptr pitchptr pixels <- peek pixelsptr pitch <- fromIntegral <$> peek pitchptr - Cairo.withImageSurfaceForData (castPtr pixels) Cairo.FormatARGB32 w h pitch $ \surface ->+ res <- Cairo.withImageSurfaceForData (castPtr pixels) Cairo.FormatARGB32 w h pitch $ \surface -> Cairo.renderWith surface (evalStateT (render' w h element) engine) SDL.unlockTexture texture SDL.renderClear renderer SDL.renderCopy renderer texture nullPtr nullPtr+ SDL.destroyTexture texture SDL.renderPresent renderer + return res + {-| A utility function called by 'render' that is called by Cairo when it's ready to do rendering. -}-render' :: Int -> Int -> Element -> Helm ()+render' :: Int -> Int -> Element -> Helm Engine render' w h element = do lift $ do Cairo.setSourceRGB 0 0 0 Cairo.rectangle 0 0 (fromIntegral w) (fromIntegral h) Cairo.fill renderElement element+ get {-| A utility function that lazily grabs an image surface from the cache, i.e. creating it if it's not already stored in it. -}@@ -195,7 +198,7 @@ Cairo.clip forM_ center $ uncurry Cairo.translate mapM_ renderForm forms- lift $ Cairo.restore+ lift Cairo.restore renderElement (ImageElement (sx, sy) sw sh src stretch) = do (surface, w, h) <- getSurface (normalise src)@@ -215,7 +218,7 @@ Cairo.restore renderElement (TextElement (Text { textColor = (Color r g b a), .. })) = do- lift $ Cairo.save+ lift Cairo.save layout <- lift $ Pango.createLayout textUTF8 @@ -254,7 +257,7 @@ withTransform s t x y f = do lift $ Cairo.save >> Cairo.scale s s >> Cairo.translate x y >> Cairo.rotate t f- lift $ Cairo.restore+ lift Cairo.restore {-| A utility function that sets the Cairo line cap based off of our version. -} setLineCap :: LineCap -> Cairo.Render ()@@ -286,9 +289,9 @@ to render with a fill style and then fills afterwards. Assumes that all drawing paths have already been setup before being called. -} setFillStyle :: FillStyle -> Helm ()-setFillStyle (Solid (Color r g b a)) = do- lift $ do Cairo.setSourceRGBA r g b a- Cairo.fill+setFillStyle (Solid (Color r g b a)) = lift $ do+ Cairo.setSourceRGBA r g b a+ Cairo.fill setFillStyle (Texture src) = do (surface, _, _) <- getSurface (normalise src)@@ -313,23 +316,23 @@ renderForm :: Form -> Helm () renderForm Form { .. } = withTransform formScale formTheta formX formY $ case formStyle of- PathForm style ~ps @ ((hx, hy) : _) -> do- lift $ do Cairo.newPath- Cairo.moveTo hx hy- mapM_ (uncurry Cairo.lineTo) ps- setLineStyle style+ PathForm style ~ps @ ((hx, hy) : _) -> lift $ do+ Cairo.newPath+ Cairo.moveTo hx hy+ mapM_ (uncurry Cairo.lineTo) ps+ setLineStyle style ShapeForm style shape -> do- lift $ Cairo.newPath+ lift Cairo.newPath case shape of- PolygonShape ~ps @ ((hx, hy) : _) -> do+ PolygonShape ~ps @ ((hx, hy) : _) -> lift $ do Cairo.moveTo hx hy mapM_ (uncurry Cairo.lineTo) ps RectangleShape (w, h) -> lift $ Cairo.rectangle (-w / 2) (-h / 2) w h - ArcShape (cx, cy) a1 a2 r (sx, sy) -> do+ ArcShape (cx, cy) a1 a2 r (sx, sy) -> lift $ do Cairo.scale sx sy Cairo.arc cx cy r a1 a2 Cairo.scale 1 1@@ -341,4 +344,4 @@ lift $ do Cairo.save forM_ mayhaps Cairo.setMatrix mapM_ renderForm forms- lift $ Cairo.restore+ lift Cairo.restore
src/FRP/Helm/Mouse.hs view
@@ -50,11 +50,11 @@ {-| The current x-coordinate of the mouse. -} x :: SignalGen (Signal Int)-x = (\(x_, _) -> x_) <~ position+x = fst <~ position {-| The current y-coordinate of the mouse. -} y :: SignalGen (Signal Int)-y = (\(_, y_) -> y_) <~ position+y = snd <~ position {-| The current state of a certain mouse button. True if the mouse is down, false otherwise. -}@@ -62,4 +62,4 @@ isDown m = effectful $ do flags <- SDL.getMouseState nullPtr nullPtr - return $ ((.&.) (fromIntegral flags) (fromEnum m)) /= 0+ return $ (.&.) (fromIntegral flags) (fromEnum m) /= 0
src/FRP/Helm/Time.hs view
@@ -72,7 +72,7 @@ {-| A utility function that does the real magic for 'delta'. -} delta' :: Signal Time -> SignalGen (Signal Time)-delta' t = (fmap . fmap) ((*) millisecond . snd) $ transfer (0, 0) (\t2 (t1, _) -> (t2, t2 - t1)) t+delta' t = fmap ((*) millisecond . snd) <$> transfer (0, 0) (\ t2 (t1, _) -> (t2, t2 - t1)) t {-| A signal that blocks the game thread for a certain amount of time when sampled and then returns the amount of time it blocked for. Please note that delaying by values smaller than 1 millisecond can have
src/FRP/Helm/Window.hs view
@@ -22,8 +22,8 @@ return (fromIntegral w, fromIntegral h) {-| The current width of the window. -} width :: Engine -> SignalGen (Signal Int)-width engine = (\(w, _) -> w) <~ dimensions engine+width engine = fst <~ dimensions engine {-| The current height of the window. -} height :: Engine -> SignalGen (Signal Int)-height engine = (\(_, h) -> h) <~ dimensions engine+height engine = snd <~ dimensions engine