{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
module Reanimate.Driver
( reanimate
)
where
import Control.Applicative ( (<|>) )
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.Parameters
import Reanimate.Render ( render
, renderSnippets
, renderSvgs
, selectRaster
)
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
presetFormat LowFPS = RenderMp4
presetFPS :: Preset -> FPS
presetFPS Youtube = 60
presetFPS ExampleGif = 25
presetFPS Quick = 15
presetFPS MediumQ = 30
presetFPS HighQ = 30
presetFPS LowFPS = 10
presetWidth :: Preset -> Width
presetWidth Youtube = 2560
presetWidth ExampleGif = 320
presetWidth Quick = 320
presetWidth MediumQ = 800
presetWidth HighQ = 1920
presetWidth LowFPS = presetWidth HighQ
presetHeight :: Preset -> Height
presetHeight preset = presetWidth preset * 9 `div` 16
formatFPS :: Format -> FPS
formatFPS RenderMp4 = 60
formatFPS RenderGif = 25
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 -> setFPS 60 >> renderSvgs animation
Test -> do
setNoExternals True
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, height) = fromMaybe
( maybe (formatWidth fmt) presetWidth renderPreset
, maybe (formatHeight fmt) presetHeight renderPreset
)
(userPreferredDimensions renderWidth renderHeight)
if renderCompile
then compile
[ "render"
, "--fps"
, show fps
, "--width"
, show width
, "--height"
, show height
, "--format"
, showFormat fmt
, "--raster"
, showRaster renderRaster
, "--target"
, target
, "+RTS"
, "-N"
, "-RTS"
]
else do
raster <- selectRaster renderRaster
setRaster raster
setFPS fps
setWidth width
setHeight height
printf
"Animation options:\n\
\ fps: %d\n\
\ width: %d\n\
\ height: %d\n\
\ fmt: %s\n\
\ target: %s\n\
\ raster: %s\n"
fps
width
height
(showFormat fmt)
target
(show raster)
render animation target raster fmt width height fps
guessParameter :: Maybe a -> Maybe a -> a -> a
guessParameter a b def = fromMaybe def (a <|> b)
userPreferredDimensions :: Maybe Width -> Maybe Height -> Maybe (Width, Height)
userPreferredDimensions (Just width) (Just height) = Just (width, height)
userPreferredDimensions (Just width) Nothing =
Just (width, makeEven $ width * 9 `div` 16)
userPreferredDimensions Nothing (Just height) =
Just (makeEven $ height * 16 `div` 9, height)
userPreferredDimensions Nothing Nothing = Nothing
makeEven :: Int -> Int
makeEven x | even x = x
| otherwise = x - 1