mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-09 15:12:21 +00:00
Feature showcase (#29)
* Add 'mkText'. * Add builtin svg logo. * Bump dependency on reanimate-svg. Former-commit-id: 94cbf80b828ca3cb59e3bcf577299a6f84418fbf
This commit is contained in:
David Himmelstrup
GitHub
parent
77fd94dd32
commit
8694425284
21 changed files with 747 additions and 135 deletions
64
data/svg-logo.svg
Normal file
64
data/svg-logo.svg
Normal file
|
|
@ -0,0 +1,64 @@
|
|||
<svg xmlns="http://www.w3.org/2000/svg"
|
||||
xmlns:xlink="http://www.w3.org/1999/xlink"
|
||||
width="100%"
|
||||
height="100%"
|
||||
viewBox="0 0 300 300">
|
||||
|
||||
<title>SVG Logo</title>
|
||||
<desc>Designed for the SVG Logo Contest in 2006 by Harvey Rayner, and adopted by W3C in 2009. It is available under the Creative Commons license for those who have an SVG product or who are using SVG on their site.</desc>
|
||||
|
||||
<metadata id="license">
|
||||
<rdf:RDF
|
||||
xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
|
||||
xmlns:dc="http://purl.org/dc/elements/1.1/"
|
||||
xmlns:cc="http://web.resource.org/cc/">
|
||||
<cc:Work rdf:about="">
|
||||
<dc:title>SVG Logo</dc:title>
|
||||
<dc:date>14-08-2009</dc:date>
|
||||
<dc:creator>
|
||||
<cc:Agent><dc:title>W3C</dc:title></cc:Agent>
|
||||
<cc:Agent><dc:title>Harvey Rayner, designer</dc:title></cc:Agent>
|
||||
</dc:creator>
|
||||
<dc:description>See document description</dc:description>
|
||||
<cc:license rdf:resource="http://creativecommons.org/licenses/by-nc-sa/2.5/" />
|
||||
<dc:format>image/svg+xml</dc:format>
|
||||
<dc:type rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
|
||||
</cc:Work>
|
||||
<cc:License rdf:about="http://creativecommons.org/licenses/by-nc-sa/2.5/">
|
||||
<cc:permits rdf:resource="http://web.resource.org/cc/Reproduction" />
|
||||
<cc:permits rdf:resource="http://web.resource.org/cc/Distribution" />
|
||||
<cc:requires rdf:resource="http://web.resource.org/cc/Notice" />
|
||||
<cc:requires rdf:resource="http://web.resource.org/cc/Attribution" />
|
||||
<cc:prohibits rdf:resource="http://web.resource.org/cc/CommercialUse" />
|
||||
<cc:permits rdf:resource="http://web.resource.org/cc/DerivativeWorks" />
|
||||
<cc:requires rdf:resource="http://web.resource.org/cc/ShareAlike" />
|
||||
</cc:License>
|
||||
</rdf:RDF>
|
||||
</metadata>
|
||||
|
||||
|
||||
<defs>
|
||||
<g id="SVG" fill="#ffffff" transform="scale(2) translate(20,79)">
|
||||
<path id="S" d="M 5.482,31.319 C2.163,28.001 0.109,23.419 0.109,18.358 C0.109,8.232 8.322,0.024 18.443,0.024 C28.569,0.024 36.782,8.232 36.782,18.358 L26.042,18.358 C26.042,14.164 22.638,10.765 18.443,10.765 C14.249,10.765 10.850,14.164 10.850,18.358 C10.850,20.453 11.701,22.351 13.070,23.721 L13.075,23.721 C14.450,25.101 15.595,25.500 18.443,25.952 L18.443,25.952 C23.509,26.479 28.091,28.006 31.409,31.324 L31.409,31.324 C34.728,34.643 36.782,39.225 36.782,44.286 C36.782,54.412 28.569,62.625 18.443,62.625 C8.322,62.625 0.109,54.412 0.109,44.286 L10.850,44.286 C10.850,48.480 14.249,51.884 18.443,51.884 C22.638,51.884 26.042,48.480 26.042,44.286 C26.042,42.191 25.191,40.298 23.821,38.923 L23.816,38.923 C22.441,37.548 20.468,37.074 18.443,36.697 L18.443,36.692 C13.533,35.939 8.800,34.638 5.482,31.319 L5.482,31.319 L5.482,31.319 Z"/>
|
||||
|
||||
<path id="V" d="M 73.452,0.024 L60.482,62.625 L49.742,62.625 L36.782,0.024 L47.522,0.024 L55.122,36.687 L62.712,0.024 L73.452,0.024 Z"/>
|
||||
|
||||
<path id="G" d="M 91.792,25.952 L110.126,25.952 L110.126,44.286 L110.131,44.286 C110.131,54.413 101.918,62.626 91.792,62.626 C81.665,62.626 73.458,54.413 73.458,44.286 L73.458,44.286 L73.458,18.359 L73.453,18.359 C73.453,8.233 81.665,0.025 91.792,0.025 C101.913,0.025 110.126,8.233 110.126,18.359 L99.385,18.359 C99.385,14.169 95.981,10.765 91.792,10.765 C87.597,10.765 84.198,14.169 84.198,18.359 L84.198,44.286 L84.198,44.286 C84.198,48.481 87.597,51.880 91.792,51.880 C95.981,51.880 99.380,48.481 99.385,44.291 L99.385,44.286 L99.385,36.698 L91.792,36.698 L91.792,25.952 L91.792,25.952 Z"/>
|
||||
</g>
|
||||
</defs>
|
||||
|
||||
<path id="base" fill="#000" d="M8.5,150 H291.5 V250 C291.5,273.5 273.5,291.5 250,291.5 H50 C26.5,291.5 8.5,273.5 8.5,250 Z"/>
|
||||
<g stroke-width="38.0086" stroke="#000">
|
||||
<g id="svgstar" transform="translate(150, 150)">
|
||||
<path id="svgbar" fill="#ffb13b"
|
||||
d="M-84.1487,-15.8513 a22.4171,22.4171 0 1 0 0,31.7026 h168.2974 a22.4171,22.4171 0 1 0 0,-31.7026 Z"/>
|
||||
<use xlink:href="#svgbar" transform="rotate(45)"/>
|
||||
<use xlink:href="#svgbar" transform="rotate(90)"/>
|
||||
<use xlink:href="#svgbar" transform="rotate(135)"/>
|
||||
</g>
|
||||
</g>
|
||||
<use xlink:href="#svgstar"/>
|
||||
<use xlink:href="#base" opacity="0.85"/>
|
||||
<use xlink:href="#SVG"/>
|
||||
|
||||
</svg>
|
||||
|
After Width: | Height: | Size: 4.2 KiB |
11
examples/doc_githubIcon.hs
Executable file
11
examples/doc_githubIcon.hs
Executable file
|
|
@ -0,0 +1,11 @@
|
|||
#!/usr/bin/env stack
|
||||
-- stack runghc --package reanimate
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Main (main) where
|
||||
|
||||
import Reanimate
|
||||
import Reanimate.Builtin.Documentation
|
||||
import Reanimate.Builtin.Images
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ docEnv $ animate $ const githubIcon
|
||||
11
examples/doc_haskellLogo.hs
Executable file
11
examples/doc_haskellLogo.hs
Executable file
|
|
@ -0,0 +1,11 @@
|
|||
#!/usr/bin/env stack
|
||||
-- stack runghc --package reanimate
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Main (main) where
|
||||
|
||||
import Reanimate
|
||||
import Reanimate.Builtin.Documentation
|
||||
import Reanimate.Builtin.Images
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ docEnv $ animate $ const haskellLogo
|
||||
11
examples/doc_svgLogo.hs
Executable file
11
examples/doc_svgLogo.hs
Executable file
|
|
@ -0,0 +1,11 @@
|
|||
#!/usr/bin/env stack
|
||||
-- stack runghc --package reanimate
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Main (main) where
|
||||
|
||||
import Reanimate
|
||||
import Reanimate.Builtin.Documentation
|
||||
import Reanimate.Builtin.Images
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ docEnv $ animate $ const svgLogo
|
||||
|
|
@ -32,6 +32,7 @@ data-files: viewer/build/*.js
|
|||
data/CIExyz.csv
|
||||
data/CIE_XYZ.csv
|
||||
data/cone_sensitivity_lms.csv
|
||||
data/*.svg
|
||||
|
||||
Source-Repository head
|
||||
Type: git
|
||||
|
|
@ -68,6 +69,7 @@ library
|
|||
Reanimate.Chiphunk
|
||||
Reanimate.PolyShape
|
||||
Reanimate.Builtin.Documentation
|
||||
Reanimate.Builtin.Images
|
||||
other-modules: Reanimate.Cache
|
||||
Reanimate.Driver.Check
|
||||
Reanimate.Driver.CLI
|
||||
|
|
@ -76,7 +78,7 @@ library
|
|||
Paths_reanimate
|
||||
build-depends: base >=4.10 && <5,
|
||||
time, text, filepath, process, directory,
|
||||
containers, reanimate-svg >= 0.9.3.1, xml, bytestring, lens, linear, mtl, matrix,
|
||||
containers, reanimate-svg >= 0.9.4.0, xml, bytestring, lens, linear, mtl, matrix,
|
||||
JuicyPixels, attoparsec, parallel,
|
||||
cubicbezier, websockets,
|
||||
hashable, fsnotify, open-browser, random-shuffle, base64-bytestring,
|
||||
|
|
|
|||
|
|
@ -2,7 +2,6 @@ module Reanimate.Animation where
|
|||
|
||||
import Control.Arrow ()
|
||||
import Data.Fixed (mod')
|
||||
import qualified Data.Map as M
|
||||
import Graphics.SvgTree (Alignment (..), Document (..),
|
||||
Number (..),
|
||||
PreserveAspectRatio (..),
|
||||
|
|
@ -148,7 +147,6 @@ renderSvg w h t = ppDocument doc
|
|||
, _width = w
|
||||
, _height = h
|
||||
, _elements = [withStrokeWidth defaultStrokeWidth $ scaleXY 1 (-1) t]
|
||||
, _definitions = M.empty
|
||||
, _description = ""
|
||||
, _documentLocation = ""
|
||||
, _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing
|
||||
|
|
@ -264,3 +262,15 @@ freezeAtPercentage frac (Animation d genFrame) =
|
|||
-- <<docs/gifs/doc_signalA.gif>>
|
||||
signalA :: Signal -> Animation -> Animation
|
||||
signalA fn (Animation d gen) = Animation d $ gen . fn
|
||||
|
||||
takeA :: Double -> Animation -> Animation
|
||||
takeA len (Animation d gen) = Animation len' $ \t ->
|
||||
gen (t * len'/d)
|
||||
where
|
||||
len' = min len d
|
||||
|
||||
dropA :: Double -> Animation -> Animation
|
||||
dropA len (Animation d gen) = Animation len' $ \t ->
|
||||
gen (t * len'/d + len/d)
|
||||
where
|
||||
len' = max (d-len) 0
|
||||
|
|
|
|||
32
src/Reanimate/Builtin/Images.hs
Normal file
32
src/Reanimate/Builtin/Images.hs
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
module Reanimate.Builtin.Images
|
||||
( svgLogo
|
||||
, haskellLogo
|
||||
, githubIcon
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import Graphics.SvgTree (parseSvgFile)
|
||||
import Paths_reanimate
|
||||
import Reanimate.Animation
|
||||
import Reanimate.Svg
|
||||
import System.IO.Unsafe
|
||||
|
||||
embedImage :: FilePath -> IO SVG
|
||||
embedImage key = do
|
||||
svg_file <- getDataFileName key
|
||||
svg_data <- B.readFile svg_file
|
||||
case parseSvgFile svg_file svg_data of
|
||||
Nothing -> error "Malformed svg"
|
||||
Just svg -> return $ embedDocument svg
|
||||
|
||||
-- | <<docs/gifs/doc_svgLogo.gif>>
|
||||
svgLogo :: SVG
|
||||
svgLogo = unsafePerformIO $ embedImage "data/svg-logo.svg"
|
||||
|
||||
-- | <<docs/gifs/doc_haskellLogo.gif>>
|
||||
haskellLogo :: SVG
|
||||
haskellLogo = unsafePerformIO $ embedImage "data/haskell.svg"
|
||||
|
||||
-- | <<docs/gifs/doc_githubIcon.gif>>
|
||||
githubIcon :: SVG
|
||||
githubIcon = unsafePerformIO $ embedImage "data/github-icon.svg"
|
||||
|
|
@ -1,28 +1,44 @@
|
|||
module Reanimate.Cache
|
||||
( cacheMem
|
||||
( cacheFile -- :: FilePath -> (FilePath -> IO ()) -> IO FilePath
|
||||
, cacheMem
|
||||
, cacheDisk
|
||||
, cacheDiskSvg
|
||||
, cacheDiskKey
|
||||
, cacheDiskLines
|
||||
) where
|
||||
|
||||
import Control.Monad (unless)
|
||||
import Data.Hashable
|
||||
import Data.IORef
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Graphics.SvgTree (Tree (..), unparse)
|
||||
import Reanimate.Animation (renderTree)
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Graphics.SvgTree (Tree (..), unparse)
|
||||
import Reanimate.Animation (renderTree)
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import System.IO
|
||||
import Control.Exception
|
||||
import System.IO.Unsafe
|
||||
import Text.XML.Light (Content (..), parseXML)
|
||||
import Text.XML.Light (Content (..), parseXML)
|
||||
import System.IO.Temp
|
||||
|
||||
-- Memory cache and disk cache
|
||||
|
||||
cacheFile :: FilePath -> (FilePath -> IO ()) -> IO FilePath
|
||||
cacheFile template gen = do
|
||||
root <- getXdgDirectory XdgCache "reanimate"
|
||||
createDirectoryIfMissing True root
|
||||
let path = root </> template
|
||||
hit <- doesFileExist path
|
||||
unless hit $ withSystemTempFile template $ \tmp h -> do
|
||||
hClose h
|
||||
gen tmp
|
||||
renameFile tmp path
|
||||
evaluate path
|
||||
|
||||
cacheDisk :: (T.Text -> Maybe a) -> (a -> T.Text) -> (Text -> IO a) -> (Text -> IO a)
|
||||
cacheDisk parse render gen key = do
|
||||
root <- getXdgDirectory XdgCache "reanimate"
|
||||
|
|
|
|||
|
|
@ -38,6 +38,12 @@ fadeInE d t = withGroupOpacity (t/d)
|
|||
fadeOutE :: Effect
|
||||
fadeOutE = reverseE fadeInE
|
||||
|
||||
fadeLineInE :: Double -> Effect
|
||||
fadeLineInE w d t = withStrokeWidth (w*(t/d))
|
||||
|
||||
fadeLineOutE :: Double -> Effect
|
||||
fadeLineOutE = reverseE . fadeLineInE
|
||||
|
||||
drawInE :: Effect
|
||||
drawInE d t = withFillOpacity 0 . partialSvg (t/d) . pathify
|
||||
|
||||
|
|
@ -48,3 +54,6 @@ fillInE :: Effect
|
|||
fillInE d t = withFillOpacity f
|
||||
where
|
||||
f = t/d
|
||||
|
||||
scaleE :: Double -> Effect
|
||||
scaleE target d t = scale (1 + (target-1) * t/d)
|
||||
|
|
|
|||
|
|
@ -28,8 +28,10 @@ requireExecutable exec = do
|
|||
|
||||
runCmd :: FilePath -> [String] -> IO ()
|
||||
runCmd exec args = do
|
||||
_ <- runCmd_ exec args
|
||||
return ()
|
||||
ret <- runCmd_ exec args
|
||||
case ret of
|
||||
Left err -> error $ "exec " ++ exec ++ show args ++ " failed:\n" ++ err
|
||||
Right{} -> return ()
|
||||
|
||||
runCmd_ :: FilePath -> [String] -> IO (Either String String)
|
||||
runCmd_ exec args = do
|
||||
|
|
|
|||
|
|
@ -1,50 +1,76 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Reanimate.Povray
|
||||
( povray
|
||||
, povrayQuick
|
||||
, povraySlow
|
||||
, povrayExtreme
|
||||
, povray'
|
||||
, povrayQuick'
|
||||
, povraySlow'
|
||||
, povrayExtreme'
|
||||
) where
|
||||
|
||||
import Codec.Picture.Png
|
||||
import qualified Data.ByteString as B
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Graphics.SvgTree (Tree (..))
|
||||
import qualified Data.ByteString as B
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Graphics.SvgTree (Tree (..))
|
||||
import Reanimate.Cache
|
||||
import Reanimate.Misc
|
||||
import Reanimate.Raster
|
||||
import Reanimate.Svg.Constructors
|
||||
import System.FilePath (replaceExtension)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import System.FilePath (replaceExtension, (<.>))
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import Data.Hashable
|
||||
|
||||
povrayRaw :: [String] -> Text -> Tree
|
||||
povrayRaw args script =
|
||||
-- memo [Key mkPovrayImage, KeyPrim args, KeyPrim script]
|
||||
(unsafePerformIO $ mkPovrayImage args script)
|
||||
|
||||
povrayRaw' :: [String] -> Text -> FilePath
|
||||
povrayRaw' args script =
|
||||
(unsafePerformIO $ mkPovrayImage' args script)
|
||||
|
||||
povray :: [String] -> Text -> Tree
|
||||
povray args = povrayRaw (["+H180","+W320", "+A"] ++ args)
|
||||
|
||||
povray' :: [String] -> Text -> FilePath
|
||||
povray' args = povrayRaw' (["+H180","+W320", "+A"] ++ args)
|
||||
|
||||
povrayQuick :: [String] -> Text -> Tree
|
||||
povrayQuick args = povrayRaw (["+H180","+W320"] ++ args)
|
||||
|
||||
povrayQuick' :: [String] -> Text -> FilePath
|
||||
povrayQuick' args = povrayRaw' (["+H180","+W320"] ++ args)
|
||||
|
||||
povraySlow :: [String] -> Text -> Tree
|
||||
povraySlow args = povrayRaw (["+H1440","+W2560", "+A"] ++ args)
|
||||
|
||||
povraySlow' :: [String] -> Text -> FilePath
|
||||
povraySlow' args = povrayRaw' (["+H1440","+W2560", "+A"] ++ args)
|
||||
|
||||
povrayExtreme :: [String] -> Text -> Tree
|
||||
povrayExtreme args = povrayRaw (["+H2160","+W3840", "+A"] ++ args)
|
||||
|
||||
povrayExtreme' :: [String] -> Text -> FilePath
|
||||
povrayExtreme' args = povrayRaw' (["+H2160","+W3840", "+A"] ++ args)
|
||||
|
||||
mkPovrayImage :: [String] -> Text -> IO Tree
|
||||
mkPovrayImage args script = cacheDiskKey key $ do
|
||||
exec <- requireExecutable "povray"
|
||||
withTempFile "pov" $ \pov_file -> do
|
||||
let out = replaceExtension pov_file "png"
|
||||
mkPovrayImage args script = do
|
||||
out <- mkPovrayImage' args script
|
||||
-- return $ center $ scaleToSize 16 9 $ embedImageFile out
|
||||
png <- B.readFile out
|
||||
case decodePng png of
|
||||
Left{} -> error "bad image"
|
||||
Right img -> return $ center $ scaleToSize 16 9 $ embedDynamicImage img
|
||||
|
||||
mkPovrayImage' :: [String] -> Text -> IO FilePath
|
||||
mkPovrayImage' args script = cacheFile template $ \target -> do
|
||||
exec <- requireExecutable "povray"
|
||||
let pov_file = replaceExtension target "pov"
|
||||
T.writeFile pov_file script
|
||||
ret <- runCmd_ exec (args ++ ["-D","+UA", pov_file, "+o"++out])
|
||||
case ret of
|
||||
Left err -> error $ "povray went wrong:\n" ++ err
|
||||
Right{} -> do
|
||||
png <- B.readFile out
|
||||
case decodePng png of
|
||||
Left{} -> error "bad image"
|
||||
Right img -> return $ center $ scaleToSize 16 9 $ embedDynamicImage img
|
||||
runCmd exec (args ++ ["-D","+UA", pov_file, "+o"++target])
|
||||
where
|
||||
template = show (hash key) <.> "png"
|
||||
key = T.concat (script:map T.pack args)
|
||||
|
|
|
|||
|
|
@ -3,25 +3,33 @@ module Reanimate.Raster
|
|||
, embedDynamicImage
|
||||
, embedPng
|
||||
, raster
|
||||
, vectorize
|
||||
, vectorize_
|
||||
, svgAsPngFile
|
||||
) where
|
||||
|
||||
import Codec.Picture.Types
|
||||
import Codec.Picture
|
||||
import Control.Lens ((.~),(&))
|
||||
import Codec.Picture.Types (dynamicMap)
|
||||
import Control.Lens ((&), (.~))
|
||||
import Control.Monad
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Base64.Lazy as Base64
|
||||
import qualified Data.ByteString.Lazy.Char8 as LBS
|
||||
import Graphics.SvgTree (Number (..), Tree (..),
|
||||
defaultSvg)
|
||||
import qualified Graphics.SvgTree as Svg
|
||||
import Reanimate.Misc
|
||||
import Reanimate.Animation
|
||||
import Reanimate.Svg.Constructors
|
||||
import System.FilePath
|
||||
import System.Directory
|
||||
import Data.Hashable
|
||||
import Graphics.SvgTree (Number (..), Tree (..),
|
||||
defaultSvg,parseSvgFile)
|
||||
import qualified Graphics.SvgTree as Svg
|
||||
import Reanimate.Animation
|
||||
import Reanimate.Misc
|
||||
import Reanimate.Cache
|
||||
import Reanimate.Svg.Constructors
|
||||
import Reanimate.Svg.Unuse
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import System.IO.Unsafe
|
||||
import System.IO.Temp
|
||||
import System.IO
|
||||
|
||||
|
||||
{-# INLINE embedImage #-}
|
||||
|
|
@ -53,6 +61,22 @@ embedDynamicImage img = embedPng width height imgData
|
|||
Left err -> error err
|
||||
Right dat -> 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)
|
||||
|
||||
|
||||
|
||||
raster :: Tree -> DynamicImage
|
||||
raster svg = unsafePerformIO $ do
|
||||
png <- B.readFile (svgAsPngFile svg)
|
||||
|
|
@ -60,27 +84,48 @@ raster svg = unsafePerformIO $ do
|
|||
Left{} -> error "bad image"
|
||||
Right img -> return img
|
||||
|
||||
vectorize :: FilePath -> Tree
|
||||
vectorize = vectorize_ []
|
||||
|
||||
vectorize_ :: [String] -> FilePath -> Tree
|
||||
vectorize_ args path = unsafePerformIO $ do
|
||||
root <- getXdgDirectory XdgCache "reanimate"
|
||||
createDirectoryIfMissing True root
|
||||
let svgPath = root </> show key <.> "svg"
|
||||
hit <- doesFileExist svgPath
|
||||
unless hit $
|
||||
withSystemTempFile "file.svg" $ \tmpSvgPath svgH ->
|
||||
withSystemTempFile "file.bmp" $ \tmpBmpPath bmpH -> do
|
||||
hClose svgH
|
||||
hClose bmpH
|
||||
potrace <- requireExecutable "potrace"
|
||||
convert <- requireExecutable "convert"
|
||||
runCmd convert [ path, tmpBmpPath ]
|
||||
runCmd potrace (args ++ ["--svg", "--output", tmpSvgPath, tmpBmpPath])
|
||||
renameFile tmpSvgPath svgPath
|
||||
svg_data <- B.readFile svgPath
|
||||
case parseSvgFile svgPath svg_data of
|
||||
Nothing -> do
|
||||
removeFile svgPath
|
||||
error "Malformed svg"
|
||||
Just svg -> return $ unbox $ replaceUses svg
|
||||
where
|
||||
key = hash (path, args)
|
||||
|
||||
-- imageAsFile :: DynamicImage -> FilePath
|
||||
-- imageAsFile img
|
||||
|
||||
svgAsPngFile :: Tree -> FilePath
|
||||
svgAsPngFile svg = unsafePerformIO $ do
|
||||
root <- getXdgDirectory XdgCache "reanimate"
|
||||
createDirectoryIfMissing True root
|
||||
let svgPath = root </> show (hash rendered) <.> "svg"
|
||||
pngPath = replaceExtension svgPath "png"
|
||||
hit <- doesFileExist pngPath
|
||||
if hit
|
||||
then return pngPath
|
||||
else do
|
||||
-- ffmpeg <- requireExecutable "ffmpeg"
|
||||
-- convert <- requireExecutable "convert"
|
||||
inkscape <- requireExecutable "inkscape"
|
||||
writeFile svgPath rendered
|
||||
-- runCmd convert [ "-background", "none", "-antialias", svgPath, pngPath ]
|
||||
runCmd inkscape [ svgPath, "--export-png=" ++ pngPath, "--without-gui" ]
|
||||
return pngPath
|
||||
svgAsPngFile svg = unsafePerformIO $ cacheFile template $ \pngPath -> do
|
||||
let svgPath = replaceExtension pngPath "svg"
|
||||
-- ffmpeg <- requireExecutable "ffmpeg"
|
||||
-- convert <- requireExecutable "convert"
|
||||
inkscape <- requireExecutable "inkscape"
|
||||
writeFile svgPath rendered
|
||||
-- runCmd convert [ "-background", "none", "-antialias", svgPath, pngPath ]
|
||||
runCmd inkscape [ svgPath, "--export-png=" ++ pngPath, "--without-gui" ]
|
||||
where
|
||||
template = show (hash rendered) <.> "png"
|
||||
rendered = renderSvg (Just $ Num width) (Just $ Num height) svg
|
||||
width = 2560
|
||||
height = width * 9 / 16
|
||||
|
|
|
|||
|
|
@ -290,6 +290,14 @@ spriteE (Sprite born ref) effect = do
|
|||
let (svg', z) = render d t svg
|
||||
in (delayE (now-born) effect d t svg', z))
|
||||
|
||||
spriteZ :: Sprite s -> ZIndex -> Scene s ()
|
||||
spriteZ (Sprite born ref) zindex = do
|
||||
now <- queryNow
|
||||
liftST $ modifySTRef ref $ \(ttl, render) ->
|
||||
(ttl, \d t svg ->
|
||||
let (svg', z) = render d t svg
|
||||
in (svg', if t < now-born then z else zindex))
|
||||
|
||||
{-
|
||||
data Var s a = Var (STRef s (Time -> a))
|
||||
data Sprite s = Sprite (STRef s (Duration, Duration -> Time -> (SVG, ZIndex)))
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ module Reanimate.Signal
|
|||
, fromToS
|
||||
, reverseS
|
||||
, curveS
|
||||
, powerS
|
||||
, bellS
|
||||
, oscillateS
|
||||
, fromListS
|
||||
|
|
@ -65,6 +66,9 @@ curveS steepness s =
|
|||
then 0.5 * (2*s)**steepness
|
||||
else 1-0.5 * (2 - 2*s)**steepness
|
||||
|
||||
powerS :: Double -> Signal
|
||||
powerS steepness s = s**steepness
|
||||
|
||||
-- | Oscillate signal.
|
||||
--
|
||||
-- Example:
|
||||
|
|
|
|||
|
|
@ -86,6 +86,9 @@ mkColor name =
|
|||
withStrokeColor :: String -> Tree -> Tree
|
||||
withStrokeColor color = strokeColor .~ pure (mkColor color)
|
||||
|
||||
withStrokeColorPixel :: PixelRGBA8 -> Tree -> Tree
|
||||
withStrokeColorPixel color = strokeColor .~ pure (ColorRef color)
|
||||
|
||||
withStrokeLineJoin :: LineJoin -> Tree -> Tree
|
||||
withStrokeLineJoin ljoin = strokeLineJoin .~ pure ljoin
|
||||
|
||||
|
|
@ -180,3 +183,10 @@ gridLayout rows = mkGroup
|
|||
where
|
||||
rowSep = screenHeight / fromIntegral (nRows+1)
|
||||
nRows = length rows
|
||||
|
||||
mkText :: T.Text -> Tree
|
||||
mkText str =
|
||||
TextTree Nothing $ defaultSvg
|
||||
& textRoot .~ span_
|
||||
where
|
||||
span_ = defaultSvg & spanContent .~ [SpanText str]
|
||||
|
|
|
|||
|
|
@ -1,18 +1,17 @@
|
|||
module Reanimate.Svg.Unuse
|
||||
( replaceUses
|
||||
, unbox
|
||||
, embedDocument
|
||||
) where
|
||||
|
||||
import Control.Lens ((%~), (&), (.~), (^.),(?~))
|
||||
import qualified Data.Map as Map
|
||||
import Graphics.SvgTree hiding (height, line, path, use,
|
||||
width)
|
||||
import Control.Lens ((%~), (&), (.~), (?~), (^.))
|
||||
import qualified Data.Map as Map
|
||||
import Graphics.SvgTree hiding (line, path, use)
|
||||
import Reanimate.Constants
|
||||
import Reanimate.Svg.Constructors
|
||||
|
||||
replaceUses :: Document -> Document
|
||||
replaceUses doc = doc & elements %~ map (mapTree replace)
|
||||
& definitions .~ Map.empty
|
||||
where
|
||||
replaceDefinition PathTree{} = None
|
||||
replaceDefinition t = t
|
||||
|
|
@ -32,8 +31,7 @@ replaceUses doc = doc & elements %~ map (mapTree replace)
|
|||
(Num a, Num b) -> Translate a b
|
||||
_ -> TransformUnknown
|
||||
docTree = mkGroup (doc^.elements)
|
||||
idMap = foldTree updMap Map.empty docTree `Map.union`
|
||||
(doc^.definitions)
|
||||
idMap = foldTree updMap Map.empty docTree
|
||||
updMap m tree =
|
||||
case tree^.attrId of
|
||||
Nothing -> m
|
||||
|
|
@ -48,3 +46,12 @@ unbox doc@Document{_viewBox = Just (minx, minw, _width, _height)} =
|
|||
unbox doc =
|
||||
GroupTree $ defaultSvg
|
||||
& groupChildren .~ doc^.elements
|
||||
|
||||
embedDocument :: Document -> Tree
|
||||
embedDocument doc =
|
||||
translate (-screenWidth/2) (screenHeight/2) $
|
||||
withFillOpacity 1 $
|
||||
withStrokeWidth 0 $
|
||||
flipYAxis $
|
||||
SvgTree $ doc & width .~ Nothing
|
||||
& height .~ Nothing
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ packages:
|
|||
- .
|
||||
|
||||
extra-deps:
|
||||
- reanimate-svg-0.9.3.1
|
||||
- reanimate-svg-0.9.4.0
|
||||
- chiphunk-0.1.2.1
|
||||
- cubicbezier-0.6.0.6@sha256:2191ff47144d9a13a2784651a33d340cd31be1926a6c188925143103eb3c8db3
|
||||
- fast-math-1.0.2@sha256:91181eb836e54413cc5a841e797c42b2264954e893ea530b6fc4da0dccf6a8b7
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ packages:
|
|||
- .
|
||||
|
||||
extra-deps:
|
||||
- reanimate-svg-0.9.3.1
|
||||
- reanimate-svg-0.9.4.0
|
||||
- chiphunk-0.1.2.1
|
||||
- cubicbezier-0.6.0.6@sha256:2191ff47144d9a13a2784651a33d340cd31be1926a6c188925143103eb3c8db3
|
||||
- fast-math-1.0.2@sha256:91181eb836e54413cc5a841e797c42b2264954e893ea530b6fc4da0dccf6a8b7
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ packages:
|
|||
- .
|
||||
|
||||
extra-deps:
|
||||
- reanimate-svg-0.9.3.1
|
||||
- reanimate-svg-0.9.4.0
|
||||
- chiphunk-0.1.2.1
|
||||
- cubicbezier-0.6.0.6@sha256:2191ff47144d9a13a2784651a33d340cd31be1926a6c188925143103eb3c8db3
|
||||
- fast-math-1.0.2@sha256:91181eb836e54413cc5a841e797c42b2264954e893ea530b6fc4da0dccf6a8b7
|
||||
|
|
|
|||
|
|
@ -5,61 +5,19 @@
|
|||
|
||||
packages:
|
||||
- completed:
|
||||
hackage: reanimate-svg-0.9.3.1@sha256:ce3783b5d8437ec39f60c4bc9199068dbfe5d074baecee085303c5c850f9428f,2448
|
||||
hackage: reanimate-svg-0.9.4.0@sha256:6acada3f3fea83e8b5e8ae5c9960b2fafdde8e6a48c32f094e6aa346bc7cc226,2448
|
||||
pantry-tree:
|
||||
size: 1117
|
||||
sha256: 470085c4740a4790e9d96c588c17ddea879f7b4a793041eebfa982625b69450f
|
||||
sha256: 4cdd5f71443fc486f561b5a0d50b87d6890cd7fb5fbf1f8c0899b40a0e70d27e
|
||||
original:
|
||||
hackage: reanimate-svg-0.9.3.1
|
||||
hackage: reanimate-svg-0.9.4.0
|
||||
- completed:
|
||||
hackage: palette-0.3.0.2@sha256:50e210b7d21a0c394a6d672cc3c6d3bffcfa1be07419d72b99e68cfb65d6ca3c,1485
|
||||
pantry-tree:
|
||||
size: 6342
|
||||
sha256: 9285e95a5701636961e83ed2036cca52a6b66e5ea809500ed6b845bc920f2791
|
||||
original:
|
||||
hackage: palette-0.3.0.2
|
||||
- completed:
|
||||
hackage: chiphunk-0.1.2.0@sha256:bd129c91033140cb5ad9cc3c446baccdc377a17214026c79c9705c7d886e54cb,4619
|
||||
hackage: chiphunk-0.1.2.1@sha256:1e17e0e3d2fc91317e2cfcb8fd9f7add4a5038d76a4ae6b444641c0a2adec881,4619
|
||||
pantry-tree:
|
||||
size: 6333
|
||||
sha256: 155b48a7a4ecd4a36b853445b27acec55ebe1247f206cf719613fee43a1a4d7b
|
||||
sha256: 505d40929bd792b8003c0d03ec93d99ecba5e7927fbc6193824c0dab92c54dec
|
||||
original:
|
||||
hackage: chiphunk-0.1.2.0
|
||||
- completed:
|
||||
hackage: diagrams-1.4@sha256:3e36369e84115b900fd9dcb570672a188339a470eb19ca62170775cd835cf8ca,5483
|
||||
pantry-tree:
|
||||
size: 208
|
||||
sha256: 8f2ea432c67f4711446942e032be53ed7dc49c1b1dd7d26ff71fbd4d05a02c4d
|
||||
original:
|
||||
hackage: diagrams-1.4@sha256:3e36369e84115b900fd9dcb570672a188339a470eb19ca62170775cd835cf8ca
|
||||
- completed:
|
||||
hackage: diagrams-contrib-1.4.3@sha256:bcfa6c85f8c33b8c48c3a61b7216afdebd51cd793c50da3a2dd358827d25fc76,4693
|
||||
pantry-tree:
|
||||
size: 10858
|
||||
sha256: cadfa25f496761b205a0583bef05ebe84003a64c2d66f86f64ba1f05a79ab916
|
||||
original:
|
||||
hackage: diagrams-contrib-1.4.3@sha256:bcfa6c85f8c33b8c48c3a61b7216afdebd51cd793c50da3a2dd358827d25fc76
|
||||
- completed:
|
||||
hackage: diagrams-core-1.4.1.1@sha256:6ef6b17785d77997c481eb085570e21b6a00cc91d086fbf49490504130ebc7d1,2999
|
||||
pantry-tree:
|
||||
size: 2018
|
||||
sha256: 1a28c53443667f0a0cf43224e935257973ee234d721e8d2a49a41ab8d8a97a35
|
||||
original:
|
||||
hackage: diagrams-core-1.4.1.1@sha256:6ef6b17785d77997c481eb085570e21b6a00cc91d086fbf49490504130ebc7d1
|
||||
- completed:
|
||||
hackage: diagrams-lib-1.4.2.3@sha256:47af9bd9249f16e164a0ba014dcc0aaf47a787b5d3ff78a1bf38ed80f5a5c13e,8114
|
||||
pantry-tree:
|
||||
size: 11529
|
||||
sha256: 5520075cab7bcccdbc35f55318a44792df58399a9a085a577d1229ece040770a
|
||||
original:
|
||||
hackage: diagrams-lib-1.4.2.3@sha256:47af9bd9249f16e164a0ba014dcc0aaf47a787b5d3ff78a1bf38ed80f5a5c13e
|
||||
- completed:
|
||||
hackage: diagrams-svg-1.4.2@sha256:1b0b473c9825f6abda5b1551376dc5c4adcc995cc1705324231c32a57a415697,3197
|
||||
pantry-tree:
|
||||
size: 475
|
||||
sha256: 2ca5139bf68f3a5bce17f48d964e6067c168c3b1d164b8d61537b8d6bf17df06
|
||||
original:
|
||||
hackage: diagrams-svg-1.4.2@sha256:1b0b473c9825f6abda5b1551376dc5c4adcc995cc1705324231c32a57a415697
|
||||
hackage: chiphunk-0.1.2.1
|
||||
- completed:
|
||||
hackage: cubicbezier-0.6.0.6@sha256:2191ff47144d9a13a2784651a33d340cd31be1926a6c188925143103eb3c8db3,2243
|
||||
pantry-tree:
|
||||
|
|
@ -67,27 +25,6 @@ packages:
|
|||
sha256: 1a6e3a16c3d33c8baac53b4345b29695ff90cf2b559cfed349ab1bc454949632
|
||||
original:
|
||||
hackage: cubicbezier-0.6.0.6@sha256:2191ff47144d9a13a2784651a33d340cd31be1926a6c188925143103eb3c8db3
|
||||
- completed:
|
||||
hackage: diagrams-solve-0.1.1@sha256:ad04ac1c1b1071f906a9879de00997bd543cc0a46c83c3a38199a87702674afa,1699
|
||||
pantry-tree:
|
||||
size: 469
|
||||
sha256: 1f224951aa3f7ca9e0ec693d9aff30b58368a44aaa83c7764b5f9fe9acf3822e
|
||||
original:
|
||||
hackage: diagrams-solve-0.1.1@sha256:ad04ac1c1b1071f906a9879de00997bd543cc0a46c83c3a38199a87702674afa
|
||||
- completed:
|
||||
hackage: dual-tree-0.2.2@sha256:b04a53694ad1e8c34f9e2f2b96cd6c3ae59d782caba14b6d523d6205436e1165,2908
|
||||
pantry-tree:
|
||||
size: 387
|
||||
sha256: cad942894995e1c47d4c931562083d93764b5e46b676751038810f92c6b6f360
|
||||
original:
|
||||
hackage: dual-tree-0.2.2@sha256:b04a53694ad1e8c34f9e2f2b96cd6c3ae59d782caba14b6d523d6205436e1165
|
||||
- completed:
|
||||
hackage: mfsolve-0.3.2.0@sha256:19ce2822b8d3cf906e983a237341698349dcef49d873b1b03d141276b4b0e8dc,1155
|
||||
pantry-tree:
|
||||
size: 262
|
||||
sha256: 194ef83e8a4008c156a76b87fcda74dd3ea5ca3274d3a01b63ca62bd5d8228a2
|
||||
original:
|
||||
hackage: mfsolve-0.3.2.0@sha256:19ce2822b8d3cf906e983a237341698349dcef49d873b1b03d141276b4b0e8dc
|
||||
- completed:
|
||||
hackage: fast-math-1.0.2@sha256:91181eb836e54413cc5a841e797c42b2264954e893ea530b6fc4da0dccf6a8b7,1387
|
||||
pantry-tree:
|
||||
|
|
|
|||
407
videos/showcase/showcase.hs
Normal file
407
videos/showcase/showcase.hs
Normal file
|
|
@ -0,0 +1,407 @@
|
|||
#!/usr/bin/env stack
|
||||
-- stack runghc --package reanimate
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
module Main (main) where
|
||||
|
||||
import Codec.Picture
|
||||
import Control.Lens ((^.))
|
||||
import Control.Monad
|
||||
import Data.Fixed
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import Data.String.Here
|
||||
import Data.Text (Text)
|
||||
import Graphics.SvgTree (Number (..), strokeWidth, toUserUnit)
|
||||
import Reanimate
|
||||
import Reanimate.Animation
|
||||
import Reanimate.Builtin.Images
|
||||
import Reanimate.Effect
|
||||
import Reanimate.Povray
|
||||
import Reanimate.Raster
|
||||
import Reanimate.Scene
|
||||
import Reanimate.Signal
|
||||
import Reanimate.Svg
|
||||
|
||||
{- SCRIPT
|
||||
|
||||
Some ideas lend themselves well to be illustrated. Take spheres, for example: It
|
||||
just so happens that the surface of a sphere is exactly 4 times the area of a
|
||||
circle with the same radius.
|
||||
|
||||
Now, this relationship has already been visually explored by others in mucher
|
||||
greater detail so I'll leave it at this. But there are countless other ideas and
|
||||
concepts that deserve to be illustrated yet have not. I want to remedy this, in
|
||||
part, by animating ideas I find interesting, but also by encouraging you to make
|
||||
your own animations.
|
||||
|
||||
Every video on this channel, including this one, will be open-source with the source files
|
||||
linked in the description. If any of the graphics pique your interest then
|
||||
please download the code and play with it. The animations are created with a
|
||||
library called 'reanimate' which, at its core, is a set of tools for generating
|
||||
individual frames as SVG images. Layered on top of this core are external
|
||||
components such as:
|
||||
|
||||
* LaTeX, for typesetting equations,
|
||||
* a bitmap tracer, for turning pixel data into vector graphics,
|
||||
* and a raytracer, for generating 3D graphics,
|
||||
|
||||
Raytracing is inherently a pixel-based graphics technique but, with a bit of math,
|
||||
it and vector graphics can be overlayed with pixel-perfect precision.
|
||||
|
||||
Everything is held together by the purely functional language Haskell. Haskell
|
||||
is particularlly well suited for this task since animations are inherently
|
||||
immutable.
|
||||
|
||||
|
||||
|
||||
|
||||
-}
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ animate (const $ mkBackground "black") `parA`
|
||||
-- animate $ const $ checker 10 10
|
||||
-- rotateSphere
|
||||
-- rotateWireSphere
|
||||
sphereIntro
|
||||
-- introSVG
|
||||
-- mapA (scale 2) $ setDuration 20 featLaTeX
|
||||
|
||||
playbackTest :: Animation
|
||||
playbackTest = setDuration 10 feat3D
|
||||
|
||||
sphereIntro :: Animation
|
||||
sphereIntro = sceneAnimation $ do
|
||||
-- play $ drawSphere
|
||||
-- # setDuration 15
|
||||
-- # pauseAtEnd 2
|
||||
-- play $ rotateWireSphere
|
||||
-- # setDuration 2
|
||||
-- # signalA (powerS 2)
|
||||
fork $ play $ rotateWireSphere
|
||||
# setDuration 1
|
||||
# repeatA 10
|
||||
# takeA (2+5)
|
||||
# applyE (delayE 2 fadeOutE)
|
||||
fork $ play $ rotateSphere
|
||||
# setDuration 1
|
||||
# repeatA 15
|
||||
# applyE (overBeginning 2 $ constE $ withGroupOpacity 0)
|
||||
# applyE (delayE 2 $ overBeginning 5 fadeInE)
|
||||
wait 7
|
||||
playZ 1 $ setDuration 3 $ animate $ \t ->
|
||||
partialSvg t $
|
||||
withFillOpacity 0 $
|
||||
rotate 180 $
|
||||
pathify $
|
||||
circ
|
||||
-- playZ 1 $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
||||
-- withFillOpacity t $
|
||||
-- circ
|
||||
let scaleFactor = 0.05
|
||||
fork $ playZ 1 $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
||||
let p = curveS 3 t in
|
||||
withFillOpacity p $
|
||||
translate (1*p) (2*p) $
|
||||
scale (1-scaleFactor*p) $
|
||||
circ
|
||||
fork $ playZ 1 $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
||||
let p = curveS 3 t in
|
||||
withFillOpacity p $
|
||||
translate (1*p) (-2*p) $
|
||||
scale (1-scaleFactor*p) $
|
||||
circ
|
||||
fork $ playZ 1 $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
||||
let p = curveS 3 t in
|
||||
withFillOpacity p $
|
||||
translate (5*p) (2*p) $
|
||||
scale (1-scaleFactor*p) $
|
||||
circ
|
||||
fork $ playZ 1 $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
||||
let p = curveS 3 t in
|
||||
withFillOpacity p $
|
||||
translate (5*p) (-2*p) $
|
||||
scale (1-scaleFactor*p) $
|
||||
circ
|
||||
where
|
||||
circ =
|
||||
withFillColor "blue" $
|
||||
withStrokeColor "white" $
|
||||
mkCircle 2
|
||||
circEq = mkGroup
|
||||
[ circ
|
||||
, withFillColor "white" $
|
||||
scale 0.5 $
|
||||
center $ latexAlign "A=\\pi r^2"]
|
||||
|
||||
mkFeatSprite :: Double -> Double -> Animation
|
||||
-> Scene s (Var s Double, Var s Double, Sprite s)
|
||||
mkFeatSprite xPos yPos ani = do
|
||||
spriteAt <- newVar 0
|
||||
spriteTMod <- newVar 0
|
||||
sprite <- newSprite $ do
|
||||
genAt <- freezeVar spriteAt
|
||||
genT <- freezeVar spriteTMod
|
||||
return $ \real_t d t ->
|
||||
let i = 1-genAt real_t in
|
||||
translate (xPos*i) (yPos*i) $
|
||||
scale (1+0.5*genAt real_t) $
|
||||
frameAtT (((t+genT real_t)/d) `mod'` 1) ani
|
||||
return (spriteAt, spriteTMod, sprite)
|
||||
|
||||
featSVG :: Animation
|
||||
featSVG = animate $ const $ scale 0.4 $ svgLogo
|
||||
|
||||
feat3D :: Animation
|
||||
feat3D = rotateSphere
|
||||
# mapA (scale 0.5)
|
||||
# repeatA 10
|
||||
|
||||
frameAtT :: Double -> Animation -> SVG
|
||||
frameAtT t (Animation d f) = f t
|
||||
|
||||
featLaTeX :: Animation
|
||||
featLaTeX = animate $ \t ->
|
||||
translate 0 0.5 $
|
||||
mkGroup
|
||||
[ scale 1.5 $
|
||||
center $
|
||||
withFillColor "white" $
|
||||
latex "\\LaTeX"
|
||||
, frameAtT t $
|
||||
fadeTransitions 0.2 $ map mkEQ [eq1, eq3, eq4, eq5]
|
||||
]
|
||||
where
|
||||
eq1 = "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
|
||||
eq2 = "e=mc^2"
|
||||
-- eq3 = "\\int_{a}^{b}f'(x)dx=f(b)-f(a)"
|
||||
eq3 = "\\Delta \\times E=- \\frac{\\partial B}{\\partial t}"
|
||||
eq4 = "\\frac{d}{dt}(\\frac{\\partial L}{\\partial \\dot{q}}) = \\frac{\\partial L}{\\partial q}"
|
||||
eq5 = "\\vec{E} = \\frac{\\sigma}{2\\epsilon_0}\\hat{n}"
|
||||
mkEQ txt =
|
||||
drawAnimation $
|
||||
withStrokeColor "white" $
|
||||
withFillColor "white" $
|
||||
withStrokeWidth 0.01 $
|
||||
translate 0 (-1.5) $
|
||||
scale 0.5 $
|
||||
center $
|
||||
latexAlign txt
|
||||
|
||||
fadeTransition :: Double -> Animation -> Animation -> Animation
|
||||
fadeTransition overlap a b =
|
||||
(a
|
||||
# pauseAtEnd overlap
|
||||
# applyE (overEnding overlap $ fadeOutE)
|
||||
) `seqA` (
|
||||
b
|
||||
# applyE (overBeginning overlap $ fadeInE)
|
||||
)
|
||||
|
||||
fadeTransitions :: Double -> [Animation] -> Animation
|
||||
fadeTransitions overlap = foldl (fadeTransition overlap) (pause 0)
|
||||
|
||||
featWireSphere :: Animation
|
||||
featWireSphere = rotateWireSphere
|
||||
# mapA (scale 0.5)
|
||||
# reverseA
|
||||
# repeatA 10
|
||||
|
||||
introSVG :: Animation
|
||||
introSVG = sceneAnimation $ do
|
||||
fork $ play $ animate $ const $
|
||||
mkBackground "black"
|
||||
-- Title
|
||||
title <- newSprite $ do
|
||||
return $ \_ _d _t ->
|
||||
translate 0 3.5 $
|
||||
center $
|
||||
withFillColor "white" $
|
||||
latex "reanimate"
|
||||
spriteZ title 2
|
||||
-- Shading
|
||||
shadeOpacity <- newVar 0
|
||||
shade <- newSprite $ do
|
||||
opacity <- freezeVar shadeOpacity
|
||||
return $ \real_t d t ->
|
||||
withFillOpacity (0.8 * opacity real_t) $
|
||||
withFillColor "black" $
|
||||
mkRect screenWidth screenHeight
|
||||
spriteZ shade 1
|
||||
-- Modifier
|
||||
let tweenFeat sp var varT initWait dur = do
|
||||
wait initWait
|
||||
spriteZ sp 2
|
||||
tweenVar shadeOpacity 1 $ \t i -> fromToS i 1 (curveS 2 t)
|
||||
tweenVar var 1 $ \t i -> fromToS i 1 (curveS 2 t)
|
||||
tweenVar varT 1 $ \t i -> fromToS i 1 (curveS 2 t)
|
||||
wait 1
|
||||
tweenVar varT dur $ \t i -> fromToS i (1+dur) (t/dur)
|
||||
wait dur
|
||||
tweenVar var 1 $ \t i -> fromToS i 0 (curveS 2 t)
|
||||
tweenVar varT dur $ \t i -> fromToS i (1+dur+1) $ curveS 2 (t/dur)
|
||||
tweenVar shadeOpacity 1 $ \t i -> fromToS i 0 (curveS 2 t)
|
||||
wait 1
|
||||
spriteZ sp 0
|
||||
-- SVG
|
||||
(svgAt, svgT, svgS) <- mkFeatSprite (-5.5) (1.5) featSVG
|
||||
fork $ tweenFeat svgS svgAt svgT svgHighlight svgHighlightDur
|
||||
-- LaTeX
|
||||
(latexAt, latexT, latexS) <- mkFeatSprite (5.5) (1.5) featLaTeX
|
||||
fork $ tweenFeat latexS latexAt latexT latexHighlight latexHighlightDur
|
||||
-- Tracing
|
||||
(traceAt, traceT, traceS) <- mkFeatSprite (-5.5) (-2.5) featWireSphere
|
||||
fork $ tweenFeat traceS traceAt traceT traceHighlight traceHighlightDur
|
||||
-- Raytracing
|
||||
(rayAt, rayT, rayS) <- mkFeatSprite (5.5) (-2.5) feat3D
|
||||
fork $ tweenFeat rayS rayAt rayT rayHighlight rayHighlightDur
|
||||
-- wait
|
||||
wait $ rayHighlight + rayHighlightDur + 2 + 10
|
||||
return ()
|
||||
where
|
||||
svgHighlight = 1
|
||||
svgHighlightDur = 3
|
||||
latexHighlight = svgHighlight+svgHighlightDur+2
|
||||
latexHighlightDur = 3
|
||||
traceHighlight = latexHighlight+latexHighlightDur+2
|
||||
traceHighlightDur = 3
|
||||
rayHighlight = traceHighlight+traceHighlightDur+2
|
||||
rayHighlightDur = 3
|
||||
|
||||
drawAnimation :: SVG -> Animation
|
||||
drawAnimation = drawAnimation' 0.5 0.3
|
||||
|
||||
drawAnimation' :: Double -> Double -> SVG -> Animation
|
||||
drawAnimation' fillDur step svg = sceneAnimation $ do
|
||||
forM_ (zip [0..] $ svgGlyphs svg) $ \(n, (fn, attr, tree)) -> do
|
||||
let sWidth =
|
||||
case toUserUnit defaultDPI <$> getLast (attr ^. strokeWidth) of
|
||||
Just (Num d) -> d
|
||||
_ -> defaultStrokeWidth
|
||||
fork $ do
|
||||
wait (n*step)
|
||||
play $ mapA fn $ (animate (\t -> withFillOpacity 0 $ partialSvg t tree)
|
||||
# applyE (overEnding fillDur $ fadeLineOutE sWidth))
|
||||
fork $ do
|
||||
wait (n*step+(1-fillDur))
|
||||
newSprite $ do
|
||||
return $ \_real_t d t ->
|
||||
withStrokeWidth 0 $ fn $ withFillOpacity (min 1 $ t/fillDur) tree
|
||||
-- play $ animate (\t -> withStrokeWidth 0 $ fn $ withFillOpacity t tree)
|
||||
-- # setDuration fillDur
|
||||
-- # pauseAtEnd ((len-n)*step)
|
||||
where
|
||||
len = fromIntegral $ length $ svgGlyphs svg
|
||||
|
||||
drawSphere :: Animation
|
||||
drawSphere = animate $ \t ->
|
||||
partialSvg t $
|
||||
withStrokeColor "white" $
|
||||
withStrokeWidth 0.01 $
|
||||
withFillOpacity 0 $
|
||||
lowerTransformations $
|
||||
flipYAxis $
|
||||
translate (-screenWidth/2) (-screenHeight/2) $
|
||||
scale 0.00625 $
|
||||
mkPath $ extractPath $
|
||||
vectorize_ ["-i"] $
|
||||
povraySlow' [] (script (svgAsPngFile texture) 0)
|
||||
|
||||
rotateWireSphere :: Animation
|
||||
rotateWireSphere = animate $ \t ->
|
||||
withStrokeColor "white" $
|
||||
withStrokeWidth 0.01 $
|
||||
withFillOpacity 0 $
|
||||
lowerTransformations $
|
||||
flipYAxis $
|
||||
translate (-screenWidth/2) (-screenHeight/2) $
|
||||
scale (screenWidth/2560) $
|
||||
mkPath $ extractPath $
|
||||
vectorize_ ["-i"] $
|
||||
povraySlow' [] (script (svgAsPngFile texture) (t*360/10))
|
||||
|
||||
rotateSphere :: Animation
|
||||
rotateSphere = animate $ \t ->
|
||||
povraySlow [] (script (svgAsPngFile texture) (t*360/10))
|
||||
|
||||
texture :: SVG
|
||||
texture = checker 10 10
|
||||
|
||||
script :: FilePath -> Double -> Text
|
||||
script png s = [iTrim|
|
||||
//EXAMPLE OF SPHERE
|
||||
|
||||
//Files with predefined colors and textures
|
||||
#include "colors.inc"
|
||||
#include "glass.inc"
|
||||
#include "golds.inc"
|
||||
#include "metals.inc"
|
||||
#include "stones.inc"
|
||||
#include "woods.inc"
|
||||
|
||||
#include "shapes3.inc"
|
||||
|
||||
//Place the camera
|
||||
camera {
|
||||
orthographic
|
||||
// angle 50
|
||||
location <0,0,-10>
|
||||
look_at <0,0,0>
|
||||
//right x*image_width/image_height
|
||||
up <0,9,0>
|
||||
right <16,0,0>
|
||||
}
|
||||
|
||||
|
||||
|
||||
//Ambient light to "brighten up" darker pictures
|
||||
global_settings { ambient_light White*3 }
|
||||
|
||||
//Set a background color
|
||||
//background { color White }
|
||||
//background { color rgbt <0.1, 0, 0, 0> } // red
|
||||
background { color rgbt <0, 0, 0, 1> } // transparent
|
||||
|
||||
//Sphere with specified center point and radius
|
||||
sphere {
|
||||
<0,0,0>, 2
|
||||
texture {
|
||||
//pigment{ color rgbt <0,0,1,0.1> }
|
||||
uv_mapping pigment{
|
||||
image_map{ png ${png} }
|
||||
//color rgbt <0,0,1,0.1>
|
||||
}
|
||||
}
|
||||
rotate <0,${s'},0>
|
||||
rotate <-30,0,0>
|
||||
}
|
||||
|]
|
||||
where
|
||||
precision = 0.1
|
||||
s' = fromIntegral (round (s / precision)) * precision
|
||||
|
||||
checker :: Int -> Int -> SVG
|
||||
checker w h =
|
||||
withFillColor "white" $
|
||||
withStrokeColor "white" $
|
||||
withStrokeWidth 0.1 $
|
||||
mkGroup
|
||||
[ withStrokeWidth 0 $
|
||||
withFillOpacity 0.8 $ mkBackground "blue"
|
||||
, mkGroup
|
||||
[ translate (stepX*x-offsetX + stepX/2) 0 $
|
||||
mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9)
|
||||
| x <- map fromIntegral [0..w-1]
|
||||
]
|
||||
,
|
||||
mkGroup
|
||||
[ translate 0 (stepY*y-offsetY) $
|
||||
mkLine (-screenWidth/2, 0) (screenWidth/2, 0)
|
||||
| y <- map fromIntegral [0..h]
|
||||
]
|
||||
]
|
||||
where
|
||||
stepX = screenWidth/fromIntegral w
|
||||
stepY = screenHeight/fromIntegral h
|
||||
offsetX = screenWidth/2
|
||||
offsetY = screenHeight/2
|
||||
Loading…
Reference in a new issue