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

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

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Backend.Rasterific.CmdLine
-- Copyright   :  (c) 2014-2015 Diagrams 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 Rasterific backend. Create
-- png, tif, bmp, jpg, pdf, or animated GIF files.
--
-- * '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".
--
-- * You can use 'Diagrams.Backend.Rasterific.renderRasterific' to render a
--   diagram to a file directly; see "Diagrams.Backend.Rasterific".
--
-- * A more flexible approach is to directly call 'renderDia'; see
--   "Diagrams.Backend.Rasterific" for more information.
--
-- For a tutorial on command-line diagram creation see
-- <http://projects.haskell.org/diagrams/doc/cmdline.html>.
--
-----------------------------------------------------------------------------
module Diagrams.Backend.Rasterific.CmdLine
  (
   -- * General form of @main@
   -- $mainwith
   mainWith

    -- * Supported forms of @main@
  , defaultMain
  , multiMain
  , animMain
  , gifMain
  , uniformGifMain

   -- * GIF support
  , GifOpts(..)

    -- * Backend tokens
  , 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

-- | 'mainWith' specialised to 'Diagram' 'Rasterific'.
defaultMain :: Diagram Rasterific -> IO ()
defaultMain :: Diagram Rasterific -> IO ()
defaultMain = Diagram Rasterific -> IO ()
QDiagram Rasterific V2 Double Any -> IO ()
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

  mainRender :: MainOpts (QDiagram Rasterific V2 n Any)
-> QDiagram Rasterific V2 n Any -> IO ()
mainRender MainOpts (QDiagram Rasterific V2 n Any)
opts QDiagram Rasterific V2 n Any
d = DiagramOpts -> QDiagram Rasterific V2 n Any -> IO ()
forall n.
TypeableFloat n =>
DiagramOpts -> QDiagram Rasterific V2 n Any -> IO ()
chooseRender DiagramOpts
MainOpts (QDiagram Rasterific V2 n Any)
opts QDiagram Rasterific V2 n Any
d

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
  | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path = IO ()
noFileError
  | Bool
otherwise = String -> SizeSpec V2 n -> QDiagram Rasterific V2 n Any -> IO ()
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
optsDiagramOpts -> Getting String DiagramOpts String -> String
forall s a. s -> Getting a s a -> a
^.Getting String DiagramOpts String
Lens' DiagramOpts String
output
    sz :: SizeSpec V2 n
sz   = GifDelay -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GifDelay -> n) -> SizeSpec V2 GifDelay -> SizeSpec V2 n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GifDelay -> Maybe GifDelay -> SizeSpec V2 GifDelay
forall n. Num n => Maybe n -> Maybe n -> SizeSpec V2 n
mkSizeSpec2D (DiagramOpts
optsDiagramOpts
-> Getting (Maybe GifDelay) DiagramOpts (Maybe GifDelay)
-> Maybe GifDelay
forall s a. s -> Getting a s a -> a
^.Getting (Maybe GifDelay) DiagramOpts (Maybe GifDelay)
Lens' DiagramOpts (Maybe GifDelay)
width) (DiagramOpts
optsDiagramOpts
-> Getting (Maybe GifDelay) DiagramOpts (Maybe GifDelay)
-> Maybe GifDelay
forall s a. s -> Getting a s a -> a
^.Getting (Maybe GifDelay) DiagramOpts (Maybe GifDelay)
Lens' DiagramOpts (Maybe GifDelay)
height)

noFileError :: IO ()
noFileError :: IO ()
noFileError = String -> IO ()
putStrLn String
"No output file given. Specify output file with -o"

-- | @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, Diagram Rasterific)] -> IO ()
multiMain :: [(String, Diagram Rasterific)] -> IO ()
multiMain = [(String, Diagram Rasterific)] -> IO ()
[(String, QDiagram Rasterific V2 Double Any)] -> IO ()
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 = (MainOpts (QDiagram Rasterific V2 n Any), DiagramMultiOpts)
-> [(String, QDiagram Rasterific V2 n Any)] -> IO ()
MainOpts [(String, QDiagram Rasterific V2 n Any)]
-> [(String, QDiagram Rasterific V2 n Any)] -> IO ()
forall d.
Mainable d =>
(MainOpts d, DiagramMultiOpts) -> [(String, 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 Rasterific V2 Double -> IO ()
animMain :: Animation Rasterific V2 Double -> IO ()
animMain = Animation Rasterific V2 Double -> IO ()
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)

  mainRender :: MainOpts (Animation Rasterific V2 n)
-> Animation Rasterific V2 n -> IO ()
mainRender MainOpts (Animation Rasterific V2 n)
opts Animation Rasterific V2 n
d = (DiagramOpts -> QDiagram Rasterific V2 n Any -> IO ())
-> Lens' DiagramOpts String
-> (DiagramOpts, DiagramAnimOpts)
-> Animation Rasterific V2 n
-> IO ()
forall opts b (v :: * -> *) n.
(opts -> QDiagram b v n Any -> IO ())
-> Lens' opts String
-> (opts, DiagramAnimOpts)
-> Animation b v n
-> IO ()
defaultAnimMainRender DiagramOpts -> QDiagram Rasterific V2 n Any -> IO ()
forall n.
TypeableFloat n =>
DiagramOpts -> QDiagram Rasterific V2 n Any -> IO ()
chooseRender (String -> f String) -> DiagramOpts -> f DiagramOpts
Lens' DiagramOpts String
output (DiagramOpts, DiagramAnimOpts)
MainOpts (Animation Rasterific V2 n)
opts Animation Rasterific V2 n
d

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

-- | An animated GIF can be a result.
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)]
ResultOf [(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
    | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path = IO ()
noFileError
    | Bool
otherwise = case SizeSpec V2 n
-> GifLooping
-> PaletteOptions
-> [(QDiagram Rasterific V2 n Any, GifDelay)]
-> Either String ByteString
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   = GifDelay -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GifDelay -> n) -> SizeSpec V2 GifDelay -> SizeSpec V2 n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GifDelay -> Maybe GifDelay -> SizeSpec V2 GifDelay
forall n. Num n => Maybe n -> Maybe n -> SizeSpec V2 n
mkSizeSpec2D (DiagramOpts
dOptsDiagramOpts
-> Getting (Maybe GifDelay) DiagramOpts (Maybe GifDelay)
-> Maybe GifDelay
forall s a. s -> Getting a s a -> a
^.Getting (Maybe GifDelay) DiagramOpts (Maybe GifDelay)
Lens' DiagramOpts (Maybe GifDelay)
width) (DiagramOpts
dOptsDiagramOpts
-> Getting (Maybe GifDelay) DiagramOpts (Maybe GifDelay)
-> Maybe GifDelay
forall s a. s -> Getting a s a -> a
^.Getting (Maybe GifDelay) DiagramOpts (Maybe GifDelay)
Lens' DiagramOpts (Maybe GifDelay)
height)
      path :: String
path = DiagramOpts
dOptsDiagramOpts -> Getting String DiagramOpts String -> String
forall s a. s -> Getting a s a -> a
^.Getting String DiagramOpts String
Lens' DiagramOpts String
output
      lOpts :: GifLooping
lOpts
        | GifOpts
gOptsGifOpts -> Getting Bool GifOpts Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool GifOpts Bool
Lens' GifOpts Bool
noLooping = GifLooping
LoopingNever
        | Bool
otherwise        = GifLooping
-> (GifDelay -> GifLooping) -> Maybe GifDelay -> GifLooping
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GifLooping
LoopingForever (Word16 -> GifLooping
LoopingRepeat (Word16 -> GifLooping)
-> (GifDelay -> Word16) -> GifDelay -> GifLooping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GifDelay -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
                               (GifOpts
gOptsGifOpts
-> Getting (Maybe GifDelay) GifOpts (Maybe GifDelay)
-> Maybe GifDelay
forall s a. s -> Getting a s a -> a
^.Getting (Maybe GifDelay) GifOpts (Maybe GifDelay)
Lens' GifOpts (Maybe GifDelay)
loopRepeat)
      pOpts :: PaletteOptions
pOpts = PaletteOptions
defaultPaletteOptions {enableImageDithering=gOpts^.dither}

-- | Make an animated gif main by pairing diagrams with a delay ('Int'
--   measured in 100th seconds).
gifMain :: [(Diagram Rasterific, GifDelay)] -> IO ()
gifMain :: [(Diagram Rasterific, GifDelay)] -> IO ()
gifMain = [(Diagram Rasterific, GifDelay)] -> IO ()
[(QDiagram Rasterific V2 Double Any, GifDelay)] -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith

-- | Make an animated gif main with the same delay for each diagram.
uniformGifMain :: GifDelay -> [Diagram Rasterific] -> IO ()
uniformGifMain :: GifDelay -> [Diagram Rasterific] -> IO ()
uniformGifMain GifDelay
i = [(QDiagram Rasterific V2 Double Any, GifDelay)] -> IO ()
forall d. (Mainable d, Parseable (MainOpts d)) => d -> IO ()
mainWith ([(QDiagram Rasterific V2 Double Any, GifDelay)] -> IO ())
-> ([QDiagram Rasterific V2 Double Any]
    -> [(QDiagram Rasterific V2 Double Any, GifDelay)])
-> [QDiagram Rasterific V2 Double Any]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QDiagram Rasterific V2 Double Any
 -> (QDiagram Rasterific V2 Double Any, GifDelay))
-> [QDiagram Rasterific V2 Double Any]
-> [(QDiagram Rasterific V2 Double Any, GifDelay)]
forall a b. (a -> b) -> [a] -> [b]
map (,GifDelay
i)