Feature colortheory (#57)

* Add 'lastA' combinator.

* Add 'mapT' combinator.

* Support multiple raster engines.

Former-commit-id: 2d314548528abd02e79c82557a107a303a836178

src/Reanimate/Animation.hs

@@ -23,6 +23,7 @@ module Reanimate.Animation
   , mapA
   , takeA
   , dropA
+  , lastA
   , pauseAtEnd
   , pauseAtBeginning
   , pauseAround
@@ -316,7 +317,7 @@ freezeAtPercentage frac (Animation d genFrame) =
 signalA :: Signal -> Animation -> Animation
 signalA fn (Animation d gen) = Animation d $ gen . fn
 
--- | @takeA duration animation@ creates a new animation consisting of initial segment of 
+-- | @takeA duration animation@ creates a new animation consisting of initial segment of
 --   @animation@ of given @duration@, played at the same rate as the original animation.
 --
 --  The @duration@ parameter is clamped to be between 0 and @animation@'s duration.
@@ -338,6 +339,9 @@ dropA len (Animation d gen) = Animation len' $ \t ->
   where
     len' = d - clamp 0 d len
 
+lastA :: Duration -> Animation -> Animation
+lastA len a = dropA (duration a - len) a
+
 clamp :: Double -> Double -> Double -> Double
 clamp a b number
   | a < b     = max a (min b number)

src/Reanimate/Builtin/Flip.hs

@@ -7,6 +7,7 @@ module Reanimate.Builtin.Flip
   , flipSprite
   , Transition
   , signalT
+  , mapT
   , flipTransition
   , flipTransitionOpts
   , overlapTransition
@@ -56,7 +57,10 @@ flipSprite front back = do
 type Transition = Animation -> Animation -> Animation
 
 signalT :: Signal -> Transition -> Transition
-signalT s t = \a b -> signalA s (t a b)
+signalT = mapT . signalA
+
+mapT :: (Animation -> Animation) -> Transition -> Transition
+mapT fn t = \a b -> fn (t a b)
 
 overlapTransition :: Double -> Transition -> Transition
 overlapTransition overlap t a b =

src/Reanimate/Driver.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiWayIf #-}
 module Reanimate.Driver ( reanimate ) where
 
 import           Control.Applicative      ((<|>))
@@ -14,6 +15,7 @@ import           Reanimate.Render         (FPS, Format (..), Height, Width,
 import           System.Directory
 import           System.FilePath
 import           Text.Printf
+import           Data.Either
 
 presetFormat :: Preset -> Format
 presetFormat Youtube    = RenderMp4
@@ -142,6 +144,7 @@ reanimate animation = do
             ,"--width", show width
             ,"--height", show height
             ,"--format", showFormat fmt
+            ,"--raster", showRaster renderRaster
             ,"--target", target
             ,"+RTS", "-N", "-RTS"]
         else do
@@ -155,9 +158,19 @@ reanimate animation = do
                  \  fmt:    %s\n\
                  \  target: %s\n"
             fps width height (showFormat fmt) target
-          render animation target fmt width height fps
-
+          raster <- selectRaster renderRaster
+          render animation target raster fmt width height fps
 
+selectRaster :: Raster -> IO Raster
+selectRaster RasterAuto = do
+  rsvg <- hasRSvg
+  ink <- hasInkscape
+  conv <- hasConvert
+  if | isRight rsvg -> pure RasterRSvg
+     | isRight ink  -> pure RasterInkscape
+     | isRight conv -> pure RasterConvert
+     | otherwise    -> pure RasterNone
+selectRaster r = pure r
 
 guessParameter :: Maybe a -> Maybe a -> a -> a
 guessParameter a b def = fromMaybe def (a <|> b)

src/Reanimate/Driver/CLI.hs

@@ -5,14 +5,17 @@ module Reanimate.Driver.CLI
   , Command(..)
   , Preset(..)
   , Format(..)
+  , Raster(..)
   , showFormat
+  , showRaster
   ) where
 
 import           Data.Char
 import           Data.Monoid
 import           Options.Applicative
-import           Reanimate.Render    (Format (..), Width, Height, FPS)
 import           Prelude
+import           Reanimate.Render    (FPS, Format (..), Height, Raster (..),
+                                      Width)
 
 data Options = Options
   { optsCommand :: Command
@@ -31,12 +34,30 @@ data Command
     , renderCompile :: Bool
     , renderFormat  :: Maybe Format
     , renderPreset  :: Maybe Preset
+    , renderRaster  :: Raster
     }
    deriving (Show)
 
 data Preset = Youtube | ExampleGif | Quick | MediumQ | HighQ | LowFPS
   deriving (Show)
 
+readRaster :: String -> Maybe Raster
+readRaster raster =
+  case map toLower raster of
+    "none"     -> Just RasterNone
+    "auto"     -> Just RasterAuto
+    "inkscape" -> Just RasterInkscape
+    "rsvg"     -> Just RasterRSvg
+    "convert"  -> Just RasterConvert
+    _          -> Nothing
+
+showRaster :: Raster -> String
+showRaster RasterNone     = "none"
+showRaster RasterAuto     = "auto"
+showRaster RasterInkscape = "inkscape"
+showRaster RasterRSvg     = "rsvg"
+showRaster RasterConvert  = "convert"
+
 readFormat :: String -> Maybe Format
 readFormat fmt =
   case map toLower fmt of
@@ -145,6 +166,11 @@ renderCommand = info parse
           (long "preset" <> showDefaultWith showPreset
           <> metavar "TYPE"
           <> help "Parameter presets: youtube, gif, quick, medium, high"))
+      <*> option (maybeReader readRaster)
+          (long "raster" <> showDefaultWith showRaster
+          <> metavar "RASTER"
+          <> value RasterNone
+          <> help "Raster engine: none, auto, inkscape, rsvg, convert")
 
 opts :: ParserInfo Options
 opts = info (options <**> helper )

src/Reanimate/Driver/Check.hs

@@ -1,6 +1,9 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Reanimate.Driver.Check
   ( checkEnvironment
+  , hasRSvg
+  , hasInkscape
+  , hasConvert
   ) where
 
 import           Control.Exception            (SomeException, handle)
@@ -25,6 +28,7 @@ checkEnvironment = do
     runCheck "Has dvisvgm" hasDvisvgm
     runCheck "Has povray" hasPovray
     runCheck "Has blender" hasBlender
+    runCheck "Has rsvg-convert" hasRSvg
     runCheck "Has inkscape" hasInkscape
     runCheck "Has convert" hasConvert
     runCheck "Has LaTeX" hasLaTeX
@@ -89,6 +93,11 @@ hasBlender = checkMinVersion minVersion <$> blenderVersion
   where
     minVersion = Version [2,80] []
 
+hasRSvg :: IO (Either String String)
+hasRSvg = checkMinVersion minVersion <$> rsvgVersion
+  where
+    minVersion = Version [2,44,0] []
+
 hasInkscape :: IO (Either String String)
 hasInkscape = checkMinVersion minVersion <$> inkscapeVersion
   where
@@ -97,7 +106,7 @@ hasInkscape = checkMinVersion minVersion <$> inkscapeVersion
 hasConvert :: IO (Either String String)
 hasConvert = checkMinVersion minVersion <$> convertVersion
   where
-    minVersion = Version [7,0,0] []
+    minVersion = Version [6,0,0] []
 
 ffmpegVersion :: IO (Maybe Version)
 ffmpegVersion = extractVersion "ffmpeg" ["-version"] $ \line ->
@@ -111,6 +120,12 @@ blenderVersion = extractVersion "blender" ["--version"] $ \line ->
       ["Blender", vs] -> vs
       _ -> ""
 
+rsvgVersion :: IO (Maybe Version)
+rsvgVersion = extractVersion "rsvg-convert" ["--version"] $ \line ->
+  case words line of
+    ["rsvg-convert", "version", vs] -> vs
+    _ -> ""
+
 inkscapeVersion :: IO (Maybe Version)
 inkscapeVersion = extractVersion "inkscape" ["--version"] $ \line ->
     case take 2 $ words line of

src/Reanimate/Raster.hs

@@ -25,6 +25,7 @@ import qualified Graphics.SvgTree            as Svg
 import           Reanimate.Animation
 import           Reanimate.Cache
 import           Reanimate.Misc
+import           Reanimate.Render
 import           Reanimate.Parameters
 import           Reanimate.Svg.Constructors
 import           Reanimate.Svg.Unuse
@@ -140,10 +141,10 @@ svgAsPngFile' width height svg = unsafePerformIO $ cacheFile template $ \pngPath
     let svgPath = replaceExtension pngPath "svg"
     -- ffmpeg <- requireExecutable "ffmpeg"
     -- convert <- requireExecutable "convert"
-    inkscape <- requireExecutable "inkscape"
+    -- inkscape <- requireExecutable "inkscape"
     writeFile svgPath rendered
-    -- runCmd convert [ "-background", "none", "-antialias", svgPath, pngPath ]
-    runCmd inkscape [ svgPath, "--export-png=" ++ pngPath, "--without-gui" ]
+    -- FIXME: raster should be configurable.
+    applyRaster RasterRSvg svgPath
   where
     template = show (hash rendered) <.> "png"
     rendered = renderSvg (Just $ Px $ fromIntegral width) (Just $ Px $ fromIntegral height) svg

src/Reanimate/Render.hs

@@ -3,7 +3,9 @@ module Reanimate.Render
   , renderSvgs
   , renderSnippets
   , Format(..)
+  , Raster(..)
   , Width, Height, FPS
+  , applyRaster
   ) where
 
 import           Control.Concurrent
@@ -15,8 +17,9 @@ import           Graphics.SvgTree    (Number (..))
 import           Numeric
 import           Reanimate.Animation
 import           Reanimate.Misc
-import           System.Exit
 import           System.FilePath     ((</>))
+import           System.FilePath    (replaceExtension)
+import           System.Exit
 import           System.IO
 import           Text.Printf         (printf)
 
@@ -68,6 +71,14 @@ filterFrameList seen nthFrame nFrames =
   where
     isSeen x = any (\y -> x `mod` y == 0) seen
 
+data Raster
+  = RasterNone
+  | RasterAuto
+  | RasterInkscape
+  | RasterRSvg
+  | RasterConvert
+  deriving (Show)
+
 data Format = RenderMp4 | RenderGif | RenderWebm
   deriving (Show)
 
@@ -77,15 +88,16 @@ type FPS = Int
 
 render :: Animation
        -> FilePath
+       -> Raster
        -> Format
        -> Width
        -> Height
        -> FPS
        -> IO ()
-render ani target format width height fps = do
+render ani target raster format width height fps = do
   printf "Starting render of animation: %.1f\n" (duration ani)
   ffmpeg <- requireExecutable "ffmpeg"
-  generateFrames ani width height fps $ \template ->
+  generateFrames raster ani width height fps $ \template ->
     withTempFile "txt" $ \progress -> writeFile progress "" >>
     case format of
       RenderMp4 ->
@@ -117,42 +129,56 @@ render ani target format width height fps = do
 ---------------------------------------------------------------------------------
 -- Helpers
 
-generateFrames :: Animation -> Width -> Height -> FPS -> (FilePath -> IO a) -> IO a
-generateFrames ani width_ height_ rate action = withTempDir $ \tmp -> do
+generateFrames :: Raster -> Animation -> Width -> Height -> FPS -> (FilePath -> IO a) -> IO a
+generateFrames raster ani width_ height_ rate action = withTempDir $ \tmp -> do
     done <- newMVar (0::Int)
     let frameName nth = tmp </> printf nameTemplate nth
+    putStr $ "\r0/" ++ show frameCount
+    hFlush stdout
     handle h $ concurrentForM_ frames $ \n -> do
       writeFile (frameName n) $ renderSvg width height $ nthFrame n
-      -- runCmd "inkscape"
-      --   [ "--without-gui"
-      --   , "--file=" ++ frameName n
-      --   , "--export-png=" ++ replaceExtension (frameName n) "png" ]
-      -- runCmd "rsvg-convert"
-      --   [ frameName n
-      --   , "--output", replaceExtension (frameName n) "png" ]
+      applyRaster raster (frameName n)
       modifyMVar_ done $ \nDone -> do
         putStr $ "\r" ++ show (nDone+1) ++ "/" ++ show frameCount
         hFlush stdout
         return (nDone+1)
     putStrLn "\n"
-    -- action (tmp </> pngTemplate)
-    action (tmp </> nameTemplate)
+    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
-    width = Just $ Num $ fromIntegral width_
-    height = Just $ Num $ fromIntegral height_
     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"
 
-    -- pngTemplate :: String
-    -- pngTemplate = "render-%05d.png"
+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

videos/color-theory/SCRIPT.md

@@ -20,10 +20,36 @@ can a colormap be interesting enough to merit a research publication?
 To answer these questions, first we have to explore a bit of color theory.
 
 
-Visible light roughly ranges from a wavelength of 400nm to 700nm. If each
-combination of wavelengths gave rise to a unique color then creating a color
-space would be nigh impossible. Fortunately, most human eyes have just three
-types of light-sensitive cells that respond to ranges of wavelengths, and the
-space of colors is therefore reduced to three dimensions.
-The axes are called S, M and L because the corrosponding cones are sensitive to
-short, medium, and lone wavelengths respectively.
+The wavelength of visible light is roughly between 400nm and 700nm, and the
+colors we see in the natural world tends to span this entire range.
+As such, a lotus leaf might emit a light spectrum like this. However, eyes
+don't detect indivial wavelengths and instead are sensitive to ranges
+of light.
+There are three types of color-sensing cones, S, M, and L, sensitive
+to short, medium, and long wavelengths respectively.
+
+Now imagine a space with S, M, and L as the axes. This space contains all
+unique colors but, due to the rather large overlap between the M and L cones,
+this space is rather awkward to use.
+
+The intensity of light sensed by these three cones give each color a unique
+three dimensional position. However, due to the rather large overlap between
+the M and L cones, the resulting three dimensional LMS space is awkward to use.
+This, plus the fact that blue is perceived to be much less bright than
+other colors, lead to the development of the XYZ colorspace. The XYZ space
+is equivalent to the LMS space but has been designed with a focus on the colors
+a human can actually perceive.
+
+The colors in the XYZ space form a pyramid in three dimensions but
+we can take a slice through this pyramid show a triangular section of colors
+with roughly equal intensity.
+
+The X corner has all the red colors, the Y corner has green colors, and the
+Z corner has blue colors.
+
+This is a false picture of colors, though, and some areas of the triangle cannot be
+perceived. This is because cone sensitivities overlap and even pure laser light
+of a single frequency would activate more than one.
+
+Plotting the wavelengths of visible light removes the false colors and gives us
+a map of every perceivable color.

videos/color-theory/Spectrum.hs

@@ -401,7 +401,7 @@ scene2 = seqA scene2Intro $ seqA illustrateSpectrum $ sceneAnimation $ do
   fork $ spriteTween xyzSpace 1 $ \t -> withGroupOpacity (1-t)
   wait 2
 
-  fork $ spriteTween xyzGraph 1 $ \t -> withGroupOpacity (1-t)
+  fork $ spriteTween xyzGraph 0.5 $ \t -> withGroupOpacity (1-t)
 
   fork $ tweenVar labelXPos 1 $ \(x,y) t ->
     let (newX, newY) = (-1,3)

videos/color-theory/color-theory.hs

@@ -72,7 +72,7 @@ main = reanimate $ --  takeA 10 $ dropA 55 $
   falseColorScene `seqA`
   scene2 `seqA`
   (parA (staticFrame 1 $ mkBackground "aliceblue") $
-  overlapTransition 1.5 (signalT (curveS 2) flipTransition)
+  overlapTransition 2 (signalT (curveS 2) flipTransition)
     (parA (staticFrame 1 $ mkBackground "black") $ gridScene)
     (parA (staticFrame 1 $ mkBackground "black") $ endScene))
   -- scene3