hashirama/reanimate
Watch
1
0
Fork
You've already forked reanimate
 0
mirror of https://github.com/reanimate/reanimate.git synced 2026-09-14 09:32:22 +00:00
Code Issues Projects Releases Wiki Activity

Support diagrams.

Browse source
This commit is contained in:
David 2019-03-03 16:09:59 +01:00
commit 585a0577d5
10 changed files with 216 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

11
reanimate.cabal
View file

@ -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

3
src/Reanimate/Combinators.hs
View file

@ -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)]

35
src/Reanimate/Diagrams.hs Normal file
View file

@ -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

130
src/Reanimate/Examples.hs
View file

@ -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 ..]]

44
src/Reanimate/LaTeX.hs
View file

@ -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)

2
src/Reanimate/Monad.hs
View file

@ -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

16
src/Reanimate/Render.hs
View file

@ -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

11
src/Reanimate/Svg.hs
View file

@ -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{} -> []

7
src/Reanimate/Transform.hs
View file

@ -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

17
stack.yaml
View file

@ -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