never executed always true always false
1 {-# LANGUAGE MultiWayIf #-}
2 {-# LANGUAGE RecordWildCards #-}
3 module Reanimate.Driver
4 ( reanimate
5 )
6 where
7
8 import Control.Applicative ((<|>))
9 import Control.Monad
10 import Data.Maybe
11 import Data.Either
12 import Reanimate.Animation (Animation)
13 import Reanimate.Driver.Check
14 import Reanimate.Driver.CLI
15 import Reanimate.Driver.Compile
16 import Reanimate.Driver.Server
17 import Reanimate.Parameters
18 import Reanimate.Render (render, renderSnippets, renderSvgs,
19 selectRaster)
20 import System.Directory
21 import System.Exit
22 import System.FilePath
23 import System.IO
24 import Text.Printf
25
26 presetFormat :: Preset -> Format
27 presetFormat Youtube = RenderMp4
28 presetFormat ExampleGif = RenderGif
29 presetFormat Quick = RenderMp4
30 presetFormat MediumQ = RenderMp4
31 presetFormat HighQ = RenderMp4
32 presetFormat LowFPS = RenderMp4
33
34 presetFPS :: Preset -> FPS
35 presetFPS Youtube = 60
36 presetFPS ExampleGif = 25
37 presetFPS Quick = 15
38 presetFPS MediumQ = 30
39 presetFPS HighQ = 30
40 presetFPS LowFPS = 10
41
42 presetWidth :: Preset -> Width
43 presetWidth Youtube = 2560
44 presetWidth ExampleGif = 320
45 presetWidth Quick = 320
46 presetWidth MediumQ = 800
47 presetWidth HighQ = 1920
48 presetWidth LowFPS = presetWidth HighQ
49
50 presetHeight :: Preset -> Height
51 presetHeight preset = presetWidth preset * 9 `div` 16
52
53 formatFPS :: Format -> FPS
54 formatFPS RenderMp4 = 60
55 formatFPS RenderGif = 25
56 formatFPS RenderWebm = 60
57
58 formatWidth :: Format -> Width
59 formatWidth RenderMp4 = 2560
60 formatWidth RenderGif = 320
61 formatWidth RenderWebm = 2560
62
63 formatHeight :: Format -> Height
64 formatHeight RenderMp4 = 1440
65 formatHeight RenderGif = 180
66 formatHeight RenderWebm = 1440
67
68 formatExtension :: Format -> String
69 formatExtension RenderMp4 = "mp4"
70 formatExtension RenderGif = "gif"
71 formatExtension RenderWebm = "webm"
72
73 {-|
74 Main entry-point for accessing an animation. Creates a program that takes the
75 following command-line arguments:
76
77 > Usage: PROG [COMMAND]
78 > This program contains an animation which can either be viewed in a web-browser
79 > or rendered to disk.
80 >
81 > Available options:
82 > -h,--help Show this help text
83 >
84 > Available commands:
85 > check Run a system's diagnostic and report any missing
86 > external dependencies.
87 > view Play animation in browser window.
88 > render Render animation to file.
89
90 Neither the 'check' nor the 'view' command take any additional arguments.
91 Rendering animation can be controlled with these arguments:
92
93 > Usage: PROG render [-o|--target FILE] [--fps FPS] [-w|--width PIXELS]
94 > [-h|--height PIXELS] [--compile] [--format FMT]
95 > [--preset TYPE]
96 > Render animation to file.
97 >
98 > Available options:
99 > -o,--target FILE Write output to FILE
100 > --fps FPS Set frames per second.
101 > -w,--width PIXELS Set video width.
102 > -h,--height PIXELS Set video height.
103 > --compile Compile source code before rendering.
104 > --format FMT Video format: mp4, gif, webm
105 > --preset TYPE Parameter presets: youtube, gif, quick
106 > -h,--help Show this help text
107 -}
108 reanimate :: Animation -> IO ()
109 reanimate animation = do
110 Options {..} <- getDriverOptions
111 case optsCommand of
112 Raw {..} -> do
113 setFPS 60
114 renderSvgs rawOutputFolder rawFrameOffset rawPrettyPrint animation
115 Test -> do
116 setNoExternals True
117 -- hSetBinaryMode stdout True
118 renderSnippets animation
119 Check -> checkEnvironment
120 View {..} -> serve viewVerbose viewGHCPath viewGHCOpts viewOrigin
121 Render {..} -> do
122 let fmt =
123 guessParameter renderFormat (fmap presetFormat renderPreset)
124 $ case renderTarget of
125 -- Format guessed from output
126 Just target -> case takeExtension target of
127 ".mp4" -> RenderMp4
128 ".gif" -> RenderGif
129 ".webm" -> RenderWebm
130 _ -> RenderMp4
131 -- Default to mp4 rendering.
132 Nothing -> RenderMp4
133
134 target <- case renderTarget of
135 Nothing -> do
136 mbSelf <- findOwnSource
137 let ext = formatExtension fmt
138 self = fromMaybe "output" mbSelf
139 pure $ replaceExtension self ext
140 Just target -> makeAbsolute target
141
142 let
143 fps =
144 guessParameter renderFPS (fmap presetFPS renderPreset) $ formatFPS fmt
145 (width, height) = fromMaybe
146 ( maybe (formatWidth fmt) presetWidth renderPreset
147 , maybe (formatHeight fmt) presetHeight renderPreset
148 )
149 (userPreferredDimensions renderWidth renderHeight)
150
151 raster <-
152 if renderRaster == RasterNone || renderRaster == RasterAuto then do
153 svgSupport <- hasFFmpegRSvg
154 if isRight svgSupport
155 then selectRaster renderRaster
156 else do
157 raster <- selectRaster RasterAuto
158 when (raster == RasterNone) $ do
159 hPutStrLn stderr $
160 "Error: your FFmpeg was built without SVG support and no raster engines \
161 \are available. Please install either inkscape, imagemagick, or rsvg."
162 exitWith (ExitFailure 1)
163 return raster
164 else selectRaster renderRaster
165
166 if renderCompile
167 then compile $
168 [ "render"
169 , "--fps"
170 , show fps
171 , "--width"
172 , show width
173 , "--height"
174 , show height
175 , "--format"
176 , showFormat fmt
177 , "--raster"
178 , showRaster raster
179 , "--target"
180 , target
181 , "+RTS"
182 , "-N"
183 , "-RTS"
184 ] ++ [ "--partial" | renderPartial ]
185 else do
186 setRaster raster
187 setFPS fps
188 setWidth width
189 setHeight height
190 printf
191 "Animation options:\n\
192 \ fps: %d\n\
193 \ width: %d\n\
194 \ height: %d\n\
195 \ fmt: %s\n\
196 \ target: %s\n\
197 \ raster: %s\n"
198 fps
199 width
200 height
201 (showFormat fmt)
202 target
203 (show raster)
204
205 render animation target raster fmt width height fps renderPartial
206
207 guessParameter :: Maybe a -> Maybe a -> a -> a
208 guessParameter a b def = fromMaybe def (a <|> b)
209
210
211 -- If user specifies exactly one dimension explicitly, calculate the other
212 userPreferredDimensions :: Maybe Width -> Maybe Height -> Maybe (Width, Height)
213 userPreferredDimensions (Just width) (Just height) = Just (width, height)
214 userPreferredDimensions (Just width) Nothing =
215 Just (width, makeEven $ width * 9 `div` 16)
216 userPreferredDimensions Nothing (Just height) =
217 Just (makeEven $ height * 16 `div` 9, height)
218 userPreferredDimensions Nothing Nothing = Nothing
219
220 -- Avoid ffmpeg failures "height not divisible by 2"
221 makeEven :: Int -> Int
222 makeEven x | even x = x
223 | otherwise = x - 1