diff --git a/ChangeLog.md b/ChangeLog.md index 2e47646..ac0932b 100644 --- a/ChangeLog.md +++ b/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. diff --git a/docs/gen_doc_gifs.sh b/docs/gen_doc_gifs.sh index 552e374..862ddd4 100755 --- a/docs/gen_doc_gifs.sh +++ b/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 diff --git a/examples/doc_mkImage.hs b/examples/doc_mkImage.hs new file mode 100755 index 0000000..2963ef5 --- /dev/null +++ b/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" diff --git a/examples/tut_glue_povray.hs b/examples/tut_glue_povray.hs index 5e11a39..1866c2a 100755 --- a/examples/tut_glue_povray.hs +++ b/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 diff --git a/src/Reanimate.hs b/src/Reanimate.hs index 6dacdc0..dba235a 100644 --- a/src/Reanimate.hs +++ b/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 diff --git a/src/Reanimate/Driver.hs b/src/Reanimate/Driver.hs index a6567ca..525f1a8 100644 --- a/src/Reanimate/Driver.hs +++ b/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) diff --git a/src/Reanimate/Parameters.hs b/src/Reanimate/Parameters.hs index 619eb0a..3b459dd 100644 --- a/src/Reanimate/Parameters.hs +++ b/src/Reanimate/Parameters.hs @@ -30,7 +30,7 @@ data Raster | RasterInkscape | RasterRSvg | RasterConvert - deriving (Show) + deriving (Show, Eq) {-# NOINLINE pRasterRef #-} pRasterRef :: IORef Raster diff --git a/src/Reanimate/Raster.hs b/src/Reanimate/Raster.hs index 21d01e7..ab8b241 100644 --- a/src/Reanimate/Raster.hs +++ b/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. -mkImage :: Double -> Double -> FilePath -> SVG +-- | Load an external image. Width and height must be specified, +-- 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" +-- +-- <> +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) - -raster :: Tree -> DynamicImage +-- | Convert an SVG object to a pixel-based image. The default resolution +-- 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. - applyRaster RasterRSvg svgPath + engine <- requireRaster pRaster + applyRaster engine svgPath where template = show (hash rendered) <.> "png" rendered = renderSvg (Just $ Px $ fromIntegral width) (Just $ Px $ fromIntegral height) svg diff --git a/src/Reanimate/Render.hs b/src/Reanimate/Render.hs index a2b294c..6e55e38 100644 --- a/src/Reanimate/Render.hs +++ b/src/Reanimate/Render.hs @@ -1,11 +1,14 @@ +{-# LANGUAGE MultiWayIf #-} module Reanimate.Render ( render - , renderSvgs - , renderSnippets + , renderSvgs -- :: Animation -> IO () + , 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 ()