diff --git a/reanimate.cabal b/reanimate.cabal index abc790c..a3df5cc 100644 --- a/reanimate.cabal +++ b/reanimate.cabal @@ -16,20 +16,23 @@ cabal-version: >=1.10 library hs-source-dirs: src default-language: Haskell2010 - exposed-modules: Reanimate.Arrow - Reanimate.Monad + default-extensions: PackageImports + exposed-modules: Reanimate.Monad Reanimate.Render Reanimate.Examples Reanimate.Combinators Reanimate.LaTeX Reanimate.Svg + Reanimate.Diagrams Reanimate.Transform other-modules: Reanimate.Misc Reanimate.Svg.NamedColors build-depends: base >=4.10 && <4.13, - lucid-svg, time, text, unix, lucid, filepath, process, directory, + time, text, unix, lucid, filepath, process, directory, containers, svg-tree >= 0.6.2.3, xml, bytestring, lens, linear, mtl, matrix, - JuicyPixels, attoparsec, parallel + JuicyPixels, attoparsec, parallel, diagrams, diagrams-svg, + diagrams-core, diagrams-lib, diagrams-contrib, + svg-builder, matrices, cubicbezier, palette Flag gtk-viewer Description: Enable gtk-based viewer diff --git a/src/Reanimate/Combinators.hs b/src/Reanimate/Combinators.hs index 59d81cd..644c40b 100644 --- a/src/Reanimate/Combinators.hs +++ b/src/Reanimate/Combinators.hs @@ -7,9 +7,8 @@ import Data.Fixed (mod') import Data.Monoid ((<>)) import Data.Text (Text, pack) import qualified Data.Text as T -import Lucid.Svg -import Reanimate.Arrow +-- import Reanimate.Arrow type Path = [(Double, Double)] diff --git a/src/Reanimate/Diagrams.hs b/src/Reanimate/Diagrams.hs new file mode 100644 index 0000000..9af8889 --- /dev/null +++ b/src/Reanimate/Diagrams.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE TypeFamilies #-} +module Reanimate.Diagrams + ( renderDiagram + , SvgDiagram + ) where + +import qualified Data.ByteString.Lazy as BL +import qualified Diagrams.Backend.SVG as D +import qualified Diagrams.Core.Compile as D +import qualified Diagrams.Core.Types as D +import qualified Diagrams.Size as D +import "svg-tree" Graphics.Svg (Document (..), Tree (..), defaultSvg, + elements, loadSvgFile, parseSvgFile, + xmlOfDocument) +import qualified Graphics.Svg.Core as Svg +import Linear.V2 +import Reanimate.Svg (unbox) + +import Diagrams.Prelude +import qualified Diagrams.Prelude as D + +renderDiagram :: SvgDiagram -> Tree +renderDiagram d = + case parseSvgFile "" (BL.toStrict $ Svg.renderBS (renderDia D.SVG opts d)) of + Nothing -> error "Malformed svg" + Just svg -> unbox svg + where + -- opts = SVGOptions (mkSizeSpec (V2 Nothing Nothing)) Nothing "" [] False + opts = D.SVGOptions absolute Nothing "" [] False + +type SvgDiagram = D.Diagram D.SVG diff --git a/src/Reanimate/Examples.hs b/src/Reanimate/Examples.hs index 2c1c9e8..f0a4b8f 100644 --- a/src/Reanimate/Examples.hs +++ b/src/Reanimate/Examples.hs @@ -1,25 +1,37 @@ -{-# LANGUAGE Arrows #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ParallelListComp #-} +{-# LANGUAGE Arrows #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE ParallelListComp #-} +{-# LANGUAGE TypeFamilies #-} module Reanimate.Examples where -import Control.Lens -import Control.Monad +import qualified Data.Map as M import Codec.Picture.Types -import Data.Monoid -import Data.Monoid ((<>)) -import Data.Text (Text, pack) -import Graphics.Svg as S +import Control.Lens () +import Control.Monad +import Data.Text (Text, pack) +import "svg-tree" Graphics.Svg as S import Linear.V2 import Numeric import Text.Printf -import Reanimate.Monad import Reanimate.Combinators import Reanimate.LaTeX +import Reanimate.Monad import Reanimate.Svg +import Reanimate.Diagrams -import Debug.Trace +import qualified Diagrams.Backend.SVG as D +import Diagrams.Prelude hiding (Animation, boundingBox, center, + duration, fontSize, rotate, scale, + translate, circle) +import qualified Diagrams.Prelude as D +import qualified Diagrams.TwoD.Path.LSystem as D +import qualified Data.Colour.Palette.BrewerSet as D + +import Debug.Trace {- sinewave :: Ani () @@ -642,3 +654,99 @@ valentine = n <- oscillate $ signalSCurve 2 0.9 1.1 emit $ scale n $ scale 2 $ withFillColor "white" $ withFillOpacity o txt drawHeart = emit $ withFillColor "red" $ heartShape + + +diaSize :: Animation +diaSize = mkAnimation 0.1 $ do + emit $ mkBackground "white" + emit $ translate (-320/2) (-180/2) dSvg + where + dSvg = renderDiagram $ withEnvelope (D.rect 320 180 :: SvgDiagram) $ + D.scale 3 $ + D.translate (V2 0 (-30)) $ + D.rotate (90 @@ deg) $ + D.lwO 0.1 $ D.strokePath (D.getTurtlePath (D.tree3 4)) + +wavyTree :: Animation +wavyTree = mkAnimation 1 $ do + s <- oscillate $ signal 1 2 + emit $ mkBackground "white" + emit $ translate (-320/2) (-180/2) (dSvg s) + where + dSvg s = renderDiagram $ withEnvelope (D.rect 320 180 :: SvgDiagram) $ + D.scale 3 $ + D.translate (V2 0 (-30)) $ + D.rotate (90 @@ deg) $ + D.lwO 0.1 $ D.strokePath (D.getTurtlePath (tree s)) + gens = 4 + tree s = + D.lSystem gens (s/16 @@ turn) (D.symbols "F") rules + rules = M.fromList [D.rule 'F' "FF-[->F+F+>F]+[+>F->F->F]"] + +tangentAndNormal :: Animation +tangentAndNormal = mkAnimation 5 $ do + s <- oscillate $ signalSCurve 2 0 1 + emit $ mkBackground "white" + emit $ translate (-320/2) (-180/2) $ renderDiagram $ + withEnvelope (D.rect 320 180 :: SvgDiagram) $ + D.scale 50 $ D.translate (V2 (-2) (-0.75)) $ dia s + where + dia param = + frame 0.5 $ + strokeLocTrail spline + <> mconcat + [ tangentLine + , baselineText "tangent" # D.translate tangentVector + , normalLine + , topLeftText "normal" # D.translate (-normalVector) + , rightAngleSquare + ] # moveTo pt # D.fontSize large + where + pts = map p2 [(0,0), (1,1), (2,1), (3,0), (3.5,0)] + + spline :: Located (Trail V2 Double) + spline = cubicSpline False pts + + pt = atParam spline param + tangentVector :: V2 Double + tangentVector = D.normalize $ tangentAtParam spline param + normalVector = D.normalize $ normalAtParam spline param + + symmetricLine :: V2 Double -> SvgDiagram + symmetricLine v = fromOffsets [2 *^ v] # D.center + tangentLine :: SvgDiagram + tangentLine = symmetricLine tangentVector + normalLine = symmetricLine normalVector + + rightAngleSquare :: SvgDiagram + rightAngleSquare = square 0.1 # alignBL # D.rotate (signedAngleBetween tangentVector unitX) + + +drawSunflower :: Animation +drawSunflower = mkAnimation 10 $ do + n <- signal 1 500 + rot <- signal 0 45 + emit $ mkBackground "black" + emit $ rotate rot $ translate (-320/2) (-180/2) + (dSvg $ round n) + where + cached = [ dSvg n | n <- [0..]] + dSvg n = renderDiagram $ withEnvelope (D.rect 320 180 :: SvgDiagram) $ + D.scale 5 $ sunflower n + + mkCoords :: [P2 Double] + mkCoords =[coord (fromIntegral i) | i <- [1..]] + where + coord m = p2 $ fromPolar (sqrt m) (2.4 * m) + fromPolar r theta = (r * cos theta, r * sin theta) + + floret :: Double -> SvgDiagram + floret r = D.circle 0.6 # lw none # fc (colors !! n) + where + n = floor (1.4 * sqrt r) `mod` 10 + colors = black : (reverse $ D.brewerSet D.YlOrBr 9) + + sunflower :: Int -> SvgDiagram + sunflower n = frame 4 $ position $ take n $ zip mkCoords florets + where + florets = [ floret (sqrt (fromIntegral i)) | i <- [1 ..]] diff --git a/src/Reanimate/LaTeX.hs b/src/Reanimate/LaTeX.hs index 98030fe..835d42d 100644 --- a/src/Reanimate/LaTeX.hs +++ b/src/Reanimate/LaTeX.hs @@ -7,15 +7,13 @@ import qualified Data.ByteString as B import Data.IORef import Data.Map (Map) import qualified Data.Map as Map -import Lucid (ToHtml (..)) -import Lucid.Svg (Svg, fill_, font_size_, text_) import Reanimate.Misc import Reanimate.Svg import System.FilePath (replaceExtension, takeFileName, ()) import System.IO.Unsafe (unsafePerformIO) import Control.Lens (over, set, (%~), (&), (.~), (^.)) -import Graphics.Svg (Document (..), Tree (..), defaultSvg, +import "svg-tree" Graphics.Svg (Document (..), Tree (..), defaultSvg, elements, loadSvgFile, parseSvgFile, xmlOfDocument) import Text.XML.Light (elContent) @@ -25,26 +23,26 @@ import Text.XML.Light.Output (ppcContent, ppcElement, prettyConfigPP) -- toHtml = toHtmlRaw -- toHtmlRaw = toHtmlRaw . ppcElement prettyConfigPP . xmlOfDocument -instance ToHtml Document where - toHtml = toHtmlRaw - toHtmlRaw doc = toHtmlRaw $ unlines $ map (ppcContent prettyConfigPP) (elContent elt) - where - elt = xmlOfDocument doc - -instance ToHtml Tree where - toHtml = toHtmlRaw - toHtmlRaw tree = toHtmlRaw doc - where - doc = Document - { _viewBox = Nothing - , _width = Nothing - , _height = Nothing - , _elements = [tree] - , _definitions = Map.empty - , _description = "" - , _styleRules = [] - , _documentLocation = "" - } +-- instance ToHtml Document where +-- toHtml = toHtmlRaw +-- toHtmlRaw doc = toHtmlRaw $ unlines $ map (ppcContent prettyConfigPP) (elContent elt) +-- where +-- elt = xmlOfDocument doc +-- +-- instance ToHtml Tree where +-- toHtml = toHtmlRaw +-- toHtmlRaw tree = toHtmlRaw doc +-- where +-- doc = Document +-- { _viewBox = Nothing +-- , _width = Nothing +-- , _height = Nothing +-- , _elements = [tree] +-- , _definitions = Map.empty +-- , _description = "" +-- , _styleRules = [] +-- , _documentLocation = "" +-- } {-# NOINLINE cache #-} cache :: IORef (Map String Tree) diff --git a/src/Reanimate/Monad.hs b/src/Reanimate/Monad.hs index 513dc8c..ddae705 100644 --- a/src/Reanimate/Monad.hs +++ b/src/Reanimate/Monad.hs @@ -8,7 +8,7 @@ import Data.Fixed (mod') import qualified Data.Map as M import Data.Monoid ((<>)) import Data.Text (Text, pack) -import Graphics.Svg (Document (..), Number (..), Tree, +import "svg-tree" Graphics.Svg (Document (..), Number (..), Tree, xmlOfDocument, Tree(..), Text(..), TextSpan(..), TextSpanContent(..)) import Reanimate.LaTeX import Reanimate.Svg diff --git a/src/Reanimate/Render.hs b/src/Reanimate/Render.hs index dd05224..1760662 100644 --- a/src/Reanimate/Render.hs +++ b/src/Reanimate/Render.hs @@ -8,11 +8,11 @@ import Control.Parallel.Strategies import qualified Data.ByteString.Lazy.Char8 as BS import qualified Data.Text as T import qualified Data.Text.IO as T -import Graphics.Svg (Number (..)) -import Lucid.Svg (renderBS, renderToFile) +import "svg-tree" Graphics.Svg (Number (..)) import Reanimate.Examples import Reanimate.Misc import Reanimate.Monad +import Reanimate.Diagrams import System.Directory (renameFile) import System.FilePath (takeExtension, takeFileName, ()) @@ -85,12 +85,16 @@ renderFormat format ani target = do -- XXX: Use threads generateFrames ani rate action = withTempDir $ \tmp -> do let frameName nth = tmp printf nameTemplate nth - forM_ frames $ \n -> - writeFile (frameName n) (renderSizedTree width height $ nthFrame n) + rendered = [ renderSizedTree width height $ nthFrame n | n <- frames] + `using` parBuffer 16 rdeepseq + forM_ (zip [0::Int ..] rendered) $ \(n, frame) -> do + writeFile (frameName n) frame + putStr $ "\r" ++ show (n+1) ++ "/" ++ show frameCount + putStrLn "\n" action (tmp nameTemplate) where - width = Just $ Num 320 - height = Just $ Num 180 + width = Just $ Num 1024 + height = Just $ Num 768 frames = [0..frameCount-1] nthFrame nth = frameAt (recip (fromIntegral rate) * fromIntegral nth) ani frameCount = round (duration ani * fromIntegral rate) :: Int diff --git a/src/Reanimate/Svg.hs b/src/Reanimate/Svg.hs index 4d27faa..0d8c3cb 100644 --- a/src/Reanimate/Svg.hs +++ b/src/Reanimate/Svg.hs @@ -1,18 +1,19 @@ module Reanimate.Svg where import Codec.Picture (PixelRGBA8 (..)) +import Codec.Picture.Types +import Control.Arrow import Control.Lens (over, set, (%~), (&), (.~), (^.)) import Control.Monad.Fix import Control.Monad.State -import Control.Arrow import Data.Attoparsec.Text (parseOnly) import Data.List import qualified Data.Map as Map import Data.Maybe import qualified Data.Text as T -import Graphics.Svg -import Codec.Picture.Types -import Graphics.Svg.PathParser +import qualified Geom2D.CubicBezier as Bezier +import "svg-tree" Graphics.Svg +import "svg-tree" Graphics.Svg.PathParser import Linear.Metric import Linear.V2 import Linear.Vector @@ -331,7 +332,7 @@ svgBoundingPoints t = map (Transform.transformPoint m) $ (Num x, Num y) -> [V2 x y] ++ case mapTuple (toUserUnit defaultDPI) (rect^.rectWidth, rect^.rectHeight) of (Num w, Num h) -> [V2 (x+w) (y+h)] - _ -> [] + _ -> [] _ -> [] TextTree{} -> [] ImageTree{} -> [] diff --git a/src/Reanimate/Transform.hs b/src/Reanimate/Transform.hs index bc32809..b5bbdc2 100644 --- a/src/Reanimate/Transform.hs +++ b/src/Reanimate/Transform.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE PackageImports #-} module Reanimate.Transform ( identity , transformPoint @@ -6,10 +7,10 @@ module Reanimate.Transform -- XXX: Use Linear.Matrix instead of Data.Matrix to drop the 'matrix' dependency. import Data.List -import Data.Matrix (Matrix) -import qualified Data.Matrix as M +import "matrix" Data.Matrix (Matrix) +import qualified "matrix" Data.Matrix as M import Data.Maybe -import Graphics.Svg +import "svg-tree" Graphics.Svg import Linear.V2 type TMatrix = Matrix Coord diff --git a/stack.yaml b/stack.yaml index a5b1dea..163ada5 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,10 +1,17 @@ resolver: lts-11.22 -allow-newer: true +allow-newer: false extra-deps: -- gio-0.13.5.0@sha256:1e02962f498f62ba68cff88e7f7379e2f8c192f311d867b22f4815518b2f9a86 -- gtk-0.15.0@sha256:a76d280dbeefbe08cf021c31bcd51c09cda97ebee7934debbfc14e1da4220b78 -- svgcairo-0.13.1.1@sha256:145b6acce7306e84652376efb3f00e9194ccd8787a62d3f93fb539c4a3382a2e -- lucid-svg-0.7.0.0@sha256:2a2d0fe51329e8b89f723a8e86e6ab8d150d7b205591fffe4c09d8d11e022f98 - svg-tree-0.6.2.3 +- diagrams-1.4@sha256:3e36369e84115b900fd9dcb570672a188339a470eb19ca62170775cd835cf8ca +- diagrams-contrib-1.4.3@sha256:bcfa6c85f8c33b8c48c3a61b7216afdebd51cd793c50da3a2dd358827d25fc76 +- diagrams-core-1.4.1.1@sha256:6ef6b17785d77997c481eb085570e21b6a00cc91d086fbf49490504130ebc7d1 +- diagrams-lib-1.4.2.3@sha256:47af9bd9249f16e164a0ba014dcc0aaf47a787b5d3ff78a1bf38ed80f5a5c13e +- diagrams-svg-1.4.2@sha256:1b0b473c9825f6abda5b1551376dc5c4adcc995cc1705324231c32a57a415697 +- cubicbezier-0.6.0.6@sha256:2191ff47144d9a13a2784651a33d340cd31be1926a6c188925143103eb3c8db3 +- diagrams-solve-0.1.1@sha256:ad04ac1c1b1071f906a9879de00997bd543cc0a46c83c3a38199a87702674afa +- dual-tree-0.2.2@sha256:b04a53694ad1e8c34f9e2f2b96cd6c3ae59d782caba14b6d523d6205436e1165 +- mfsolve-0.3.2.0@sha256:19ce2822b8d3cf906e983a237341698349dcef49d873b1b03d141276b4b0e8dc +- fast-math-1.0.2@sha256:91181eb836e54413cc5a841e797c42b2264954e893ea530b6fc4da0dccf6a8b7 +- matrices-0.5.0@sha256:b2761813f6a61c84224559619cc60a16a858ac671c8436bbac8ec89e85473058