{-|
Module      : Reanimate.Raster
Copyright   : Written by David Himmelstrup
License     : Unlicense
Maintainer  : lemmih@gmail.com
Stability   : experimental
Portability : POSIX

Tools for generating, manipulating, and embedding raster images.

-}
module Reanimate.Raster
  ( mkImage           -- :: Double -> Double -> FilePath -> SVG
  , cacheImage        -- :: (PngSavable pixel, Hashable a) => a -> Image pixel -> FilePath
  , prerenderSvg      -- :: Hashable a => a -> SVG -> SVG
  , prerenderSvgFile  -- :: Hashable a => a -> Width -> Height -> SVG -> FilePath
  , embedImage        -- :: PngSavable a => Image a -> SVG
  , embedDynamicImage -- :: DynamicImage -> SVG
  , embedPng          -- :: Double -> Double -> LBS.ByteString -> SVG
  , raster            -- :: SVG -> DynamicImage
  , rasterSized       -- :: Width -> Height -> SVG -> DynamicImage
  , vectorize         -- :: FilePath -> SVG
  , vectorize_        -- :: [String] -> FilePath -> SVG
  , svgAsPngFile      -- :: SVG -> FilePath
  , svgAsPngFile'     -- :: Width -> Height -> SVG -> FilePath
  )
where

import           Codec.Picture               (DynamicImage, Image (imageHeight, imageWidth),
                                              PngSavable (encodePng), decodePng, dynamicMap,
                                              encodeDynamicPng, writePng)
import           Control.Lens                ((&), (.~))
import           Control.Monad               (unless)
import qualified Data.ByteString             as B
import qualified Data.ByteString.Base64.Lazy as Base64
import qualified Data.ByteString.Lazy.Char8  as LBS
import           Data.Hashable               (Hashable (hash))
import qualified Data.Text                   as T
import qualified Data.Text.IO                as T
import           Graphics.SvgTree            (Number (..), defaultSvg, parseSvgFile)
import qualified Graphics.SvgTree            as Svg
import           Reanimate.Animation         (SVG, renderSvg)
import           Reanimate.Cache             (cacheFile, encodeInt)
import           Reanimate.Constants         (screenHeight, screenWidth)
import           Reanimate.Driver.Magick     (magickCmd)
import           Reanimate.Misc              (fileUri, getReanimateCacheDirectory,
                                              renameOrCopyFile, requireExecutable,
                                              runCmd)
import           Reanimate.Parameters        (Height, Raster (RasterNone), Width, pHeight,
                                              pNoExternals, pRaster, pRootDirectory, pWidth)
import           Reanimate.Render            (applyRaster, requireRaster)
import           Reanimate.Svg.Constructors  (flipYAxis, mkText, scaleXY)
import           Reanimate.Svg.Unuse         (replaceUses, unbox, unboxFit)
import           System.Directory            (copyFile, doesFileExist, removeFile)
import           System.FilePath             (replaceExtension, takeExtension, (<.>), (</>))
import           System.IO                   (hClose)
import           System.IO.Temp              (withSystemTempFile)
import           System.IO.Unsafe            (unsafePerformIO)

-- | 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\"
-- @
--
--   <<docs/gifs/doc_mkImage.gif>>
mkImage
  :: Double -- ^ Desired image width.
  -> Double -- ^ Desired image height.
  -> FilePath -- ^ Path to external image file.
  -> SVG
mkImage :: Double -> Double -> FilePath -> SVG
mkImage Double
width Double
height FilePath
path | FilePath -> FilePath
takeExtension FilePath
path FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".svg" = IO SVG -> SVG
forall a. IO a -> a
unsafePerformIO (IO SVG -> SVG) -> IO SVG -> SVG
forall a b. (a -> b) -> a -> b
$ do
  Text
svg_data <- FilePath -> IO Text
T.readFile FilePath
path
  case FilePath -> Text -> Maybe Document
parseSvgFile FilePath
path Text
svg_data of
    Maybe Document
Nothing -> FilePath -> IO SVG
forall a. HasCallStack => FilePath -> a
error FilePath
"Malformed svg"
    Just Document
svg ->
      SVG -> IO SVG
forall (m :: * -> *) a. Monad m => a -> m a
return
        (SVG -> IO SVG) -> SVG -> IO SVG
forall a b. (a -> b) -> a -> b
$ Double -> Double -> SVG -> SVG
scaleXY (Double
width Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Fractional a => a
screenWidth) (Double
height Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
forall a. Fractional a => a
screenHeight)
        (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$ Document -> SVG
unboxFit Document
svg
mkImage Double
width Double
height FilePath
path | Raster
pRaster Raster -> Raster -> Bool
forall a. Eq a => a -> a -> Bool
== Raster
RasterNone = IO SVG -> SVG
forall a. IO a -> a
unsafePerformIO (IO SVG -> SVG) -> IO SVG -> SVG
forall a b. (a -> b) -> a -> b
$ do
  ByteString
inp <- FilePath -> IO ByteString
LBS.readFile FilePath
path
  let imgData :: FilePath
imgData = ByteString -> FilePath
LBS.unpack (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base64.encode ByteString
inp
  SVG -> IO SVG
forall (m :: * -> *) a. Monad m => a -> m a
return
    (SVG -> IO SVG) -> SVG -> IO SVG
forall a b. (a -> b) -> a -> b
$  SVG -> SVG
flipYAxis
    (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$  Image -> SVG
Svg.imageTree
    (Image -> SVG) -> Image -> SVG
forall a b. (a -> b) -> a -> b
$  Image
forall a. WithDefaultSvg a => a
defaultSvg
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (Number -> Identity Number) -> Image -> Identity Image
Lens' Image Number
Svg.imageWidth
    ((Number -> Identity Number) -> Image -> Identity Image)
-> Number -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Number
Svg.Num Double
width
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (Number -> Identity Number) -> Image -> Identity Image
Lens' Image Number
Svg.imageHeight
    ((Number -> Identity Number) -> Image -> Identity Image)
-> Number -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Number
Svg.Num Double
height
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (FilePath -> Identity FilePath) -> Image -> Identity Image
Lens' Image FilePath
Svg.imageHref
    ((FilePath -> Identity FilePath) -> Image -> Identity Image)
-> FilePath -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (FilePath
"data:" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
mimeType FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
";base64," FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
imgData)
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (Point -> Identity Point) -> Image -> Identity Image
Lens' Image Point
Svg.imageCornerUpperLeft
    ((Point -> Identity Point) -> Image -> Identity Image)
-> Point -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Double -> Number
Svg.Num (-Double
width Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2), Double -> Number
Svg.Num (-Double
height Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2))
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (PreserveAspectRatio -> Identity PreserveAspectRatio)
-> Image -> Identity Image
Lens' Image PreserveAspectRatio
Svg.imageAspectRatio
    ((PreserveAspectRatio -> Identity PreserveAspectRatio)
 -> Image -> Identity Image)
-> PreserveAspectRatio -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> Alignment -> Maybe MeetSlice -> PreserveAspectRatio
Svg.PreserveAspectRatio Bool
False Alignment
Svg.AlignNone Maybe MeetSlice
forall a. Maybe a
Nothing
 where
    -- FIXME: Is there a better way to do this?
  mimeType :: FilePath
mimeType = case FilePath -> FilePath
takeExtension FilePath
path of
    FilePath
".jpg" -> FilePath
"image/jpeg"
    FilePath
ext    -> FilePath
"image/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
ext
mkImage Double
width Double
height FilePath
path = IO SVG -> SVG
forall a. IO a -> a
unsafePerformIO (IO SVG -> SVG) -> IO SVG -> SVG
forall a b. (a -> b) -> a -> b
$ do
  Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
target
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
copyFile FilePath
path FilePath
target
  SVG -> IO SVG
forall (m :: * -> *) a. Monad m => a -> m a
return
    (SVG -> IO SVG) -> SVG -> IO SVG
forall a b. (a -> b) -> a -> b
$  SVG -> SVG
flipYAxis
    (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$  Image -> SVG
Svg.imageTree
    (Image -> SVG) -> Image -> SVG
forall a b. (a -> b) -> a -> b
$  Image
forall a. WithDefaultSvg a => a
defaultSvg
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (Number -> Identity Number) -> Image -> Identity Image
Lens' Image Number
Svg.imageWidth
    ((Number -> Identity Number) -> Image -> Identity Image)
-> Number -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Number
Svg.Num Double
width
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (Number -> Identity Number) -> Image -> Identity Image
Lens' Image Number
Svg.imageHeight
    ((Number -> Identity Number) -> Image -> Identity Image)
-> Number -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Number
Svg.Num Double
height
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (FilePath -> Identity FilePath) -> Image -> Identity Image
Lens' Image FilePath
Svg.imageHref
    ((FilePath -> Identity FilePath) -> Image -> Identity Image)
-> FilePath -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (FilePath -> FilePath
fileUri FilePath
target)
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (Point -> Identity Point) -> Image -> Identity Image
Lens' Image Point
Svg.imageCornerUpperLeft
    ((Point -> Identity Point) -> Image -> Identity Image)
-> Point -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Double -> Number
Svg.Num (-Double
width Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2), Double -> Number
Svg.Num (-Double
height Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2))
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (PreserveAspectRatio -> Identity PreserveAspectRatio)
-> Image -> Identity Image
Lens' Image PreserveAspectRatio
Svg.imageAspectRatio
    ((PreserveAspectRatio -> Identity PreserveAspectRatio)
 -> Image -> Identity Image)
-> PreserveAspectRatio -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> Alignment -> Maybe MeetSlice -> PreserveAspectRatio
Svg.PreserveAspectRatio Bool
False Alignment
Svg.AlignNone Maybe MeetSlice
forall a. Maybe a
Nothing
 where
  target :: FilePath
target   = FilePath
pRootDirectory FilePath -> FilePath -> FilePath
</> Int -> FilePath
encodeInt Int
hashPath FilePath -> FilePath -> FilePath
<.> FilePath -> FilePath
takeExtension FilePath
path
  hashPath :: Int
hashPath = FilePath -> Int
forall a. Hashable a => a -> Int
hash FilePath
path

-- | Write in-memory image to cache file if (and only if) such cache file doesn't
--   already exist.
cacheImage :: (PngSavable pixel, Hashable a) => a -> Image pixel -> FilePath
cacheImage :: a -> Image pixel -> FilePath
cacheImage a
key Image pixel
gen = IO FilePath -> FilePath
forall a. IO a -> a
unsafePerformIO (IO FilePath -> FilePath) -> IO FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath -> IO ()) -> IO FilePath
cacheFile FilePath
template ((FilePath -> IO ()) -> IO FilePath)
-> (FilePath -> IO ()) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \FilePath
path ->
  FilePath -> Image pixel -> IO ()
forall pixel. PngSavable pixel => FilePath -> Image pixel -> IO ()
writePng FilePath
path Image pixel
gen
  where template :: FilePath
template = Int -> FilePath
encodeInt (a -> Int
forall a. Hashable a => a -> Int
hash a
key) FilePath -> FilePath -> FilePath
<.> FilePath
"png"

-- Warning: Caching svg elements with links to external objects does
--          not work. 2020-06-01
-- | Same as 'prerenderSvg' but returns the location of the rendered image
--   as a FilePath.
prerenderSvgFile :: Hashable a => a -> Width -> Height -> SVG -> FilePath
prerenderSvgFile :: a -> Int -> Int -> SVG -> FilePath
prerenderSvgFile a
key Int
width Int
height SVG
svg =
  IO FilePath -> FilePath
forall a. IO a -> a
unsafePerformIO (IO FilePath -> FilePath) -> IO FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath -> IO ()) -> IO FilePath
cacheFile FilePath
template ((FilePath -> IO ()) -> IO FilePath)
-> (FilePath -> IO ()) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \FilePath
path -> do
    let svgPath :: FilePath
svgPath = FilePath -> FilePath -> FilePath
replaceExtension FilePath
path FilePath
"svg"
    FilePath -> FilePath -> IO ()
writeFile FilePath
svgPath FilePath
rendered
    Raster
engine <- Raster -> IO Raster
requireRaster Raster
pRaster
    Raster -> FilePath -> IO ()
applyRaster Raster
engine FilePath
svgPath
 where
  template :: FilePath
template = Int -> FilePath
encodeInt ((a, Int, Int) -> Int
forall a. Hashable a => a -> Int
hash (a
key, Int
width, Int
height)) FilePath -> FilePath -> FilePath
<.> FilePath
"png"
  rendered :: FilePath
rendered = Maybe Number -> Maybe Number -> SVG -> FilePath
renderSvg (Number -> Maybe Number
forall a. a -> Maybe a
Just (Number -> Maybe Number) -> Number -> Maybe Number
forall a b. (a -> b) -> a -> b
$ Double -> Number
Px (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
                       (Number -> Maybe Number
forall a. a -> Maybe a
Just (Number -> Maybe Number) -> Number -> Maybe Number
forall a b. (a -> b) -> a -> b
$ Double -> Number
Px (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
                       SVG
svg

-- | Render SVG node to a PNG file and return a new node containing
--   that image. For static SVG nodes, this can hugely improve performance.
--   The first argument is the key that determines SVG uniqueness. It
--   is entirely your responsibility to ensure that all keys are unique.
--   If they are not, you will be served stale results from the cache.
prerenderSvg :: Hashable a => a -> SVG -> SVG
prerenderSvg :: a -> SVG -> SVG
prerenderSvg a
key =
  Double -> Double -> FilePath -> SVG
mkImage Double
forall a. Fractional a => a
screenWidth Double
forall a. Fractional a => a
screenHeight (FilePath -> SVG) -> (SVG -> FilePath) -> SVG -> SVG
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int -> Int -> SVG -> FilePath
forall a. Hashable a => a -> Int -> Int -> SVG -> FilePath
prerenderSvgFile a
key Int
pWidth Int
pHeight


{-# INLINE embedImage #-}
-- | 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 :: Image a -> SVG
embedImage Image a
img = Double -> Double -> ByteString -> SVG
embedPng Double
width Double
height (Image a -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng Image a
img)
 where
  width :: Double
width  = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Image a -> Int
forall a. Image a -> Int
imageWidth Image a
img
  height :: Double
height = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Image a -> Int
forall a. Image a -> Int
imageHeight Image a
img

-- | 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
--       & Svg.imageCornerUpperLeft .~ (Svg.Num (-w/2), Svg.Num (-h/2))
--       & Svg.imageWidth .~ Svg.Num w
--       & Svg.imageHeight .~ Svg.Num h
--       & Svg.imageHref .~ ("file://"++path)
--   where
--     path = "/tmp" </> show (hash png) <.> "png"
embedPng :: Double -> Double -> ByteString -> SVG
embedPng Double
w Double
h ByteString
png =
  SVG -> SVG
flipYAxis
    (SVG -> SVG) -> SVG -> SVG
forall a b. (a -> b) -> a -> b
$  Image -> SVG
Svg.imageTree
    (Image -> SVG) -> Image -> SVG
forall a b. (a -> b) -> a -> b
$  Image
forall a. WithDefaultSvg a => a
defaultSvg
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (Point -> Identity Point) -> Image -> Identity Image
Lens' Image Point
Svg.imageCornerUpperLeft
    ((Point -> Identity Point) -> Image -> Identity Image)
-> Point -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Double -> Number
Svg.Num (-Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2), Double -> Number
Svg.Num (-Double
h Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2))
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (Number -> Identity Number) -> Image -> Identity Image
Lens' Image Number
Svg.imageWidth
    ((Number -> Identity Number) -> Image -> Identity Image)
-> Number -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Number
Svg.Num Double
w
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (Number -> Identity Number) -> Image -> Identity Image
Lens' Image Number
Svg.imageHeight
    ((Number -> Identity Number) -> Image -> Identity Image)
-> Number -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Number
Svg.Num Double
h
    Image -> (Image -> Image) -> Image
forall a b. a -> (a -> b) -> b
&  (FilePath -> Identity FilePath) -> Image -> Identity Image
Lens' Image FilePath
Svg.imageHref
    ((FilePath -> Identity FilePath) -> Image -> Identity Image)
-> FilePath -> Image -> Image
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (FilePath
"data:image/png;base64," FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
imgData)
  where imgData :: FilePath
imgData = ByteString -> FilePath
LBS.unpack (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base64.encode ByteString
png


{-# INLINE embedDynamicImage #-}
-- | 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 :: DynamicImage -> SVG
embedDynamicImage DynamicImage
img = Double -> Double -> ByteString -> SVG
embedPng Double
width Double
height ByteString
imgData
 where
  width :: Double
width   = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ (forall pixel. Pixel pixel => Image pixel -> Int)
-> DynamicImage -> Int
forall a.
(forall pixel. Pixel pixel => Image pixel -> a)
-> DynamicImage -> a
dynamicMap forall a. Image a -> Int
forall pixel. Pixel pixel => Image pixel -> Int
imageWidth DynamicImage
img
  height :: Double
height  = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ (forall pixel. Pixel pixel => Image pixel -> Int)
-> DynamicImage -> Int
forall a.
(forall pixel. Pixel pixel => Image pixel -> a)
-> DynamicImage -> a
dynamicMap forall a. Image a -> Int
forall pixel. Pixel pixel => Image pixel -> Int
imageHeight DynamicImage
img
  imgData :: ByteString
imgData = case DynamicImage -> Either FilePath ByteString
encodeDynamicPng DynamicImage
img of
    Left  FilePath
err -> FilePath -> ByteString
forall a. HasCallStack => FilePath -> a
error FilePath
err
    Right ByteString
dat -> ByteString
dat

-- embedImageFile :: FilePath -> Tree
-- embedImageFile path = unsafePerformIO $ do
--     png <- B.readFile path
--     case decodePng png of
--       Left{}    -> error "bad image"
--       Right img -> return $
--         let width   = fromIntegral $ dynamicMap imageWidth img
--             height  = fromIntegral $ dynamicMap imageHeight img in
--         ImageTree $ defaultSvg
--           & Svg.imageCornerUpperLeft .~ (Svg.Num (-width/2), Svg.Num (-height/2))
--           & Svg.imageWidth .~ Svg.Num width
--           & Svg.imageHeight .~ Svg.Num height
--           & Svg.imageHref .~ ("file://" ++ path)


-- | 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 :: SVG -> DynamicImage
raster = Int -> Int -> SVG -> DynamicImage
rasterSized Int
2560 Int
1440

-- | Convert an SVG object to a pixel-based image.
rasterSized
  :: Width  -- ^ X resolution in pixels
  -> Height -- ^ Y resolution in pixels
  -> SVG    -- ^ SVG object
  -> DynamicImage
rasterSized :: Int -> Int -> SVG -> DynamicImage
rasterSized Int
w Int
h SVG
svg = IO DynamicImage -> DynamicImage
forall a. IO a -> a
unsafePerformIO (IO DynamicImage -> DynamicImage)
-> IO DynamicImage -> DynamicImage
forall a b. (a -> b) -> a -> b
$ do
  ByteString
png <- FilePath -> IO ByteString
B.readFile (Int -> Int -> SVG -> FilePath
svgAsPngFile' Int
w Int
h SVG
svg)
  case ByteString -> Either FilePath DynamicImage
decodePng ByteString
png of
    Left{}    -> FilePath -> IO DynamicImage
forall a. HasCallStack => FilePath -> a
error FilePath
"bad image"
    Right DynamicImage
img -> DynamicImage -> IO DynamicImage
forall (m :: * -> *) a. Monad m => a -> m a
return DynamicImage
img

-- | Use \'potrace\' to trace edges in a raster image and convert them to SVG polygons.
vectorize :: FilePath -> SVG
vectorize :: FilePath -> SVG
vectorize = [FilePath] -> FilePath -> SVG
vectorize_ []

-- | Same as 'vectorize' but takes a list of arguments for \'potrace\'.
vectorize_ :: [String] -> FilePath -> SVG
vectorize_ :: [FilePath] -> FilePath -> SVG
vectorize_ [FilePath]
_ FilePath
path | Bool
pNoExternals = Text -> SVG
mkText (Text -> SVG) -> Text -> SVG
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
path
vectorize_ [FilePath]
args FilePath
path             = IO SVG -> SVG
forall a. IO a -> a
unsafePerformIO (IO SVG -> SVG) -> IO SVG -> SVG
forall a b. (a -> b) -> a -> b
$ do
  FilePath
root <- IO FilePath
getReanimateCacheDirectory
  let svgPath :: FilePath
svgPath = FilePath
root FilePath -> FilePath -> FilePath
</> Int -> FilePath
encodeInt Int
key FilePath -> FilePath -> FilePath
<.> FilePath
"svg"
  Bool
hit <- FilePath -> IO Bool
doesFileExist FilePath
svgPath
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hit (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile FilePath
"file.svg" ((FilePath -> Handle -> IO ()) -> IO ())
-> (FilePath -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
tmpSvgPath Handle
svgH ->
    FilePath -> (FilePath -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile FilePath
"file.bmp" ((FilePath -> Handle -> IO ()) -> IO ())
-> (FilePath -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
tmpBmpPath Handle
bmpH -> do
      Handle -> IO ()
hClose Handle
svgH
      Handle -> IO ()
hClose Handle
bmpH
      FilePath
potrace <- FilePath -> IO FilePath
requireExecutable FilePath
"potrace"
      FilePath
magick <- FilePath -> IO FilePath
requireExecutable FilePath
magickCmd
      FilePath -> [FilePath] -> IO ()
runCmd FilePath
magick [FilePath
path, FilePath
"-flatten", FilePath
tmpBmpPath]
      FilePath -> [FilePath] -> IO ()
runCmd FilePath
potrace ([FilePath]
args [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"--svg", FilePath
"--output", FilePath
tmpSvgPath, FilePath
tmpBmpPath])
      FilePath -> FilePath -> IO ()
renameOrCopyFile FilePath
tmpSvgPath FilePath
svgPath
  Text
svg_data <- FilePath -> IO Text
T.readFile FilePath
svgPath
  case FilePath -> Text -> Maybe Document
parseSvgFile FilePath
svgPath Text
svg_data of
    Maybe Document
Nothing -> do
      FilePath -> IO ()
removeFile FilePath
svgPath
      FilePath -> IO SVG
forall a. HasCallStack => FilePath -> a
error FilePath
"Malformed svg"
    Just Document
svg -> SVG -> IO SVG
forall (m :: * -> *) a. Monad m => a -> m a
return (SVG -> IO SVG) -> SVG -> IO SVG
forall a b. (a -> b) -> a -> b
$ Document -> SVG
unbox (Document -> SVG) -> Document -> SVG
forall a b. (a -> b) -> a -> b
$ Document -> Document
replaceUses Document
svg
  where key :: Int
key = (FilePath, [FilePath]) -> Int
forall a. Hashable a => a -> Int
hash (FilePath
path, [FilePath]
args)

-- imageAsFile :: DynamicImage -> FilePath
-- imageAsFile img

-- | 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 :: SVG -> FilePath
svgAsPngFile = Int -> Int -> SVG -> FilePath
svgAsPngFile' Int
width Int
height
 where
  width :: Int
width  = Int
2560
  height :: Int
height = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
9 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
16

-- | Convert an SVG object to a pixel-based image and save it to disk, returning
--   the filepath.
svgAsPngFile'
  :: Width  -- ^ Width
  -> Height -- ^ Height
  -> SVG    -- ^ SVG object
  -> FilePath
svgAsPngFile' :: Int -> Int -> SVG -> FilePath
svgAsPngFile' Int
_ Int
_ SVG
_ | Bool
pNoExternals = FilePath
"/svgAsPngFile/has/been/disabled"
svgAsPngFile' Int
width Int
height SVG
svg =
  IO FilePath -> FilePath
forall a. IO a -> a
unsafePerformIO (IO FilePath -> FilePath) -> IO FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath -> IO ()) -> IO FilePath
cacheFile FilePath
template ((FilePath -> IO ()) -> IO FilePath)
-> (FilePath -> IO ()) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \FilePath
pngPath -> do
    let svgPath :: FilePath
svgPath = FilePath -> FilePath -> FilePath
replaceExtension FilePath
pngPath FilePath
"svg"
    FilePath -> FilePath -> IO ()
writeFile FilePath
svgPath FilePath
rendered
    Raster
engine <- Raster -> IO Raster
requireRaster Raster
pRaster
    Raster -> FilePath -> IO ()
applyRaster Raster
engine FilePath
svgPath
 where
  template :: FilePath
template = Int -> FilePath
encodeInt (FilePath -> Int
forall a. Hashable a => a -> Int
hash FilePath
rendered) FilePath -> FilePath -> FilePath
<.> FilePath
"png"
  rendered :: FilePath
rendered = Maybe Number -> Maybe Number -> SVG -> FilePath
renderSvg (Number -> Maybe Number
forall a. a -> Maybe a
Just (Number -> Maybe Number) -> Number -> Maybe Number
forall a b. (a -> b) -> a -> b
$ Double -> Number
Px (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width)
                       (Number -> Maybe Number
forall a. a -> Maybe a
Just (Number -> Maybe Number) -> Number -> Maybe Number
forall a b. (a -> b) -> a -> b
$ Double -> Number
Px (Double -> Number) -> Double -> Number
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
                       SVG
svg