sdl2-compositor 1.0.0.1 → 1.0.1
raw patch · 3 files changed
+127/−14 lines, 3 filesdep ~lineardep ~transformers
Dependency ranges changed: linear, transformers
Files
- SDL/Compositor.hs +66/−6
- example.hs +53/−0
- sdl2-compositor.cabal +8/−8
SDL/Compositor.hs view
@@ -21,6 +21,8 @@ , Blender (..) , Manipulator (..) , Drawer (..)+ -- * Utility+ , withZIndex -- * Implementation , CompositingNode , sizedCompositingLeaf@@ -29,6 +31,7 @@ where import Control.Monad.Trans.State+import Data.List import Data.Maybe import Data.Word import Foreign.C.Types@@ -57,33 +60,69 @@ | Flipped (V2 Bool) (CompositingNode a) | Rotated Double (CompositingNode a) | Translated (V2 Int) (CompositingNode a)+ | NoOP deriving (Show,Read,Eq) --- | Create a Graphics object with the given size.+-- | Create a Graphics object with the given size on the rendering+-- surface. sizedCompositingLeaf :: V2 Int -> a -> CompositingNode a sizedCompositingLeaf = Sized instance Manipulator (CompositingNode a) where+ modulateAlphaM _ NoOP = NoOP modulateAlphaM modulator node = AlphaMod (fromIntegral modulator) node+ modulateRedM _ NoOP = NoOP modulateRedM modulator node = RedMod (fromIntegral modulator) node+ modulateGreenM _ NoOP = NoOP modulateGreenM modulator node = GreenMod (fromIntegral modulator) node+ modulateBlueM _ NoOP = NoOP modulateBlueM modulator node = BlueMod (fromIntegral modulator) node instance Blender (CompositingNode a) where- overrideBlendMode = OverrideBlendMode- preserveBlendMode = PreserveBlendMode+ overrideBlendMode _ NoOP = NoOP+ overrideBlendMode mode node = OverrideBlendMode mode node+ preserveBlendMode _ NoOP = NoOP+ preserveBlendMode mode node = PreserveBlendMode mode node instance Compositor (CompositingNode a) where+ node1 `overC` NoOP = node1+ NoOP `overC` node2 = node2 node1 `overC` node2 = node2 `Under` node1 rotateC = Rotated- translateC = Translated- flipC = Flipped+ translateC _ NoOP = NoOP+ translateC v node = Translated v node+ flipC _ NoOP = NoOP+ flipC f node = Flipped f node instance Drawer (CompositingNode a) where rectangleC = Rectangle filledRectangleC = FilledRectangle lineC = Line +-- | 'mempty' represents no painting at all. Also+--+-- prop> mappend a b == overC a b+instance Monoid (CompositingNode a) where+ mempty = NoOP+ mappend = flip overC++instance Functor CompositingNode where+ fun `fmap` (Sized vec a) = Sized vec (fun a)+ fun `fmap` (AlphaMod d n) = AlphaMod d (fun `fmap` n)+ fun `fmap` (RedMod d n) = RedMod d (fun `fmap` n)+ fun `fmap` (GreenMod d n) = GreenMod d (fun `fmap` n)+ fun `fmap` (BlueMod d n) = BlueMod d (fun `fmap` n)+ fun `fmap` (OverrideBlendMode b n) = OverrideBlendMode b (fun `fmap` n)+ fun `fmap` (PreserveBlendMode b n) = PreserveBlendMode b (fun `fmap` n)+ fun `fmap` (x1 `Under` x2) = (fun `fmap` x1) `Under` (fun `fmap` x2)+ fun `fmap` (Flipped f n) = Flipped f (fun `fmap` n)+ fun `fmap` (Rotated d n) = Rotated d (fun `fmap` n)+ fun `fmap` (Translated vec n) = Translated vec (fun `fmap` n)+ _ `fmap` NoOP = NoOP+ _ `fmap` (FilledRectangle rect color) = FilledRectangle rect color+ _ `fmap` (Rectangle rect color) = FilledRectangle rect color+ _ `fmap` (Line vec color) = FilledRectangle vec color+ infixr 5 `overC` class Compositor c where@@ -92,6 +131,27 @@ translateC :: V2 Int -> c -> c flipC :: V2 Bool -> c -> c +-- | Arrange all given compositions in one composition.+--+-- This function takes a list of pairs where the first element of the+-- pair is the z-index and the second element is the composition.+-- Elements of with a higher z-index will be rendered "in front of"+-- elements with lower indices. If elements have the same index then+-- the element that comes first in the list will be drawn over all the+-- later ones.+--+-- This method can only arrange compositions that are in the "the same+-- list of arguments". That means that+--+-- > withZIndex [(1,a),(2,b)] `overC` withZIndex [(3,c)]+--+-- will always result in @b@ being rendered "in front of" @a@ and @c@,+-- no matter how large the z-index of @c@ is.+withZIndex :: (Compositor c, Monoid c) =>+ [(Int,c)] -> c+withZIndex = go.map snd.sortOn (negate.fst) where+ go cs = foldl overC mempty cs+ type RenderEnv t a = StateT (RendState t) IO a data RendState t = RendState { alphaMod :: Double , redMod :: Double@@ -125,6 +185,7 @@ evalStateT (renderNode node) (defaultState target) renderNode :: CompositingNode SDL.Texture -> RenderEnv SDL.Renderer ()+renderNode NoOP = return () renderNode (AlphaMod m node) = withAlphaMod m (renderNode node) renderNode (RedMod m node) = withRedMod m (renderNode node) renderNode (GreenMod m node) = withGreenMod m (renderNode node)@@ -272,7 +333,6 @@ SDL.textureAlphaMod tex $= oldAlpha SDL.textureColorMod tex $= oldRGB SDL.textureBlendMode tex $= oldBlend--- liftIO $ print oldBlend return result rotateV2 :: Double -> V2 Double -> V2 Double
+ example.hs view
@@ -0,0 +1,53 @@++import Control.Concurrent (threadDelay)+import Data.Text (pack)+import Linear.V2 (V2(..))+import Linear.V4 (V4(..))+import SDL (initialize, InitFlag(InitVideo), createWindow, defaultWindow,+ createRenderer, RendererConfig(rendererTargetTexture), defaultRenderer,+ rendererLogicalSize, ($=), present, clear, quit,+ BlendMode(BlendAlphaBlend))+import SDL.Compositor (filledRectangleC, rotateC, translateC, runRenderer, overC,+ modulateAlphaM, preserveBlendMode)++main :: IO ()+main = do+ -- intialize SDL+ initialize [InitVideo]+ -- create a window+ window <- createWindow (pack "test window") defaultWindow+ -- create a renderer for the window+ rend <- createRenderer window (-1) (defaultRenderer {rendererTargetTexture = True})+ -- set the logical size of the window to 800x600+ rendererLogicalSize rend $= (Just (V2 800 600))+ -- clear the renderer+ clear rend+ let+ -- 3 rectangles, one in red, one in green and one in blue, width:+ -- 100, height 150+ rectRed = filledRectangleC (V2 100 150) (V4 255 100 100 255)+ rectGreen = filledRectangleC (V2 100 150) (V4 100 255 100 255)+ rectBlue = filledRectangleC (V2 100 150) (V4 100 100 255 255)+ -- translate an image by (250,300) pixels+ translateToCenter = translateC (V2 250 300)+ -- draw everything+ runRenderer rend+ ( ( -- enable alpha blending for the whole subtree+ preserveBlendMode BlendAlphaBlend .+ -- make all the images slightly transparent+ modulateAlphaM 150 .+ -- align the images in the center+ translateToCenter+ )+ ( -- red, green and blue+ rectRed `overC`+ translateC (V2 150 0) (rectGreen `overC`+ translateC (V2 150 0) rectBlue)+ )+ )+ -- show the drawn image on the screen+ present rend+ -- pause for 5 seconds+ threadDelay (5 * (10::Int)^(6::Int))+ -- quit SDL+ quit
sdl2-compositor.cabal view
@@ -1,8 +1,8 @@--- Initial sdl2-compositor.cabal generated by cabal init. For further +-- Initial sdl2-compositor.cabal generated by cabal init. For further -- documentation, see http://haskell.org/cabal/users-guide/ name: sdl2-compositor-version: 1.0.0.1+version: 1.0.1 synopsis: image compositing with sdl2 - declarative style description: This package provides tools for simple image composition@@ -17,7 +17,7 @@ copyright: (c) 2015 Sebastian Jordan category: Graphics build-type: Simple--- extra-source-files: +extra-source-files: example.hs cabal-version: >=1.10 library@@ -25,13 +25,13 @@ SDL.Compositor.Manipulator, SDL.Compositor.Blender, SDL.Compositor.Drawer- -- other-modules: - -- other-extensions: + -- other-modules:+ -- other-extensions: build-depends: base >=4.8 && <4.9, sdl2 == 2.*,- transformers,- linear- -- hs-source-dirs: + transformers == 0.4.*,+ linear == 1.19.*+ -- hs-source-dirs: default-language: Haskell2010 source-repository head