{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Diagrams.Backend.Rasterific.CmdLine
(
mainWith
, defaultMain
, multiMain
, animMain
, gifMain
, uniformGifMain
, GifOpts(..)
, Rasterific
, B
) where
import Diagrams.Backend.CmdLine
import Diagrams.Backend.Rasterific
import Diagrams.Prelude hiding (height, interval,
output, width, option)
import qualified Data.ByteString.Lazy as L (writeFile)
import Options.Applicative
defaultMain :: Diagram Rasterific -> IO ()
defaultMain :: Diagram Rasterific -> IO ()
defaultMain = forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith
instance TypeableFloat n => Mainable (QDiagram Rasterific V2 n Any) where
type MainOpts (QDiagram Rasterific V2 n Any) = (DiagramOpts, DiagramLoopOpts)
mainRender :: MainOpts (QDiagram Rasterific V2 n Any)
-> QDiagram Rasterific V2 n Any -> IO ()
mainRender (DiagramOpts
opts,DiagramLoopOpts
loopOpts) QDiagram Rasterific V2 n Any
d = do
forall n.
TypeableFloat n =>
DiagramOpts -> QDiagram Rasterific V2 n Any -> IO ()
chooseRender DiagramOpts
opts QDiagram Rasterific V2 n Any
d
DiagramLoopOpts -> IO ()
defaultLoopRender DiagramLoopOpts
loopOpts
chooseRender :: TypeableFloat n => DiagramOpts -> QDiagram Rasterific V2 n Any -> IO ()
chooseRender :: forall n.
TypeableFloat n =>
DiagramOpts -> QDiagram Rasterific V2 n Any -> IO ()
chooseRender DiagramOpts
opts QDiagram Rasterific V2 n Any
d
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path = IO ()
noFileError
| Bool
otherwise = forall n.
TypeableFloat n =>
String -> SizeSpec V2 n -> QDiagram Rasterific V2 n Any -> IO ()
renderRasterific String
path SizeSpec V2 n
sz QDiagram Rasterific V2 n Any
d
where
path :: String
path = DiagramOpts
optsforall s a. s -> Getting a s a -> a
^.Lens' DiagramOpts String
output
sz :: SizeSpec V2 n
sz = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. Num n => Maybe n -> Maybe n -> SizeSpec V2 n
mkSizeSpec2D (DiagramOpts
optsforall s a. s -> Getting a s a -> a
^.Lens' DiagramOpts (Maybe GifDelay)
width) (DiagramOpts
optsforall s a. s -> Getting a s a -> a
^.Lens' DiagramOpts (Maybe GifDelay)
height)
noFileError :: IO ()
noFileError :: IO ()
noFileError = String -> IO ()
putStrLn String
"No output file given. Specify output file with -o"
multiMain :: [(String, Diagram Rasterific)] -> IO ()
multiMain :: [(String, Diagram Rasterific)] -> IO ()
multiMain = forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith
instance TypeableFloat n => Mainable [(String,QDiagram Rasterific V2 n Any)] where
type MainOpts [(String,QDiagram Rasterific V2 n Any)]
= (MainOpts (QDiagram Rasterific V2 n Any), DiagramMultiOpts)
mainRender :: MainOpts [(String, QDiagram Rasterific V2 n Any)]
-> [(String, QDiagram Rasterific V2 n Any)] -> IO ()
mainRender = forall d.
Mainable d =>
(MainOpts d, DiagramMultiOpts) -> [(String, d)] -> IO ()
defaultMultiMainRender
animMain :: Animation Rasterific V2 Double -> IO ()
animMain :: Animation Rasterific V2 Double -> IO ()
animMain = forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith
instance TypeableFloat n => Mainable (Animation Rasterific V2 n) where
type MainOpts (Animation Rasterific V2 n) =
((DiagramOpts, DiagramAnimOpts), DiagramLoopOpts)
mainRender :: MainOpts (Animation Rasterific V2 n)
-> Animation Rasterific V2 n -> IO ()
mainRender ((DiagramOpts, DiagramAnimOpts)
opts, DiagramLoopOpts
l) Animation Rasterific V2 n
d = do
forall opts b (v :: * -> *) n.
(opts -> QDiagram b v n Any -> IO ())
-> Lens' opts String
-> (opts, DiagramAnimOpts)
-> Animation b v n
-> IO ()
defaultAnimMainRender forall n.
TypeableFloat n =>
DiagramOpts -> QDiagram Rasterific V2 n Any -> IO ()
chooseRender Lens' DiagramOpts String
output (DiagramOpts, DiagramAnimOpts)
opts Animation Rasterific V2 n
d
DiagramLoopOpts -> IO ()
defaultLoopRender DiagramLoopOpts
l
data GifOpts = GifOpts { GifOpts -> Bool
_dither :: Bool
, GifOpts -> Bool
_noLooping :: Bool
, GifOpts -> Maybe GifDelay
_loopRepeat :: Maybe Int}
makeLenses ''GifOpts
instance Parseable GifOpts where
parser :: Parser GifOpts
parser = Bool -> Bool -> Maybe GifDelay -> GifOpts
GifOpts forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"dither"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Turn on dithering." )
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"looping-off"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Turn looping off" )
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto)
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"loop-repeat"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Number of times to repeat" )
instance ToResult [(QDiagram Rasterific V2 n Any, GifDelay)] where
type Args [(QDiagram Rasterific V2 n Any, GifDelay)] = ()
type ResultOf [(QDiagram Rasterific V2 n Any, GifDelay)] = [(QDiagram Rasterific V2 n Any, GifDelay)]
toResult :: [(QDiagram Rasterific V2 n Any, GifDelay)]
-> Args [(QDiagram Rasterific V2 n Any, GifDelay)]
-> ResultOf [(QDiagram Rasterific V2 n Any, GifDelay)]
toResult [(QDiagram Rasterific V2 n Any, GifDelay)]
ds Args [(QDiagram Rasterific V2 n Any, GifDelay)]
_ = [(QDiagram Rasterific V2 n Any, GifDelay)]
ds
instance TypeableFloat n => Mainable [(QDiagram Rasterific V2 n Any, GifDelay)] where
type MainOpts [(QDiagram Rasterific V2 n Any, GifDelay)] = (DiagramOpts, GifOpts)
mainRender :: MainOpts [(QDiagram Rasterific V2 n Any, GifDelay)]
-> [(QDiagram Rasterific V2 n Any, GifDelay)] -> IO ()
mainRender (DiagramOpts
dOpts, GifOpts
gOpts) [(QDiagram Rasterific V2 n Any, GifDelay)]
ids
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path = IO ()
noFileError
| Bool
otherwise = case forall n.
TypeableFloat n =>
SizeSpec V2 n
-> GifLooping
-> PaletteOptions
-> [(QDiagram Rasterific V2 n Any, GifDelay)]
-> Either String ByteString
rasterGif SizeSpec V2 n
sz GifLooping
lOpts PaletteOptions
pOpts [(QDiagram Rasterific V2 n Any, GifDelay)]
ids of
Right ByteString
bs -> String -> ByteString -> IO ()
L.writeFile String
path ByteString
bs
Left String
e -> String -> IO ()
putStrLn String
e
where
sz :: SizeSpec V2 n
sz = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. Num n => Maybe n -> Maybe n -> SizeSpec V2 n
mkSizeSpec2D (DiagramOpts
dOptsforall s a. s -> Getting a s a -> a
^.Lens' DiagramOpts (Maybe GifDelay)
width) (DiagramOpts
dOptsforall s a. s -> Getting a s a -> a
^.Lens' DiagramOpts (Maybe GifDelay)
height)
path :: String
path = DiagramOpts
dOptsforall s a. s -> Getting a s a -> a
^.Lens' DiagramOpts String
output
lOpts :: GifLooping
lOpts
| GifOpts
gOptsforall s a. s -> Getting a s a -> a
^.Lens' GifOpts Bool
noLooping = GifLooping
LoopingNever
| Bool
otherwise = forall b a. b -> (a -> b) -> Maybe a -> b
maybe GifLooping
LoopingForever (Word16 -> GifLooping
LoopingRepeat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)
(GifOpts
gOptsforall s a. s -> Getting a s a -> a
^.Lens' GifOpts (Maybe GifDelay)
loopRepeat)
pOpts :: PaletteOptions
pOpts = PaletteOptions
defaultPaletteOptions {enableImageDithering :: Bool
enableImageDithering=GifOpts
gOptsforall s a. s -> Getting a s a -> a
^.Lens' GifOpts Bool
dither}
gifMain :: [(Diagram Rasterific, GifDelay)] -> IO ()
gifMain :: [(Diagram Rasterific, GifDelay)] -> IO ()
gifMain = forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith
uniformGifMain :: GifDelay -> [Diagram Rasterific] -> IO ()
uniformGifMain :: GifDelay -> [Diagram Rasterific] -> IO ()
uniformGifMain GifDelay
i = forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (,GifDelay
i)