{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Diagrams.Backend.Cairo.CmdLine
(
mainWith
, defaultMain
, multiMain
, animMain
, gifMain
, GifOpts(..)
, gifRender
, 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)
#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
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 :: [(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 :: 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 :: [(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
data GifOpts = GifOpts { GifOpts -> Bool
_dither :: Bool
, GifOpts -> Bool
_noLooping :: Bool
, GifOpts -> Maybe Int
_loopRepeat :: Maybe Int}
makeLenses ''GifOpts
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"