module Reanimate.Render
( render
, renderSvgs
) where
import Control.Monad (forM_)
import Control.Parallel.Strategies
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Graphics.SvgTree (Number (..))
import Reanimate.Diagrams
import Reanimate.Examples
import Reanimate.Misc
import Reanimate.Monad
import System.Directory (renameFile)
import System.FilePath (takeExtension, takeFileName,
(</>))
import System.IO
import Text.Printf (printf)
renderSvgs :: Animation -> IO ()
renderSvgs ani = do
let renderedFrames = map (T.concat . T.lines . T.pack . nthFrame) frames
mapM_ T.putStrLn (renderedFrames `using` parBuffer 16 rdeepseq)
where
frames = [0..frameCount-1]
rate = 60
nthFrame nth = renderSvg Nothing Nothing $ frameAt (recip (fromIntegral rate) * fromIntegral nth) ani
frameCount = round (duration ani * fromIntegral rate) :: Int
nameTemplate :: String
nameTemplate = "render-%05d.svg"
data Format = RenderMp4 | RenderGif | RenderWebm | RenderBlank
formatFPS :: Format -> Int
formatFPS RenderMp4 = 60
formatFPS RenderGif = 25
formatFPS RenderWebm = 30
formatFPS RenderBlank = 60
render :: Animation -> FilePath -> IO ()
render ani target =
case takeExtension target of
".mp4" -> renderFormat RenderMp4 ani target
".gif" -> renderFormat RenderGif ani target
".webm" -> renderFormat RenderWebm ani target
"" -> renderFormat RenderBlank ani target
ext -> error $ "Unknown media format: " ++ show ext
renderFormat :: Format -> Animation -> FilePath -> IO ()
renderFormat format ani target = do
putStrLn $ "Starting render of animation: " ++ show (round (duration ani)) ++ "s"
ffmpeg <- requireExecutable "ffmpeg"
generateFrames ani 2560 fps $ \template ->
withTempFile "txt" $ \progress -> writeFile progress "" >>
case format of
RenderMp4 ->
runCmd ffmpeg ["-r", show fps, "-i", template, "-y"
, "-c:v", "libx264", "-vf", "fps="++show fps
, "-progress", progress
, "-pix_fmt", "yuv420p", target]
RenderGif -> withTempFile "png" $ \palette -> do
runCmd ffmpeg ["-i", template, "-y"
,"-vf", "fps="++show fps++",scale=320:-1:flags=lanczos,palettegen"
,"-t", show (duration ani)
, palette ]
runCmd ffmpeg ["-i", template, "-y"
,"-i", palette
,"-progress", progress
,"-filter_complex"
,"fps="++show fps++",scale=320:-1:flags=lanczos[x];[x][1:v]paletteuse"
,"-t", show (duration ani)
, target]
RenderWebm ->
runCmd ffmpeg ["-r", show fps, "-i", template, "-y"
,"-progress", progress
, "-c:v", "libvpx-vp9", "-vf", "fps="++show fps
, target]
RenderBlank -> return ()
where
fps = formatFPS format
generateFrames ani width_ rate action = withTempDir $ \tmp -> do
let frameName nth = tmp </> printf nameTemplate nth
rendered = [ renderSvg width height $ nthFrame n | n <- frames]
`using` parBuffer 16 rdeepseq
forM_ (zip [0::Int ..] rendered) $ \(n, frame) -> do
writeFile (frameName n) frame
putStr $ "\r" ++ show (n+1) ++ "/" ++ show frameCount
hFlush stdout
putStrLn "\n"
action (tmp </> nameTemplate)
where
width = Just $ Num width_
height = Just $ Num (width_*(9/16))
frames = [0..frameCount-1]
nthFrame nth = frameAt (recip (fromIntegral rate) * fromIntegral nth) ani
frameCount = round (duration ani * fromIntegral rate) :: Int
nameTemplate :: String
nameTemplate = "render-%05d.svg"