hashirama/reanimate
Watch
1
0
Fork
You've already forked reanimate
 0
mirror of https://github.com/reanimate/reanimate.git synced 2026-09-14 01:22:20 +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

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