{-# LANGUAGE RecordWildCards #-}
module Reanimate.Driver
  ( reanimate
  )
where

import           Control.Applicative      ((<|>))
import           Control.Concurrent
import           Control.Monad
import           Data.Either
import           Data.Maybe
import           Reanimate.Animation      (Animation, duration)
import           Reanimate.Driver.CLI
import           Reanimate.Driver.Check
import           Reanimate.Driver.Daemon
import           Reanimate.Parameters
import           Reanimate.Render         (render, renderSnippets, renderSvgs, renderSvgs_,
                                           selectRaster)
import           System.Directory
import           System.Exit
import           System.FilePath
import           System.IO
import           Text.Printf

presetFormat :: Preset -> Format
presetFormat :: Preset -> Format
presetFormat Preset
Youtube    = Format
RenderMp4
presetFormat Preset
ExampleGif = Format
RenderGif
presetFormat Preset
Quick      = Format
RenderMp4
presetFormat Preset
MediumQ    = Format
RenderMp4
presetFormat Preset
HighQ      = Format
RenderMp4
presetFormat Preset
LowFPS     = Format
RenderMp4

presetFPS :: Preset -> FPS
presetFPS :: Preset -> FPS
presetFPS Preset
Youtube    = FPS
60
presetFPS Preset
ExampleGif = FPS
25
presetFPS Preset
Quick      = FPS
15
presetFPS Preset
MediumQ    = FPS
30
presetFPS Preset
HighQ      = FPS
30
presetFPS Preset
LowFPS     = FPS
10

presetWidth :: Preset -> Width
presetWidth :: Preset -> FPS
presetWidth Preset
Youtube    = FPS
2560
presetWidth Preset
ExampleGif = FPS
320
presetWidth Preset
Quick      = FPS
320
presetWidth Preset
MediumQ    = FPS
800
presetWidth Preset
HighQ      = FPS
1920
presetWidth Preset
LowFPS     = Preset -> FPS
presetWidth Preset
HighQ

presetHeight :: Preset -> Height
presetHeight :: Preset -> FPS
presetHeight Preset
preset = Preset -> FPS
presetWidth Preset
preset FPS -> FPS -> FPS
forall a. Num a => a -> a -> a
* FPS
9 FPS -> FPS -> FPS
forall a. Integral a => a -> a -> a
`div` FPS
16

formatFPS :: Format -> FPS
formatFPS :: Format -> FPS
formatFPS Format
RenderMp4  = FPS
60
formatFPS Format
RenderGif  = FPS
25
formatFPS Format
RenderWebm = FPS
60

formatWidth :: Format -> Width
formatWidth :: Format -> FPS
formatWidth Format
RenderMp4  = FPS
2560
formatWidth Format
RenderGif  = FPS
320
formatWidth Format
RenderWebm = FPS
2560

formatHeight :: Format -> Height
formatHeight :: Format -> FPS
formatHeight Format
RenderMp4  = FPS
1440
formatHeight Format
RenderGif  = FPS
180
formatHeight Format
RenderWebm = FPS
1440

formatExtension :: Format -> String
formatExtension :: Format -> String
formatExtension Format
RenderMp4  = String
"mp4"
formatExtension Format
RenderGif  = String
"gif"
formatExtension Format
RenderWebm = String
"webm"

{-|
Main entry-point for accessing an animation. Creates a program that takes the
following command-line arguments:

> Usage: PROG [COMMAND]
>   This program contains an animation which can either be viewed in a web-browser
>   or rendered to disk.
>
> Available options:
>   -h,--help                Show this help text
>
> Available commands:
>   check                    Run a system's diagnostic and report any missing
>                            external dependencies.
>   view                     Play animation in browser window.
>   render                   Render animation to file.

Neither the \'check\' nor the \'view\' command take any additional arguments.
Rendering animation can be controlled with these arguments:

> Usage: PROG render [-o|--target FILE] [--fps FPS] [-w|--width PIXELS]
>                    [-h|--height PIXELS] [--compile] [--format FMT]
>                    [--preset TYPE]
>   Render animation to file.
>
> Available options:
>   -o,--target FILE         Write output to FILE
>   --fps FPS                Set frames per second.
>   -w,--width PIXELS        Set video width.
>   -h,--height PIXELS       Set video height.
>   --compile                Compile source code before rendering.
>   --format FMT             Video format: mp4, gif, webm
>   --preset TYPE            Parameter presets: youtube, gif, quick
>   -h,--help                Show this help text
-}
reanimate :: Animation -> IO ()
reanimate :: Animation -> IO ()
reanimate Animation
animation = do
  Options {Command
optsCommand :: Options -> Command
optsCommand :: Command
..} <- IO Options
getDriverOptions
  case Command
optsCommand of
    Raw {Bool
FPS
String
rawPrettyPrint :: Command -> Bool
rawFrameOffset :: Command -> FPS
rawOutputFolder :: Command -> String
rawPrettyPrint :: Bool
rawFrameOffset :: FPS
rawOutputFolder :: String
..} -> do
      FPS -> IO ()
setFPS FPS
60
      String -> FPS -> Bool -> Animation -> IO ()
renderSvgs String
rawOutputFolder FPS
rawFrameOffset Bool
rawPrettyPrint Animation
animation
    Command
Test -> do
      Bool -> IO ()
setNoExternals Bool
True
      -- hSetBinaryMode stdout True
      Animation -> IO ()
renderSnippets Animation
animation
    Command
Check       -> IO ()
checkEnvironment
    View {Bool
viewDetach :: Command -> Bool
viewDetach :: Bool
..}   -> Bool -> Animation -> IO ()
viewAnimation Bool
viewDetach Animation
animation
    Render {Bool
Maybe FPS
Maybe String
Maybe Format
Maybe Preset
Raster
renderHash :: Command -> Bool
renderPartial :: Command -> Bool
renderRaster :: Command -> Raster
renderPreset :: Command -> Maybe Preset
renderFormat :: Command -> Maybe Format
renderCompile :: Command -> Bool
renderHeight :: Command -> Maybe FPS
renderWidth :: Command -> Maybe FPS
renderFPS :: Command -> Maybe FPS
renderTarget :: Command -> Maybe String
renderHash :: Bool
renderPartial :: Bool
renderRaster :: Raster
renderPreset :: Maybe Preset
renderFormat :: Maybe Format
renderCompile :: Bool
renderHeight :: Maybe FPS
renderWidth :: Maybe FPS
renderFPS :: Maybe FPS
renderTarget :: Maybe String
..} -> do
      let fmt :: Format
fmt =
            Maybe Format -> Maybe Format -> Format -> Format
forall a. Maybe a -> Maybe a -> a -> a
guessParameter Maybe Format
renderFormat ((Preset -> Format) -> Maybe Preset -> Maybe Format
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Preset -> Format
presetFormat Maybe Preset
renderPreset)
              (Format -> Format) -> Format -> Format
forall a b. (a -> b) -> a -> b
$ case Maybe String
renderTarget of
                  -- Format guessed from output
                  Just String
target -> case String -> String
takeExtension String
target of
                    String
".mp4"  -> Format
RenderMp4
                    String
".gif"  -> Format
RenderGif
                    String
".webm" -> Format
RenderWebm
                    String
_       -> Format
RenderMp4
                  -- Default to mp4 rendering.
                  Maybe String
Nothing -> Format
RenderMp4

      String
target <- case Maybe String
renderTarget of
        Maybe String
Nothing -> do
          Maybe String
mbSelf <- Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
          let ext :: String
ext = Format -> String
formatExtension Format
fmt
              self :: String
self = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"output" Maybe String
mbSelf
          String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
replaceExtension String
self String
ext
        Just String
target -> String -> IO String
makeAbsolute String
target

      let
        fps :: FPS
fps =
          Maybe FPS -> Maybe FPS -> FPS -> FPS
forall a. Maybe a -> Maybe a -> a -> a
guessParameter Maybe FPS
renderFPS ((Preset -> FPS) -> Maybe Preset -> Maybe FPS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Preset -> FPS
presetFPS Maybe Preset
renderPreset) (FPS -> FPS) -> FPS -> FPS
forall a b. (a -> b) -> a -> b
$ Format -> FPS
formatFPS Format
fmt
        (FPS
width, FPS
height) = (FPS, FPS) -> Maybe (FPS, FPS) -> (FPS, FPS)
forall a. a -> Maybe a -> a
fromMaybe
          ( FPS -> (Preset -> FPS) -> Maybe Preset -> FPS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Format -> FPS
formatWidth Format
fmt)  Preset -> FPS
presetWidth  Maybe Preset
renderPreset
          , FPS -> (Preset -> FPS) -> Maybe Preset -> FPS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Format -> FPS
formatHeight Format
fmt) Preset -> FPS
presetHeight Maybe Preset
renderPreset
          )
          (Maybe FPS -> Maybe FPS -> Maybe (FPS, FPS)
userPreferredDimensions Maybe FPS
renderWidth Maybe FPS
renderHeight)

      Raster
raster <-
        if Raster
renderRaster Raster -> Raster -> Bool
forall a. Eq a => a -> a -> Bool
== Raster
RasterNone Bool -> Bool -> Bool
|| Raster
renderRaster Raster -> Raster -> Bool
forall a. Eq a => a -> a -> Bool
== Raster
RasterAuto  then do
          Either String String
svgSupport <- IO (Either String String)
hasFFmpegRSvg
          if Either String String -> Bool
forall a b. Either a b -> Bool
isRight Either String String
svgSupport
            then Raster -> IO Raster
selectRaster Raster
renderRaster
            else do
              Raster
raster <- Raster -> IO Raster
selectRaster Raster
RasterAuto
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Raster
raster Raster -> Raster -> Bool
forall a. Eq a => a -> a -> Bool
== Raster
RasterNone) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Handle -> String -> IO ()
hPutStrLn Handle
stderr
                  String
"Error: your FFmpeg was built without SVG support and no raster engines \
                  \are available. Please install either inkscape, imagemagick, or rsvg."
                ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (FPS -> ExitCode
ExitFailure FPS
1)
              Raster -> IO Raster
forall (m :: * -> *) a. Monad m => a -> m a
return Raster
raster
        else Raster -> IO Raster
selectRaster Raster
renderRaster
      Raster -> IO ()
setRaster Raster
raster
      FPS -> IO ()
setFPS FPS
fps
      FPS -> IO ()
setWidth FPS
width
      FPS -> IO ()
setHeight FPS
height
      String -> FPS -> FPS -> FPS -> String -> String -> String -> IO ()
forall r. PrintfType r => String -> r
printf
        String
"Animation options:\n\
              \  fps:    %d\n\
              \  width:  %d\n\
              \  height: %d\n\
              \  fmt:    %s\n\
              \  target: %s\n\
              \  raster: %s\n"
        FPS
fps
        FPS
width
        FPS
height
        (Format -> String
showFormat Format
fmt)
        String
target
        (Raster -> String
forall a. Show a => a -> String
show Raster
raster)

      Animation
-> String -> Raster -> Format -> FPS -> FPS -> FPS -> Bool -> IO ()
render Animation
animation String
target Raster
raster Format
fmt FPS
width FPS
height FPS
fps Bool
renderPartial

guessParameter :: Maybe a -> Maybe a -> a -> a
guessParameter :: Maybe a -> Maybe a -> a -> a
guessParameter Maybe a
a Maybe a
b a
def = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def (Maybe a
a Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a
b)


-- If user specifies exactly one dimension explicitly, calculate the other
userPreferredDimensions :: Maybe Width -> Maybe Height -> Maybe (Width, Height)
userPreferredDimensions :: Maybe FPS -> Maybe FPS -> Maybe (FPS, FPS)
userPreferredDimensions (Just FPS
width) (Just FPS
height) = (FPS, FPS) -> Maybe (FPS, FPS)
forall a. a -> Maybe a
Just (FPS
width, FPS
height)
userPreferredDimensions (Just FPS
width) Maybe FPS
Nothing =
  (FPS, FPS) -> Maybe (FPS, FPS)
forall a. a -> Maybe a
Just (FPS
width, FPS -> FPS
makeEven (FPS -> FPS) -> FPS -> FPS
forall a b. (a -> b) -> a -> b
$ FPS
width FPS -> FPS -> FPS
forall a. Num a => a -> a -> a
* FPS
9 FPS -> FPS -> FPS
forall a. Integral a => a -> a -> a
`div` FPS
16)
userPreferredDimensions Maybe FPS
Nothing (Just FPS
height) =
  (FPS, FPS) -> Maybe (FPS, FPS)
forall a. a -> Maybe a
Just (FPS -> FPS
makeEven (FPS -> FPS) -> FPS -> FPS
forall a b. (a -> b) -> a -> b
$ FPS
height FPS -> FPS -> FPS
forall a. Num a => a -> a -> a
* FPS
16 FPS -> FPS -> FPS
forall a. Integral a => a -> a -> a
`div` FPS
9, FPS
height)
userPreferredDimensions Maybe FPS
Nothing Maybe FPS
Nothing = Maybe (FPS, FPS)
forall a. Maybe a
Nothing

-- Avoid ffmpeg failures "height not divisible by 2"
makeEven :: Int -> Int
makeEven :: FPS -> FPS
makeEven FPS
x | FPS -> Bool
forall a. Integral a => a -> Bool
even FPS
x    = FPS
x
           | Bool
otherwise = FPS
x FPS -> FPS -> FPS
forall a. Num a => a -> a -> a
- FPS
1


-- serve viewVerbose viewGHCPath viewGHCOpts viewOrigin
viewAnimation :: Bool -> Animation -> IO ()
viewAnimation :: Bool -> Animation -> IO ()
viewAnimation Bool
_detach Animation
animation = do
  Bool
detached <- IO Bool
ensureDaemon

  let rate :: Duration
rate = Duration
60
      count :: FPS
count = Duration -> FPS
forall a b. (RealFrac a, Integral b) => a -> b
round (Animation -> Duration
duration Animation
animation Duration -> Duration -> Duration
forall a. Num a => a -> a -> a
* Duration
rate) :: Int
  DaemonCommand -> IO ()
sendCommand (DaemonCommand -> IO ()) -> DaemonCommand -> IO ()
forall a b. (a -> b) -> a -> b
$ FPS -> DaemonCommand
DaemonCount FPS
count
  Animation -> (FPS -> String -> IO ()) -> IO ()
renderSvgs_ Animation
animation ((FPS -> String -> IO ()) -> IO ())
-> (FPS -> String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FPS
nth String
path -> do
    DaemonCommand -> IO ()
sendCommand (DaemonCommand -> IO ()) -> DaemonCommand -> IO ()
forall a b. (a -> b) -> a -> b
$ FPS -> String -> DaemonCommand
DaemonFrame FPS
nth String
path

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
detached (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
putStrLn String
"Daemon mode. Hit ctrl-c to terminate."
    IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FPS -> IO ()
threadDelay (FPS
10FPS -> FPS -> FPS
forall a b. (Num a, Integral b) => a -> b -> a
^(FPS
6::Int))