diagrams-cairo 1.0.1.2 → 1.1
raw patch · 7 files changed
+195/−26 lines, 7 filesdep +JuicyPixelsdep +bytestringdep +optparse-applicativedep ~diagrams-coredep ~diagrams-libdep ~lens
Dependencies added: JuicyPixels, bytestring, optparse-applicative, vector
Dependency ranges changed: diagrams-core, diagrams-lib, lens, unix
Files
- CHANGES.markdown +19/−0
- LICENSE +1/−0
- diagrams-cairo.cabal +11/−6
- src/Diagrams/Backend/Cairo/CmdLine.hs +139/−7
- src/Diagrams/Backend/Cairo/Internal.hs +15/−7
- src/Diagrams/Backend/Cairo/List.hs +2/−1
- src/Diagrams/Backend/Cairo/Ptr.hs +8/−5
CHANGES.markdown view
@@ -1,3 +1,22 @@+1.1 (8 March 2014)+------------------++* **New features**++ - It is now possible to directly output animated GIFs, using the+ `gifMain` function.++* **Dependency/version changes**++ - allow `diagrams-core-1.1` and `diagrams-lib-1.1`+ - allow `unix-2.7`+ - allow `vector-0.10`++* **Bug fixes**++ - Don't explicitly draw final segment of a loop if it is straight+ ([#38](https://github.com/diagrams/diagrams-cairo/issues/38))+ 1.0.1.2 (6 February 2014) -------------------------
LICENSE view
@@ -9,6 +9,7 @@ Michael Sloan <mgsloan@gmail.com> Luite Stegeman <stegeman@gmail.com> Kanchalai Suveepattananont <ksuvee@seas.upenn.edu>+ Robert Vollmert <rvollmert@gmx.net> Ryan Yates <fryguybob@gmail.com> Brent Yorgey <byorgey@cis.upenn.edu>
diagrams-cairo.cabal view
@@ -1,5 +1,5 @@ Name: diagrams-cairo-Version: 1.0.1.2+Version: 1.1 Synopsis: Cairo backend for diagrams drawing EDSL Description: A full-featured backend for rendering diagrams using the cairo rendering engine.@@ -35,7 +35,7 @@ Build-type: Simple Cabal-version: >=1.10 Extra-source-files: CHANGES.markdown, README.markdown-Tested-with: GHC == 7.4.2, GHC == 7.6.1+Tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.1 Source-repository head type: git location: http://github.com/diagrams/diagrams-cairo.git@@ -55,20 +55,25 @@ filepath, old-time, time,- diagrams-core >= 1.0 && < 1.1,- diagrams-lib >= 1.0.1 && < 1.1,+ diagrams-core >= 1.0 && < 1.2,+ diagrams-lib >= 1.0.1 && < 1.2, cairo >= 0.12.4 && < 0.13, colour, split >= 0.1.2 && < 0.3, containers >= 0.3 && < 0.6,- lens >= 3.8 && < 4,+ lens >= 3.8 && < 4.1, data-default-class >= 0.0.1 && < 0.1, statestack >= 0.2 && < 0.3,+ JuicyPixels >= 3.1.3.2 && < 3.2,+ vector >= 0.10.0 && < 0.11,+ bytestring >= 0.9 && < 0.11,+ optparse-applicative >= 0.7 && < 0.8, hashable >= 1.1 && < 1.3 if impl(ghc < 7.6) Build-depends: ghc-prim+ default-language: Haskell2010 if !os(windows) cpp-options: -DCMDLINELOOP- Build-depends: unix >= 2.4 && < 2.7+ Build-depends: unix >= 2.4 && < 2.8
src/Diagrams/Backend/Cairo/CmdLine.hs view
@@ -1,6 +1,7 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -23,9 +24,11 @@ -- * 'animMain' is like 'defaultMain' but for animations instead of -- diagrams. --+-- * `gifMain` creates an executable to generate an animated GIF.+-- -- * 'mainWith' is a generic form that does all of the above but with -- a slightly scarier type. See "Diagrams.Backend.CmdLine". This--- form can also take a function type that has a subtable final result+-- form can also take a function type that has a suitable final result -- (any of arguments to the above types) and 'Parseable' arguments. -- -- If you want to generate diagrams programmatically---/i.e./ if you@@ -67,17 +70,32 @@ , defaultMain , multiMain , animMain+ , gifMain + -- * GIF support++ , GifOpts(..)+ -- * Backend tokens , Cairo , B ) where -import Control.Lens ((^.),Lens')+import Codec.Picture+import Codec.Picture.ColorQuant (defaultPaletteOptions)+import Data.Vector.Storable (unsafeFromForeignPtr0)+import Foreign.ForeignPtr.Safe (ForeignPtr)+import qualified Data.ByteString.Lazy as L (ByteString, writeFile)+import Data.Word (Word8)+import Options.Applicative -import Diagrams.Prelude hiding (width, height, interval)+import Control.Lens ((^.), Lens', makeLenses)++import Diagrams.Prelude hiding (width, height, interval, Image, (<>)+ , option) import Diagrams.Backend.Cairo+import Diagrams.Backend.Cairo.Ptr (renderForeignPtrOpaque) import Diagrams.Backend.CmdLine -- Below hack is needed because GHC 7.0.x has a bug regarding export@@ -293,7 +311,6 @@ mainRender = defaultAnimMainRender output' - #ifdef CMDLINELOOP waitForChange :: Maybe ModuleTime -> DiagramLoopOpts -> IO () waitForChange lastAttempt opts = do@@ -342,3 +359,118 @@ where getModTime f = catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing) #endif++-- | @gifMain@ takes a list of diagram and delay time pairs and produces a+-- command line program to generate an animated GIF, with options @GifOpts@.+-- "Delay times are in 1/100ths of a second."+--+-- Example usage:+--+-- @+-- $ ghc --make GifTest+-- [1 of 1] Compiling Main ( GifTest.hs, GifTest.o )+-- Linking GifTest ...+-- ./GifTest --help+-- GifTest+--+-- Usage: GifTest [-w|--width WIDTH] [-h|--height HEIGHT] [-o|--output OUTPUT]+-- [--dither] [--looping-off] [--loop-repeat ARG]+-- Command-line diagram generation.+--+-- Available options:+-- -?,--help Show this help text+-- -w,--width WIDTH Desired WIDTH of the output image+-- -h,--height HEIGHT Desired HEIGHT of the output image+-- -o,--output OUTPUT OUTPUT file+-- --dither Turn on dithering.+-- --looping-off Turn looping off+-- --loop-repeat ARG Number of times to repeat+-- @+gifMain :: [(Diagram Cairo R2, GifDelay)] -> IO ()+gifMain = mainWith++-- | Extra options for animated GIFs.+data GifOpts = GifOpts { _dither :: Bool+ , _noLooping :: Bool+ , _loopRepeat :: Maybe Int}++makeLenses ''GifOpts++-- | Command line parser for 'GifOpts'.+-- @--dither@ turn dithering on.+-- @--looping-off@ turn looping off, i.e play GIF once.+-- @--loop-repeat@ number of times to repeat the GIF after the first playing.+-- this option is only used if @--looping-off@ is not set.+instance Parseable GifOpts where+ parser = GifOpts <$> switch+ ( long "dither"+ <> help "Turn on dithering." )+ <*> switch+ ( long "looping-off"+ <> help "Turn looping off" )+ <*> ( optional . option )+ ( long "loop-repeat"+ <> help "Number of times to repeat" )++instance Mainable [(Diagram Cairo R2, GifDelay)] where+ type MainOpts [(Diagram Cairo R2, GifDelay)] = (DiagramOpts, GifOpts)++ mainRender (dOpts, gOpts) ds = gifRender (dOpts, gOpts) ds++imageRGB8FromUnsafePtr :: Int -> Int -> ForeignPtr Word8 -> Image PixelRGB8+imageRGB8FromUnsafePtr w h ptr = pixelMap f cImg+ where+ f (PixelRGBA8 b g r _) = PixelRGB8 r g b+ cImg = Image w h $ unsafeFromForeignPtr0 ptr (w * h * 4)+++encodeGifAnimation' :: [GifDelay] -> GifLooping -> Bool+ -> [Image PixelRGB8] -> Either String (L.ByteString)+encodeGifAnimation' delays looping dithering lst =+ encodeGifImages looping triples+ where+ triples = zipWith (\(x,z) y -> (x, y, z)) doubles delays+ doubles = [(pal, img)+ | (img, pal) <- palettize+ defaultPaletteOptions {enableImageDithering=dithering} <$> lst]++writeGifAnimation' :: FilePath -> [GifDelay] -> GifLooping -> Bool+ -> [Image PixelRGB8] -> Either String (IO ())+writeGifAnimation' path delays looping dithering img =+ L.writeFile path <$> encodeGifAnimation' delays looping dithering img++scaleInt :: Int -> Double -> Double -> Int+scaleInt i num denom+ | num == 0 || denom == 0 = i+ | otherwise = round (num / denom * fromIntegral i)++gifRender :: (DiagramOpts, GifOpts) -> [(Diagram Cairo R2, GifDelay)] -> IO ()+gifRender (dOpts, gOpts) lst =+ case splitOn "." (dOpts^.output) of+ [""] -> putStrLn "No output file given"+ ps | last ps == "gif" -> do+ let (w, h) = case (dOpts^.width, dOpts^.height) of+ (Just w', Just h') -> (w', h')+ (Just w', Nothing) -> (w', scaleInt w' diaHeight diaWidth)+ (Nothing, Just h') -> (scaleInt h' diaWidth diaHeight, h')+ (Nothing, Nothing) -> (100, 100)+ looping = if gOpts^.noLooping+ then LoopingNever+ else case gOpts^.loopRepeat of+ Nothing -> LoopingForever+ Just n -> LoopingRepeat (fromIntegral n)+ dias = map fst lst+ delays = map snd lst+ (diaWidth, diaHeight) = size2D (head dias)+ fPtrs <- mapM (renderForeignPtrOpaque w h) dias+ let imageRGB8s = map (imageRGB8FromUnsafePtr w h) fPtrs+ result = writeGifAnimation'+ (dOpts^.output)+ delays+ looping+ (gOpts^.dither)+ imageRGB8s+ case result of+ Left s -> putStrLn s+ Right io -> io+ | otherwise -> putStrLn $ "File name must end with .gif"
src/Diagrams/Backend/Cairo/Internal.hs view
@@ -304,15 +304,23 @@ = C . liftC $ C.relCurveTo x1 y1 x2 y2 x3 y3 instance Renderable (Trail R2) Cairo where- render _ t = flip withLine t $ renderT . lineSegments+ render _ = withTrail renderLine renderLoop where- renderT segs =- C $ do- mapM_ renderC segs- liftC $ when (isLoop t) C.closePath+ renderLine ln = C $ do+ mapM_ renderC (lineSegments ln) - when (isLine t) (ignoreFill .= True)- -- remember that we saw a Line, so we will ignore fill attribute+ -- remember that we saw a Line, so we will ignore fill attribute+ ignoreFill .= True++ renderLoop lp = C $ do+ case loopSegments lp of+ -- let closePath handle the last segment if it is linear+ (segs, Linear _) -> mapM_ renderC segs++ -- otherwise we have to draw it explicitly+ _ -> mapM_ renderC (lineSegments . cutLoop $ lp)++ liftC C.closePath instance Renderable (Path R2) Cairo where render _ p = C $ do
src/Diagrams/Backend/Cairo/List.hs view
@@ -22,6 +22,7 @@ import Diagrams.Backend.Cairo (Cairo) import Diagrams.Backend.Cairo.Ptr (renderPtr)+import Graphics.Rendering.Cairo (Format (..)) import Diagrams.Prelude (Diagram, R2) import Foreign.Marshal.Alloc (free)@@ -32,7 +33,7 @@ renderToList :: (Ord a, Floating a) => Int -> Int -> Diagram Cairo R2 -> IO [[AlphaColour a]] renderToList w h d =- f 0 <$> bracket (renderPtr w h d) free (peekArray $ w*h*4)+ f 0 <$> bracket (renderPtr w h FormatARGB32 d) free (peekArray $ w*h*4) where f :: (Ord a, Floating a) => Int -> [Word8] -> [[AlphaColour a]] f _ [] = []
src/Diagrams/Backend/Cairo/Ptr.hs view
@@ -31,9 +31,9 @@ -- | Render a diagram to a new buffer in memory, with the format ARGB32. -renderPtr :: Int -> Int -> Diagram Cairo R2 -> IO (Ptr Word8)-renderPtr w h d = do- let stride = formatStrideForWidth FormatARGB32 w+renderPtr :: Int -> Int -> Format -> Diagram Cairo R2 -> IO (Ptr Word8)+renderPtr w h fmt d = do+ let stride = formatStrideForWidth fmt w size = stride * h opt = CairoOptions { _cairoSizeSpec = Dims (fromIntegral w) (fromIntegral h)@@ -45,11 +45,14 @@ b <- mallocArray size pokeArray b (replicate size 0)- withImageSurfaceForData b FormatARGB32 w h stride (`renderWith` r)+ withImageSurfaceForData b fmt w h stride (`renderWith` r) return (castPtr b) -- | Like 'renderPtr' but automatically garbage collected by Haskell. renderForeignPtr :: Int -> Int -> Diagram Cairo R2 -> IO (ForeignPtr Word8)-renderForeignPtr w h d = renderPtr w h d >>= newForeignPtr finalizerFree+renderForeignPtr w h d = renderPtr w h FormatARGB32 d >>= newForeignPtr finalizerFree++renderForeignPtrOpaque :: Int -> Int -> Diagram Cairo R2 -> IO (ForeignPtr Word8)+renderForeignPtrOpaque w h d = renderPtr w h FormatRGB24 d >>= newForeignPtr finalizerFree