Improve and expose 'mkImage'.

Former-commit-id: eef95441c47ed3a798b1261e17b6018ea9281344

ChangeLog.md

@@ -1,5 +1,9 @@
 # Revision history for reanimate
 
+## 0.3.1.0 -- 2020-05-12
+
+* Expose 'mkImage'
+
 ## 0.3.0.0 -- 2020-05-11
 
 * Improve README.md with better examples at a higher framerate.

docs/gen_doc_gifs.sh

@@ -5,6 +5,7 @@ TINY='^(doc_turbo|doc_viridis|doc_magma|doc_inferno|doc_plasma|doc_sinebow|doc_c
         newline|doc_hsvMatlab|doc_greyscale|doc_parula|doc_rgbComponents|doc_hsvComponents|
         newline|doc_lchComponents|doc_xyzComponents|doc_labComponents)$'
 
+cd $ROOT/examples/
 for src in $ROOT/examples/doc_*.hs; do
   BASE=`basename $src .hs`
   DST=$ROOT/docs/gifs/$BASE.gif

examples/doc_mkImage.hs

@@ -0,0 +1,10 @@
+#!/usr/bin/env stack
+-- stack runghc --package reanimate
+module Main (main) where
+
+import           Reanimate
+import           Reanimate.Builtin.Documentation
+
+main :: IO ()
+main = reanimate $ docEnv $ staticFrame 1 $
+    mkImage screenWidth screenHeight "../data/haskell.svg"

examples/tut_glue_povray.hs

@@ -7,7 +7,6 @@ module Main (main) where
 
 import           Reanimate
 import           Reanimate.Povray      (povraySlow')
-import           Reanimate.Raster
 
 import           Codec.Picture
 import           Codec.Picture.Types

src/Reanimate.hs

@@ -141,11 +141,14 @@ module Reanimate
     module Reanimate.Svg.BoundingBox,
     module Reanimate.Svg,
     -- ** Raster data
+    mkImage,
     embedImage,
     embedDynamicImage,
     embedPng,
     raster,
+    rasterSized,
     svgAsPngFile,
+    svgAsPngFile',
     vectorize,
     vectorize_,
     -- ** External SVG providers

src/Reanimate/Driver.hs

@@ -11,11 +11,10 @@ import           Reanimate.Driver.Compile
 import           Reanimate.Driver.Server
 import           Reanimate.Parameters
 import           Reanimate.Render         (FPS, Format (..), Height, Width,
-                                            render, renderSnippets, renderSvgs)
+                                            render, renderSnippets, renderSvgs, selectRaster)
 import           System.Directory
 import           System.FilePath
 import           Text.Printf
-import           Data.Either
 
 presetFormat :: Preset -> Format
 presetFormat Youtube    = RenderMp4
@@ -161,17 +160,6 @@ reanimate animation = do
 
           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/Parameters.hs

@@ -30,7 +30,7 @@ data Raster
   | RasterInkscape
   | RasterRSvg
   | RasterConvert
-  deriving (Show)
+  deriving (Show, Eq)
 
 {-# NOINLINE pRasterRef #-}
 pRasterRef :: IORef Raster

src/Reanimate/Raster.hs

@@ -29,6 +29,7 @@ import           Reanimate.Cache
 import           Reanimate.Misc
 import           Reanimate.Render
 import           Reanimate.Parameters
+import           Reanimate.Constants
 import           Reanimate.Svg.Constructors
 import           Reanimate.Svg.Unuse
 import           System.Directory
@@ -37,8 +38,49 @@ import           System.IO
 import           System.IO.Temp
 import           System.IO.Unsafe
 
--- FIXME: Embed the image data as inline base64 iff no raster engine is specified.
+-- | Load an external image. Width and height must be specified,
-mkImage :: Double -> Double -> FilePath -> SVG
+--   ignoring the image's aspect ratio. The center of the image is
+--   placed at position (0,0).
+--
+--   For security reasons, must SVG renderer do not allow arbitrary
+--   image links. For some renderers, we can get around this by placing
+--   the images in the same root directory as the parent SVG file. Other
+--   renderers (like Chrome and ffmpeg) requires that the image is inlined
+--   as base64 data. External SVG files are an exception, though, as must
+--   always be inlined directly. `mkImage` attempts to hide all the complexity
+--   but edge-cases may exist.
+--
+--   Example:
+--
+--   > mkImage screenWidth screenHeight "../data/haskell.svg"
+--
+--   <<docs/gifs/doc_mkImage.gif>>
+mkImage :: Double -- ^ Desired image width.
+        -> Double -- ^ Desired image height.
+        -> FilePath -- ^ Path to external image file.
+        -> SVG
+mkImage width height path | takeExtension path == ".svg" = unsafePerformIO $ do
+  svg_data <- B.readFile path
+  case parseSvgFile path svg_data of
+    Nothing  -> error "Malformed svg"
+    Just svg -> return $
+      scaleXY (width/screenWidth) (height/screenHeight) $
+      embedDocument svg
+mkImage width height path | pRaster == RasterNone = unsafePerformIO $ do
+  inp <- LBS.readFile path
+  let imgData = LBS.unpack $ Base64.encode inp
+  return $ flipYAxis $ ImageTree $ defaultSvg
+    & Svg.imageWidth .~ Svg.Num width
+    & Svg.imageHeight .~ Svg.Num height
+    & Svg.imageHref .~ ("data:"++mimeType++";base64,"++imgData)
+    & Svg.imageCornerUpperLeft .~ (Svg.Num (-width/2), Svg.Num (-height/2))
+    & Svg.imageAspectRatio .~ Svg.PreserveAspectRatio False Svg.AlignNone Nothing
+  where
+    -- FIXME: Is there a better way to do this?
+    mimeType =
+      case takeExtension path of
+        ".jpg" -> "image/jpeg"
+        ext    -> "image/" ++ drop 1 ext
 mkImage width height path = unsafePerformIO $ do
     exists <- doesFileExist target
     unless exists $ copyFile path target
@@ -59,13 +101,21 @@ cacheImage key gen = unsafePerformIO $ cacheFile template $ \path ->
     template = show (hash key) <.> "png"
 
 {-# INLINE embedImage #-}
-embedImage :: PngSavable a => Image a -> Tree
+-- | Embed an in-memory PNG image. Note, the pixel size of the image
+--   is used as the dimensions. As such, embedding a 100x100 PNG will
+--   result in an image 100 units wide and 100 units high. Consider
+--   using with 'scaleToSize'.
+embedImage :: PngSavable a => Image a -> SVG
 embedImage img = embedPng width height (encodePng img)
   where
     width  = fromIntegral $ imageWidth img
     height = fromIntegral $ imageHeight img
 
-embedPng :: Double -> Double -> LBS.ByteString -> Tree
+-- | Embed in-memory PNG bytestring without parsing it.
+embedPng :: Double -- ^ Width
+         -> Double -- ^ Height
+         -> LBS.ByteString -- ^ Raw PNG data
+         -> SVG
 -- embedPng w h png = unsafePerformIO $ do
 --     LBS.writeFile path png
 --     return $ ImageTree $ defaultSvg
@@ -86,7 +136,11 @@ embedPng w h png = flipYAxis $
 
 
 {-# INLINE embedDynamicImage #-}
-embedDynamicImage :: DynamicImage -> Tree
+-- | Embed an in-memory image. Note, the pixel size of the image
+--   is used as the dimensions. As such, embedding a 100x100 image will
+--   result in an image 100 units wide and 100 units high. Consider
+--   using with 'scaleToSize'.
+embedDynamicImage :: DynamicImage -> SVG
 embedDynamicImage img = embedPng width height imgData
   where
     width   = fromIntegral $ dynamicMap imageWidth img
@@ -111,21 +165,29 @@ embedDynamicImage img = embedPng width height imgData
 --           & Svg.imageHref .~ ("file://" ++ path)
 
 
-
+-- | Convert an SVG object to a pixel-based image. The default resolution
-raster :: Tree -> DynamicImage
+--   is 2560x1440. See also 'rasterSized'. Multiple raster engines are supported
+--   and are selected using the '--raster' flag in the driver.
+raster :: SVG -> DynamicImage
 raster = rasterSized 2560 1440
 
-rasterSized :: Int -> Int -> Tree -> DynamicImage
+-- | Convert an SVG object to a pixel-based image.
+rasterSized :: Int -- ^ X resolution in pixels
+            -> Int -- ^ Y resolution in pixels
+            -> SVG -- ^ SVG object
+            -> DynamicImage
 rasterSized w h svg = unsafePerformIO $ do
     png <- B.readFile (svgAsPngFile' w h svg)
     case decodePng png of
       Left{}    -> error "bad image"
       Right img -> return img
 
-vectorize :: FilePath -> Tree
+-- | Use 'potrace' to trace edges in a raster image and convert them to SVG polygons.
+vectorize :: FilePath -> SVG
 vectorize = vectorize_ []
 
-vectorize_ :: [String] -> FilePath -> Tree
+-- | Same as 'vectorize' but takes a list of arguments for 'potrace'.
+vectorize_ :: [String] -> FilePath -> SVG
 vectorize_ _ path | pNoExternals = mkText $ T.pack path
 vectorize_ args path = unsafePerformIO $ do
     root <- getXdgDirectory XdgCache "reanimate"
@@ -154,22 +216,28 @@ vectorize_ args path = unsafePerformIO $ do
 -- imageAsFile :: DynamicImage -> FilePath
 -- imageAsFile img
 
-svgAsPngFile :: Tree -> FilePath
+-- | Convert an SVG object to a pixel-based image and save it to disk, returning
+--   the filepath. The default resolution is 2560x1440. See also 'svgAsPngFile''.
+--   Multiple raster engines are supported and are selected using the '--raster'
+--   flag in the driver.
+svgAsPngFile :: SVG -> FilePath
 svgAsPngFile = svgAsPngFile' width height
   where
     width = 2560
     height = width * 9 `div` 16
 
-svgAsPngFile' :: Int -> Int -> Tree -> FilePath
+-- | Convert an SVG object to a pixel-based image and save it to disk, returning
+--   the filepath.
+svgAsPngFile' :: Int -- ^ Width
+              -> Int -- ^ Height
+              -> SVG -- ^ SVG object
+              -> FilePath
 svgAsPngFile' _ _ _ | pNoExternals = "/svgAsPngFile/has/been/disabled"
 svgAsPngFile' width height svg = unsafePerformIO $ cacheFile template $ \pngPath -> do
     let svgPath = replaceExtension pngPath "svg"
-    -- ffmpeg <- requireExecutable "ffmpeg"
-    -- convert <- requireExecutable "convert"
-    -- inkscape <- requireExecutable "inkscape"
     writeFile svgPath rendered
-    -- FIXME: raster should be configurable.
+    engine <- requireRaster pRaster
-    applyRaster RasterRSvg svgPath
+    applyRaster engine svgPath
   where
     template = show (hash rendered) <.> "png"
     rendered = renderSvg (Just $ Px $ fromIntegral width) (Just $ Px $ fromIntegral height) svg

src/Reanimate/Render.hs

@@ -1,11 +1,14 @@
+{-# LANGUAGE MultiWayIf #-}
 module Reanimate.Render
   ( render
-  , renderSvgs
+  , renderSvgs            -- :: Animation -> IO ()
-  , renderSnippets
+  , renderSnippets        -- :: Animation -> IO ()
   , Format(..)
   , Raster(..)
   , Width, Height, FPS
-  , applyRaster
+  , requireRaster         -- :: Raster -> IO Raster
+  , selectRaster          -- :: Raster -> IO Raster
+  , applyRaster           -- :: Raster -> FilePath -> IO ()
   ) where
 
 import           Control.Concurrent
@@ -14,18 +17,20 @@ import           Control.Monad       (forM_, void, unless, forever)
 import qualified Data.Text           as T
 import qualified Data.Text.IO        as T
 import           Data.Time
+import Data.Either
 import           Graphics.SvgTree    (Number (..))
 import           Numeric
 import           Reanimate.Animation
 import           Reanimate.Misc
 import           Reanimate.Parameters
+import           Reanimate.Driver.Check
 import           System.Exit
 import           System.FilePath     ((</>))
 import           System.FilePath     (replaceExtension)
 import           System.IO
 import           Text.Printf         (printf)
 
-renderSvgs :: Animation ->  IO ()
+renderSvgs :: Animation -> IO ()
 renderSvgs ani = do
     print frameCount
     lock <- newMVar ()
@@ -182,6 +187,28 @@ rasterTemplate :: Raster -> String
 rasterTemplate RasterNone = "render-%05d.svg"
 rasterTemplate _          = "render-%05d.png"
 
+requireRaster :: Raster -> IO Raster
+requireRaster raster = do
+  raster' <- selectRaster (if raster==RasterNone then RasterAuto else raster)
+  case raster' of
+    RasterNone -> do
+      hPutStrLn stderr
+        "Raster required but none could be found. \
+        \Please install either inkscape, imagemagick, or rsvg-convert."
+      exitWith (ExitFailure 1)
+    _ -> pure raster'
+
+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
+
 applyRaster :: Raster -> FilePath -> IO ()
 applyRaster RasterNone _ = return ()
 applyRaster RasterAuto _ = return ()