{-# LANGUAGE RecordWildCards #-}
module Reanimate.Driver ( reanimate ) where
import Control.Monad
import Data.Maybe
import Reanimate.Animation (Animation)
import Reanimate.Driver.Check
import Reanimate.Driver.CLI
import Reanimate.Driver.Compile
import Reanimate.Driver.Server
import Reanimate.Render (FPS, Format (..), Height, Width,
render, renderSnippets, renderSvgs)
import System.Directory
import System.FilePath
import Text.Printf
presetFormat :: Preset -> Format
presetFormat Youtube = RenderMp4
presetFormat ExampleGif = RenderGif
presetFormat Quick = RenderMp4
presetFormat MediumQ = RenderMp4
presetFormat HighQ = RenderMp4
presetFPS :: Preset -> FPS
presetFPS Youtube = 60
presetFPS ExampleGif = 24
presetFPS Quick = 15
presetFPS MediumQ = 30
presetFPS HighQ = 30
presetWidth :: Preset -> Width
presetWidth Youtube = 2560
presetWidth ExampleGif = 320
presetWidth Quick = 320
presetWidth MediumQ = 800
presetWidth HighQ = 1920
presetHeight :: Preset -> Height
presetHeight preset = presetWidth preset * 9 `div` 16
formatFPS :: Format -> FPS
formatFPS RenderMp4 = 60
formatFPS RenderGif = 24
formatFPS RenderWebm = 60
formatWidth :: Format -> Width
formatWidth RenderMp4 = 2560
formatWidth RenderGif = 320
formatWidth RenderWebm = 2560
formatHeight :: Format -> Height
formatHeight RenderMp4 = 1440
formatHeight RenderGif = 180
formatHeight RenderWebm = 1440
reanimate :: Animation -> IO ()
reanimate animation = do
Options{..} <- getDriverOptions
case optsCommand of
Raw -> renderSvgs animation
Test -> do
renderSnippets animation
Check -> checkEnvironment
View -> serve
Render{..} -> do
let fmt = guessParameter renderFormat (fmap presetFormat renderPreset) $
case renderTarget of
Just target -> case takeExtension target of
".mp4" -> RenderMp4
".gif" -> RenderGif
".webm" -> RenderWebm
_ -> RenderMp4
Nothing -> RenderMp4
target <- case renderTarget of
Nothing -> do
self <- findOwnSource
pure $ case fmt of
RenderMp4 -> replaceExtension self "mp4"
RenderGif -> replaceExtension self "gif"
RenderWebm -> replaceExtension self "webm"
Just target -> makeAbsolute target
let fps = guessParameter renderFPS (fmap presetFPS renderPreset) $
(formatFPS fmt)
width = guessParameter renderWidth (fmap presetWidth renderPreset) $
(formatWidth fmt)
height = guessParameter renderHeight (fmap presetHeight renderPreset) $
(formatHeight fmt)
if renderCompile
then
compile
["render"
,"--fps", show fps
,"--width", show width
,"--height", show height
,"--format", showFormat fmt
,"--target", target
,"+RTS", "-N", "-RTS"]
else do
printf "Animation options:\n\
\ fps: %d\n\
\ width: %d\n\
\ height: %d\n\
\ fmt: %s\n\
\ target: %s\n"
fps width height (showFormat fmt) target
render animation target fmt width height fps
guessParameter :: Maybe a -> Maybe a -> a -> a
guessParameter a b def = fromMaybe def (a `mplus` b)