diff --git a/examples/raster.hs b/examples/raster.hs new file mode 100755 index 0000000..b317553 --- /dev/null +++ b/examples/raster.hs @@ -0,0 +1,26 @@ +#!/usr/bin/env stack +-- stack --resolver lts-11.14 runghc --package reanimate +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Control.Lens + +import Graphics.SvgTree (Number(..)) +import Reanimate.Driver (reanimate) +import Reanimate.LaTeX +import Reanimate.Monad +import Reanimate.Svg +import Reanimate.Signal +import Reanimate.Raster +import Codec.Picture + +main :: IO () +main = reanimate $ mkAnimation 2 $ do + s <- getSignal signalLinear + emit $ mkGroup + [ mkBackground "black" + , rotate (s*360) $ center $ scale 0.5 $ embedImage img ] + where + img = generateImage pixelRenderer 255 255 + pixelRenderer x y = PixelRGB8 (fromIntegral x) (fromIntegral y) 128 + diff --git a/reanimate.cabal b/reanimate.cabal index 6636bbb..6f5ef9c 100644 --- a/reanimate.cabal +++ b/reanimate.cabal @@ -48,6 +48,7 @@ library Reanimate.Driver Reanimate.Misc Reanimate.Morph + Reanimate.Raster other-modules: Reanimate.Svg.NamedColors Reanimate.Cache Paths_reanimate @@ -57,7 +58,7 @@ library JuicyPixels, attoparsec, parallel, diagrams, diagrams-svg, diagrams-core, diagrams-lib, diagrams-contrib, svg-builder, matrices, cubicbezier, palette, websockets, - hashable, fsnotify, open-browser + hashable, fsnotify, open-browser, random-shuffle, base64-bytestring Flag server Description: Enable rendering server diff --git a/src/Reanimate/Raster.hs b/src/Reanimate/Raster.hs new file mode 100644 index 0000000..d0faf02 --- /dev/null +++ b/src/Reanimate/Raster.hs @@ -0,0 +1,23 @@ +module Reanimate.Raster + ( embedImage + ) where + +import Control.Lens +import Codec.Picture +import Codec.Picture.Png +import qualified Data.ByteString.Base64.Lazy as Base64 +import qualified Data.ByteString.Lazy.Char8 as LBS +import Graphics.SvgTree (Tree(..), defaultSvg) +import qualified Graphics.SvgTree as Svg + +-- XXX: Use Px instead of Num for width and height? +{-# INLINE embedImage #-} +embedImage :: PngSavable a => Image a -> Tree +embedImage img = + ImageTree $ defaultSvg + & Svg.imageWidth .~ Svg.Num (fromIntegral $ imageWidth img) + & Svg.imageHeight .~ Svg.Num (fromIntegral $ imageHeight img) + & Svg.imageHref .~ ("data:image/png;base64," ++ imgData) + where + imgData = LBS.unpack $ Base64.encode (encodePng img) + diff --git a/src/Reanimate/Svg.hs b/src/Reanimate/Svg.hs index d9a3231..5c2cde0 100644 --- a/src/Reanimate/Svg.hs +++ b/src/Reanimate/Svg.hs @@ -2,7 +2,7 @@ module Reanimate.Svg where import Codec.Picture (PixelRGBA8 (..)) -import Codec.Picture.Types +import Codec.Picture.Types () import Control.Arrow import Control.Lens (over, set, (%~), (&), (.~), (^.)) import Control.Monad.Fix @@ -358,7 +358,11 @@ svgBoundingPoints t = map (Transform.transformPoint m) $ (Just (Num w), Just (Num h)) -> [V2 (x+w) (y+h)] _ -> [] TextTree{} -> [] - ImageTree{} -> [] + ImageTree img -> + case (img^.imageCornerUpperLeft, img^.imageWidth, img^.imageHeight) of + ((Num x, Num y), Num w, Num h) -> + [V2 x y, V2 (x+w) (y+h)] + _ -> [] MeshGradientTree{} -> [] where m = Transform.mkMatrix (t^.transform)