{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeFamilies      #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Backend.Cairo.CmdLine
-- Copyright   :  (c) 2013 Diagrams-cairo team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Convenient creation of command-line-driven executables for
-- rendering diagrams using the cairo backend.
--
-- * 'defaultMain' creates an executable which can render a single
--   diagram at various options.
--
-- * 'multiMain' is like 'defaultMain' but allows for a list of
--   diagrams from which the user can choose one to render.
--
-- * '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 suitable final result
--   (any of arguments to the above types) and 'Parseable' arguments.
--
-- If you want to generate diagrams programmatically---/i.e./ if you
-- want to do anything more complex than what the below functions
-- provide---you have several options.
--
-- * Use a function with 'mainWith'.  This may require making
--   'Parseable' instances for custom argument types.
--
-- * Make a new 'Mainable' instance.  This may require a newtype
--   wrapper on your diagram type to avoid the existing instances.
--   This gives you more control over argument parsing, intervening
--   steps, and diagram creation.
--
-- * Build option records and pass them along with a diagram to 'mainRender'
--   from "Diagrams.Backend.CmdLine".
--
-- * A more flexible approach is to use the 'renderCairo' function
--   provided in the "Diagrams.Backend.Cairo" module.
--
-- * For the most flexibility, you can call the generic 'renderDia'
--   function directly; see "Diagrams.Backend.Cairo" for more
--   information.
--
-- For a tutorial on command-line diagram creation see
-- <http://projects.haskell.org/diagrams/doc/cmdline.html>.
--
-----------------------------------------------------------------------------

module Diagrams.Backend.Cairo.CmdLine
       (
         -- * General form of @main@
         -- $mainwith

         mainWith

         -- * Supported forms of @main@

       , defaultMain
       , multiMain
       , animMain
       , gifMain

        -- * GIF support

        , GifOpts(..)
        , gifRender

        -- * Backend tokens

       , Cairo
       , B
       ) where

import           Codec.Picture
import           Codec.Picture.ColorQuant        (defaultPaletteOptions)
import qualified Data.ByteString.Lazy            as L (ByteString, writeFile)
import           Data.Vector.Storable            (unsafeFromForeignPtr0)
import           Data.Word                       (Word8)
import           Options.Applicative

import           Diagrams.Backend.Cairo
import           Diagrams.Backend.Cairo.Ptr      (renderForeignPtrOpaque)
import           Diagrams.Backend.CmdLine
import           Diagrams.Prelude                hiding (height, interval,
                                                  option, output, width)

-- Below hack is needed because GHC 7.0.x has a bug regarding export
-- of data family constructors; see comments in Diagrams.Backend.Cairo
#if __GLASGOW_HASKELL__ < 702 || __GLASGOW_HASKELL__ >= 704
import           Diagrams.Backend.Cairo.Internal
#endif

#if __GLASGOW_HASKELL__ < 710
import           Foreign.ForeignPtr.Safe         (ForeignPtr)
#else
import           Foreign.ForeignPtr              (ForeignPtr)
#endif

import           Data.List.Split

-- $mainwith
-- The 'mainWith' method unifies all of the other forms of @main@ and is now
-- the recommended way to build a command-line diagrams program.  It works as a
-- direct replacement for 'defaultMain', 'multiMain', or 'animMain' as well as
-- allowing more general arguments.  For example, given a function that
-- produces a diagram when given an @Int@ and a @'Colour' Double@, 'mainWith'
-- will produce a program that looks for additional number and color arguments.
--
-- > ... definitions ...
-- > f :: Int -> Colour Double -> Diagram Cairo
-- > f i c = ...
-- >
-- > main = mainWith f
--
-- We can run this program as follows:
--
-- > $ ghc --make MyDiagram
-- >
-- > # output image.png built by `f 20 red`
-- > $ ./MyDiagram -o image.png -w 200 20 red


-- | This is the simplest way to render diagrams, and is intended to
--   be used like so:
--
-- > ... other definitions ...
-- > myDiagram = ...
-- >
-- > main = defaultMain myDiagram
--
--   Compiling a source file like the above example will result in an
--   executable which takes command-line options for setting the size,
--   output file, and so on, and renders @myDiagram@ with the
--   specified options.
--
--   On Unix systems, the generated executable also supports a
--   rudimentary \"looped\" mode, which watches the source file for
--   changes and recompiles itself on the fly.
--
--   Pass @--help@ to the generated executable to see all available
--   options.  Currently it looks something like
--
-- @
-- ./Program
--
-- Usage: ./Program [-w|--width WIDTH] [-h|--height HEIGHT] [-o|--output OUTPUT]
--                  [--loop] [-s|--src ARG] [-i|--interval INTERVAL]
--   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
--   -l,--loop                Run in a self-recompiling loop
--   -s,--src ARG             Source file to watch
--   -i,--interval INTERVAL   When running in a loop, check for changes every INTERVAL seconds.
-- @
--
--   For example, a couple common scenarios include
--
-- @
-- $ ghc --make MyDiagram
--
--   # output image.png with a width of 400px (and auto-determined height)
-- $ ./MyDiagram -o image.png -w 400
--
--   # output 200x200 dia.pdf, then watch for changes every 10 seconds
-- $ ./MyDiagram -o dia.pdf -h 200 -w 200 -l -i 10
-- @

defaultMain :: QDiagram Cairo V2 Double Any -> IO ()
defaultMain :: QDiagram Cairo V2 Double Any -> IO ()
defaultMain = QDiagram Cairo V2 Double Any -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

instance Mainable (QDiagram Cairo V2 Double Any) where
    type MainOpts (QDiagram Cairo V2 Double Any) = (DiagramOpts, DiagramLoopOpts)

    mainRender :: MainOpts (QDiagram Cairo V2 Double Any)
-> QDiagram Cairo V2 Double Any -> IO ()
mainRender (opts, l) d :: QDiagram Cairo V2 Double Any
d = DiagramOpts -> QDiagram Cairo V2 Double Any -> IO ()
chooseRender DiagramOpts
opts QDiagram Cairo V2 Double Any
d IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DiagramLoopOpts -> IO ()
defaultLoopRender DiagramLoopOpts
l

chooseRender :: DiagramOpts -> QDiagram Cairo V2 Double Any -> IO ()
chooseRender :: DiagramOpts -> QDiagram Cairo V2 Double Any -> IO ()
chooseRender opts :: DiagramOpts
opts d :: QDiagram Cairo V2 Double Any
d =
  case [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn "." (DiagramOpts
opts DiagramOpts -> Getting [Char] DiagramOpts [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^. Getting [Char] DiagramOpts [Char]
Lens' DiagramOpts [Char]
output) of
    [""] -> [Char] -> IO ()
putStrLn "No output file given."
    ps :: [[Char]]
ps | [[Char]] -> [Char]
forall a. [a] -> a
last [[Char]]
ps [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["png", "ps", "pdf", "svg"] -> do
           let outTy :: OutputType
outTy = case [[Char]] -> [Char]
forall a. [a] -> a
last [[Char]]
ps of
                 "png" -> OutputType
PNG
                 "ps"  -> OutputType
PS
                 "pdf" -> OutputType
PDF
                 "svg" -> OutputType
SVG
                 _     -> OutputType
PDF
           (IO (), Render ()) -> IO ()
forall a b. (a, b) -> a
fst ((IO (), Render ()) -> IO ()) -> (IO (), Render ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Cairo
-> Options Cairo V2 Double
-> QDiagram Cairo V2 Double Any
-> Result Cairo V2 Double
forall b (v :: * -> *) n m.
(Backend b v n, HasLinearMap v, Metric v, Typeable n,
 OrderedField n, Monoid' m) =>
b -> Options b v n -> QDiagram b v n m -> Result b v n
renderDia
                   Cairo
Cairo
                   ( [Char]
-> SizeSpec V2 Double
-> OutputType
-> Bool
-> Options Cairo V2 Double
CairoOptions
                     (DiagramOpts
optsDiagramOpts -> Getting [Char] DiagramOpts [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] DiagramOpts [Char]
Lens' DiagramOpts [Char]
output)
                     (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> SizeSpec V2 Int -> SizeSpec V2 Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int -> Maybe Int -> SizeSpec V2 Int
forall n. Num n => Maybe n -> Maybe n -> SizeSpec V2 n
mkSizeSpec2D
                       (DiagramOpts
opts DiagramOpts
-> Getting (Maybe Int) DiagramOpts (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Int) DiagramOpts (Maybe Int)
Lens' DiagramOpts (Maybe Int)
width )
                       (DiagramOpts
opts DiagramOpts
-> Getting (Maybe Int) DiagramOpts (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Int) DiagramOpts (Maybe Int)
Lens' DiagramOpts (Maybe Int)
height)
                     )
                     OutputType
outTy
                     Bool
False
                   )
                   QDiagram Cairo V2 Double Any
d
       | Bool
otherwise -> [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ "Unknown file type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. [a] -> a
last [[Char]]
ps

-- | @multiMain@ is like 'defaultMain', except instead of a single
--   diagram it takes a list of diagrams paired with names as input.
--   The generated executable then takes a @--selection@ option
--   specifying the name of the diagram that should be rendered.  The
--   list of available diagrams may also be printed by passing the
--   option @--list@.
--
--   Example usage:
--
-- @
-- $ ghc --make MultiTest
-- [1 of 1] Compiling Main             ( MultiTest.hs, MultiTest.o )
-- Linking MultiTest ...
-- $ ./MultiTest --list
-- Available diagrams:
--   foo bar
-- $ ./MultiTest --selection bar -o Bar.png -w 200
-- @

multiMain :: [(String, QDiagram Cairo V2 Double Any)] -> IO ()
multiMain :: [([Char], QDiagram Cairo V2 Double Any)] -> IO ()
multiMain = [([Char], QDiagram Cairo V2 Double Any)] -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

instance Mainable [(String, QDiagram Cairo V2 Double Any)] where
    type MainOpts [(String, QDiagram Cairo V2 Double Any)]
        = (MainOpts (QDiagram Cairo V2 Double Any), DiagramMultiOpts)

    mainRender :: MainOpts [([Char], QDiagram Cairo V2 Double Any)]
-> [([Char], QDiagram Cairo V2 Double Any)] -> IO ()
mainRender = MainOpts [([Char], QDiagram Cairo V2 Double Any)]
-> [([Char], QDiagram Cairo V2 Double Any)] -> IO ()
forall d.
Mainable d =>
(MainOpts d, DiagramMultiOpts) -> [([Char], d)] -> IO ()
defaultMultiMainRender

-- | @animMain@ is like 'defaultMain', but renders an animation
-- instead of a diagram.  It takes as input an animation and produces
-- a command-line program which will crudely \"render\" the animation
-- by rendering one image for each frame, named by extending the given
-- output file name by consecutive integers.  For example if the given
-- output file name is @foo\/blah.png@, the frames will be saved in
-- @foo\/blah001.png@, @foo\/blah002.png@, and so on (the number of
-- padding digits used depends on the total number of frames).  It is
-- up to the user to take these images and stitch them together into
-- an actual animation format (using, /e.g./ @ffmpeg@).
--
--   Of course, this is a rather crude method of rendering animations;
--   more sophisticated methods will likely be added in the future.
--
-- The @--fpu@ option can be used to control how many frames will be
-- output for each second (unit time) of animation.
animMain :: Animation Cairo V2 Double -> IO ()
animMain :: Animation Cairo V2 Double -> IO ()
animMain = Animation Cairo V2 Double -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

instance Mainable (Animation Cairo V2 Double) where
    type MainOpts (Animation Cairo V2 Double) = ((DiagramOpts, DiagramAnimOpts), DiagramLoopOpts)

    mainRender :: MainOpts (Animation Cairo V2 Double)
-> Animation Cairo V2 Double -> IO ()
mainRender (opts, l) d :: Animation Cairo V2 Double
d =  (DiagramOpts -> QDiagram Cairo V2 Double Any -> IO ())
-> Lens' DiagramOpts [Char]
-> (DiagramOpts, DiagramAnimOpts)
-> Animation Cairo V2 Double
-> IO ()
forall opts b (v :: * -> *) n.
(opts -> QDiagram b v n Any -> IO ())
-> Lens' opts [Char]
-> (opts, DiagramAnimOpts)
-> Animation b v n
-> IO ()
defaultAnimMainRender DiagramOpts -> QDiagram Cairo V2 Double Any -> IO ()
chooseRender Lens' DiagramOpts [Char]
output (DiagramOpts, DiagramAnimOpts)
opts Animation Cairo V2 Double
d IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DiagramLoopOpts -> IO ()
defaultLoopRender DiagramLoopOpts
l

-- | @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 :: [(QDiagram Cairo V2 Double Any, GifDelay)] -> IO ()
gifMain :: [(QDiagram Cairo V2 Double Any, Int)] -> IO ()
gifMain = [(QDiagram Cairo V2 Double Any, Int)] -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

-- | Extra options for animated GIFs.
data GifOpts = GifOpts { GifOpts -> Bool
_dither     :: Bool
                       , GifOpts -> Bool
_noLooping  :: Bool
                       , GifOpts -> Maybe Int
_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 :: Parser GifOpts
parser = Bool -> Bool -> Maybe Int -> GifOpts
GifOpts (Bool -> Bool -> Maybe Int -> GifOpts)
-> Parser Bool -> Parser (Bool -> Maybe Int -> GifOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch
                       ( [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long "dither"
                      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help "Turn on dithering." )
                   Parser (Bool -> Maybe Int -> GifOpts)
-> Parser Bool -> Parser (Maybe Int -> GifOpts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
                       ( [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long "looping-off"
                      Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod FlagFields Bool
forall (f :: * -> *) a. [Char] -> Mod f a
help "Turn looping off" )
                   Parser (Maybe Int -> GifOpts)
-> Parser (Maybe Int) -> Parser GifOpts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Int -> Parser (Maybe Int))
-> (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int
-> Parser (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto )
                       ( [Char] -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long "loop-repeat"
                      Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> [Char] -> Mod OptionFields Int
forall (f :: * -> *) a. [Char] -> Mod f a
help "Number of times to repeat" )

instance Mainable [(QDiagram Cairo V2 Double Any, GifDelay)] where
    type MainOpts [(QDiagram Cairo V2 Double Any, GifDelay)] = (DiagramOpts, GifOpts)

    mainRender :: MainOpts [(QDiagram Cairo V2 Double Any, Int)]
-> [(QDiagram Cairo V2 Double Any, Int)] -> IO ()
mainRender (dOpts, gOpts) ds :: [(QDiagram Cairo V2 Double Any, Int)]
ds = (DiagramOpts, GifOpts)
-> [(QDiagram Cairo V2 Double Any, Int)] -> IO ()
gifRender (DiagramOpts
dOpts, GifOpts
gOpts) [(QDiagram Cairo V2 Double Any, Int)]
ds

imageRGB8FromUnsafePtr :: Int -> Int -> ForeignPtr Word8 -> Image PixelRGB8
imageRGB8FromUnsafePtr :: Int -> Int -> ForeignPtr Word8 -> Image PixelRGB8
imageRGB8FromUnsafePtr w :: Int
w h :: Int
h ptr :: ForeignPtr Word8
ptr = (PixelRGBA8 -> PixelRGB8) -> Image PixelRGBA8 -> Image PixelRGB8
forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
pixelMap PixelRGBA8 -> PixelRGB8
f Image PixelRGBA8
cImg
  where
    f :: PixelRGBA8 -> PixelRGB8
f (PixelRGBA8 b :: Word8
b g :: Word8
g r :: Word8
r _) = Word8 -> Word8 -> Word8 -> PixelRGB8
PixelRGB8 Word8
r Word8
g Word8
b
    cImg :: Image PixelRGBA8
cImg = Int
-> Int
-> Vector (PixelBaseComponent PixelRGBA8)
-> Image PixelRGBA8
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
w Int
h (Vector (PixelBaseComponent PixelRGBA8) -> Image PixelRGBA8)
-> Vector (PixelBaseComponent PixelRGBA8) -> Image PixelRGBA8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Vector Word8
forall a. Storable a => ForeignPtr a -> Int -> Vector a
unsafeFromForeignPtr0 ForeignPtr Word8
ptr (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4)


encodeGifAnimation' :: [GifDelay] -> GifLooping -> Bool
                   -> [Image PixelRGB8] -> Either String L.ByteString
encodeGifAnimation' :: [Int]
-> GifLooping
-> Bool
-> [Image PixelRGB8]
-> Either [Char] ByteString
encodeGifAnimation' delays :: [Int]
delays looping :: GifLooping
looping dithering :: Bool
dithering lst :: [Image PixelRGB8]
lst =
    GifLooping
-> [(Image PixelRGB8, Int, Image Word8)]
-> Either [Char] ByteString
encodeGifImages GifLooping
looping [(Image PixelRGB8, Int, Image Word8)]
triples
      where
        triples :: [(Image PixelRGB8, Int, Image Word8)]
triples = ((Image PixelRGB8, Image Word8)
 -> Int -> (Image PixelRGB8, Int, Image Word8))
-> [(Image PixelRGB8, Image Word8)]
-> [Int]
-> [(Image PixelRGB8, Int, Image Word8)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(x :: Image PixelRGB8
x,z :: Image Word8
z) y :: Int
y -> (Image PixelRGB8
x, Int
y, Image Word8
z)) [(Image PixelRGB8, Image Word8)]
doubles [Int]
delays
        doubles :: [(Image PixelRGB8, Image Word8)]
doubles = [(Image PixelRGB8
pal, Image Word8
img)
                | (img :: Image Word8
img, pal :: Image PixelRGB8
pal) <- PaletteOptions -> Image PixelRGB8 -> (Image Word8, Image PixelRGB8)
palettize
                   PaletteOptions
defaultPaletteOptions {enableImageDithering :: Bool
enableImageDithering=Bool
dithering} (Image PixelRGB8 -> (Image Word8, Image PixelRGB8))
-> [Image PixelRGB8] -> [(Image Word8, Image PixelRGB8)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Image PixelRGB8]
lst]

writeGifAnimation' :: FilePath -> [GifDelay] -> GifLooping -> Bool
                  -> [Image PixelRGB8] -> Either String (IO ())
writeGifAnimation' :: [Char]
-> [Int]
-> GifLooping
-> Bool
-> [Image PixelRGB8]
-> Either [Char] (IO ())
writeGifAnimation' path :: [Char]
path delays :: [Int]
delays looping :: GifLooping
looping dithering :: Bool
dithering img :: [Image PixelRGB8]
img =
    [Char] -> ByteString -> IO ()
L.writeFile [Char]
path (ByteString -> IO ())
-> Either [Char] ByteString -> Either [Char] (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
-> GifLooping
-> Bool
-> [Image PixelRGB8]
-> Either [Char] ByteString
encodeGifAnimation' [Int]
delays GifLooping
looping Bool
dithering [Image PixelRGB8]
img

scaleInt :: Int -> Double -> Double -> Int
scaleInt :: Int -> Double -> Double -> Int
scaleInt i :: Int
i num :: Double
num denom :: Double
denom
  | Double
num Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| Double
denom Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Int
i
  | Bool
otherwise = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
num Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
denom Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)

gifRender :: (DiagramOpts, GifOpts) -> [(QDiagram Cairo V2 Double Any, GifDelay)] -> IO ()
gifRender :: (DiagramOpts, GifOpts)
-> [(QDiagram Cairo V2 Double Any, Int)] -> IO ()
gifRender (dOpts :: DiagramOpts
dOpts, gOpts :: GifOpts
gOpts) lst :: [(QDiagram Cairo V2 Double Any, Int)]
lst =
  case [Char] -> [Char] -> [[Char]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn "." (DiagramOpts
dOptsDiagramOpts -> Getting [Char] DiagramOpts [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] DiagramOpts [Char]
Lens' DiagramOpts [Char]
output) of
    [""] -> [Char] -> IO ()
putStrLn "No output file given"
    ps :: [[Char]]
ps | [[Char]] -> [Char]
forall a. [a] -> a
last [[Char]]
ps [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== "gif" -> do
           let (w :: Int
w, h :: Int
h) = case (DiagramOpts
dOptsDiagramOpts
-> Getting (Maybe Int) DiagramOpts (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) DiagramOpts (Maybe Int)
Lens' DiagramOpts (Maybe Int)
width, DiagramOpts
dOptsDiagramOpts
-> Getting (Maybe Int) DiagramOpts (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) DiagramOpts (Maybe Int)
Lens' DiagramOpts (Maybe Int)
height) of
                          (Just w' :: Int
w', Just h' :: Int
h') -> (Int
w', Int
h')
                          (Just w' :: Int
w', Nothing) -> (Int
w', Int -> Double -> Double -> Int
scaleInt Int
w' Double
diaHeight Double
diaWidth)
                          (Nothing, Just h' :: Int
h') -> (Int -> Double -> Double -> Int
scaleInt Int
h' Double
diaWidth Double
diaHeight, Int
h')
                          (Nothing, Nothing) -> (100, 100)
               looping :: GifLooping
looping = if GifOpts
gOptsGifOpts -> Getting Bool GifOpts Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool GifOpts Bool
Lens' GifOpts Bool
noLooping
                         then GifLooping
LoopingNever
                         else case GifOpts
gOptsGifOpts -> Getting (Maybe Int) GifOpts (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) GifOpts (Maybe Int)
Lens' GifOpts (Maybe Int)
loopRepeat of
                                Nothing -> GifLooping
LoopingForever
                                Just n :: Int
n  -> Word16 -> GifLooping
LoopingRepeat (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
               dias :: [QDiagram Cairo V2 Double Any]
dias = ((QDiagram Cairo V2 Double Any, Int)
 -> QDiagram Cairo V2 Double Any)
-> [(QDiagram Cairo V2 Double Any, Int)]
-> [QDiagram Cairo V2 Double Any]
forall a b. (a -> b) -> [a] -> [b]
map (QDiagram Cairo V2 Double Any, Int) -> QDiagram Cairo V2 Double Any
forall a b. (a, b) -> a
fst [(QDiagram Cairo V2 Double Any, Int)]
lst
               delays :: [Int]
delays = ((QDiagram Cairo V2 Double Any, Int) -> Int)
-> [(QDiagram Cairo V2 Double Any, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (QDiagram Cairo V2 Double Any, Int) -> Int
forall a b. (a, b) -> b
snd [(QDiagram Cairo V2 Double Any, Int)]
lst
               V2 diaWidth :: Double
diaWidth diaHeight :: Double
diaHeight = QDiagram Cairo V2 Double Any -> V2 Double
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a, HasBasis v) =>
a -> v n
size ([QDiagram Cairo V2 Double Any] -> QDiagram Cairo V2 Double Any
forall a. [a] -> a
head [QDiagram Cairo V2 Double Any]
dias)
           [ForeignPtr Word8]
fPtrs <- (QDiagram Cairo V2 Double Any -> IO (ForeignPtr Word8))
-> [QDiagram Cairo V2 Double Any] -> IO [ForeignPtr Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> Int -> QDiagram Cairo V2 Double Any -> IO (ForeignPtr Word8)
renderForeignPtrOpaque Int
w Int
h) [QDiagram Cairo V2 Double Any]
dias
           let imageRGB8s :: [Image PixelRGB8]
imageRGB8s = (ForeignPtr Word8 -> Image PixelRGB8)
-> [ForeignPtr Word8] -> [Image PixelRGB8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> ForeignPtr Word8 -> Image PixelRGB8
imageRGB8FromUnsafePtr Int
w Int
h) [ForeignPtr Word8]
fPtrs
               result :: Either [Char] (IO ())
result = [Char]
-> [Int]
-> GifLooping
-> Bool
-> [Image PixelRGB8]
-> Either [Char] (IO ())
writeGifAnimation'
                           (DiagramOpts
dOptsDiagramOpts -> Getting [Char] DiagramOpts [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] DiagramOpts [Char]
Lens' DiagramOpts [Char]
output)
                            [Int]
delays
                            GifLooping
looping
                           (GifOpts
gOptsGifOpts -> Getting Bool GifOpts Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool GifOpts Bool
Lens' GifOpts Bool
dither)
                            [Image PixelRGB8]
imageRGB8s
           case Either [Char] (IO ())
result of
             Left s :: [Char]
s   -> [Char] -> IO ()
putStrLn [Char]
s
             Right io :: IO ()
io -> IO ()
io
       | Bool
otherwise -> [Char] -> IO ()
putStrLn "File name must end with .gif"