module Reanimate.Render
  ( render
  , renderSvgs
  , renderSnippets
  , Format(..)
  , Raster(..)
  , Width, Height, FPS
  , applyRaster
  ) where

import           Control.Concurrent
import           Control.Exception
import           Control.Monad       (forM_, void, unless, forever)
import qualified Data.Text           as T
import qualified Data.Text.IO        as T
import           Data.Time
import           Graphics.SvgTree    (Number (..))
import           Numeric
import           Reanimate.Animation
import           Reanimate.Misc
import           Reanimate.Parameters
import           System.Exit
import           System.FilePath     ((</>))
import           System.FilePath     (replaceExtension)
import           System.IO
import           Text.Printf         (printf)

renderSvgs :: Animation ->  IO ()
renderSvgs ani = do
    print frameCount
    lock <- newMVar ()

    handle errHandler $ concurrentForM_ (frameOrder rate frameCount) $ \nth -> do
      let -- frame = frameAt (recip (fromIntegral rate-1) * fromIntegral nth) ani
          now = (duration ani / (fromIntegral frameCount-1)) * fromIntegral nth
          frame = frameAt (if frameCount<=1 then 0 else now) ani
          svg = renderSvg Nothing Nothing frame
      _ <- evaluate (length svg)
      withMVar lock $ \_ -> do
        putStr (show nth)
        T.putStrLn $ T.concat . T.lines . T.pack $ svg
        hFlush stdout
  where
    rate = 60
    frameCount = round (duration ani * fromIntegral rate) :: Int
    errHandler (ErrorCall msg) = do
      hPutStrLn stderr msg
      exitWith (ExitFailure 1)

-- XXX: Merge with 'renderSvgs'
renderSnippets :: Animation ->  IO ()
renderSnippets ani =
    forM_ [0..frameCount-1] $ \nth -> do
      let now = (duration ani / (fromIntegral frameCount-1)) * fromIntegral nth
          frame = frameAt now ani
          svg = renderSvg Nothing Nothing frame
      putStr (show nth)
      T.putStrLn $ T.concat . T.lines . T.pack $ svg
  where
    frameCount = 50 :: Integer

frameOrder :: Int -> Int -> [Int]
frameOrder fps nFrames = worker [] fps
  where
    worker _seen 0 = []
    worker seen nthFrame =
      filterFrameList seen nthFrame nFrames ++
      worker (nthFrame : seen) (nthFrame `div` 2)

filterFrameList :: [Int] -> Int -> Int -> [Int]
filterFrameList seen nthFrame nFrames =
    filter (not.isSeen) [0, nthFrame .. nFrames-1]
  where
    isSeen x = any (\y -> x `mod` y == 0) seen

data Format = RenderMp4 | RenderGif | RenderWebm
  deriving (Show)

render :: Animation
       -> FilePath
       -> Raster
       -> Format
       -> Width
       -> Height
       -> FPS
       -> IO ()
render ani target raster format width height fps = do
  printf "Starting render of animation: %.1f\n" (duration ani)
  ffmpeg <- requireExecutable "ffmpeg"
  generateFrames raster ani width height 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
                      , "-preset", "slow"
                      , "-crf", "18"
                      , "-movflags", "+faststart"
                      , "-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", showFFloat Nothing (duration ani) ""
                      , palette ]
        runCmd ffmpeg ["-framerate", show fps,"-i", template, "-y"
                      ,"-i", palette
                      ,"-progress", progress
                      ,"-filter_complex"
                      ,"fps="++show fps++",scale=320:-1:flags=lanczos[x];[x][1:v]paletteuse"
                      ,"-t", showFFloat Nothing (duration ani) ""
                      , target]
      RenderWebm ->
        runCmd ffmpeg ["-r", show fps, "-i", template, "-y"
                      ,"-progress", progress
                      , "-c:v", "libvpx-vp9", "-vf", "fps="++show fps
                      , target]

---------------------------------------------------------------------------------
-- Helpers

generateFrames :: Raster -> Animation -> Width -> Height -> FPS -> (FilePath -> IO a) -> IO a
generateFrames raster ani width_ height_ rate action = withTempDir $ \tmp -> do
    setRootDirectory tmp
    done <- newMVar (0::Int)
    let frameName nth = tmp </> printf nameTemplate nth
    putStr $ "\rFrames rendered: 0/" ++ show frameCount ++ "\27[K\r"
    hFlush stdout
    start <- getCurrentTime
    let statusPrinter = forever $ do
          nDone <- readMVar done
          now <- getCurrentTime
          let spent = diffUTCTime now start
              remaining = (spent / (fromIntegral nDone / fromIntegral frameCount)) - spent
          putStr $ "\rFrames rendered: " ++ show nDone ++ "/" ++ show frameCount
          putStr $ ", time spent: " ++ ppDiff spent
          unless (nDone==0) $ do
            putStr $ ", time remaining: " ++ ppDiff remaining
            putStr $ ", total time: " ++ ppDiff (remaining+spent)
          putStr $ "\27[K\r"
          hFlush stdout
          threadDelay 1000000
    withBackgroundThread statusPrinter $ do
      handle h $ concurrentForM_ frames $ \n -> do
        writeFile (frameName n) $ renderSvg width height $ nthFrame n
        applyRaster raster (frameName n)
        modifyMVar_ done $ \nDone -> return (nDone+1)
    now <- getCurrentTime
    let spent = diffUTCTime now start
    putStr $ "\rFrames rendered: " ++ show frameCount ++ "/" ++ show frameCount
    putStr $ ", time spent: " ++ ppDiff spent
    putStr $ "\27[K\n"
    action (tmp </> rasterTemplate raster)
  where
    width = Just $ Px $ fromIntegral width_
    height = Just $ Px $ fromIntegral height_
    h UserInterrupt = do
      hPutStrLn stderr "\nCtrl-C detected. Trying to generate video with available frames. \
                       \Hit ctrl-c again to abort."
      return ()
    h other = throwIO other
    -- frames = [0..frameCount-1]
    frames = frameOrder rate frameCount
    nthFrame nth = frameAt (recip (fromIntegral rate) * fromIntegral nth) ani
    frameCount = round (duration ani * fromIntegral rate) :: Int
    nameTemplate :: String
    nameTemplate = "render-%05d.svg"

withBackgroundThread :: IO () -> IO a -> IO a
withBackgroundThread t = bracket (forkIO t) killThread . const

ppDiff :: NominalDiffTime -> String
ppDiff diff
  | hours == 0 && mins == 0 = show secs ++ "s"
  | hours == 0 = printf "%.2d:%.2d" mins secs
  | otherwise  = printf "%.2d:%.2d:%.2d" hours mins secs
  where
    (osecs, secs) = round diff `divMod` (60::Int)
    (hours, mins) = osecs `divMod` 60

rasterTemplate :: Raster -> String
rasterTemplate RasterNone = "render-%05d.svg"
rasterTemplate _          = "render-%05d.png"

applyRaster :: Raster -> FilePath -> IO ()
applyRaster RasterNone _ = return ()
applyRaster RasterAuto _ = return ()
applyRaster RasterInkscape path =
  runCmd "inkscape"
    [ "--without-gui"
    , "--file=" ++ path
    , "--export-png=" ++ replaceExtension path "png" ]
applyRaster RasterRSvg path =
  runCmd "rsvg-convert"
    [ path
    , "--unlimited"
    , "--output", replaceExtension path "png" ]
applyRaster RasterConvert path =
  runCmd "convert"
    [ path
    , replaceExtension path "png" ]

concurrentForM_ :: [a] -> (a -> IO ()) -> IO ()
concurrentForM_ lst action = do
  n <- getNumCapabilities
  sem <- newQSemN n
  eVar <- newEmptyMVar
  forM_ lst $ \elt -> do
    waitQSemN sem 1
    emp <- isEmptyMVar eVar
    if emp
      then void $ forkIO (catch (action elt) (void . tryPutMVar eVar) `finally` signalQSemN sem 1)
      else signalQSemN sem 1
  waitQSemN sem n
  mbE <- tryTakeMVar eVar
  case mbE of
    Nothing -> return ()
    Just e  -> throwIO (e :: SomeException)