mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-18 03:12:40 +00:00
Merge branch 'master' into color-theory
Former-commit-id: b7cad8a8f7f9e7e32ef372fc9f15e7e21e5be61a
This commit is contained in:
David Himmelstrup
commit
f1b73da398
117 changed files with 3327 additions and 1448 deletions
|
|
@ -9,7 +9,7 @@ import Control.Lens
|
|||
import Graphics.SvgTree
|
||||
import Reanimate.Driver (reanimate)
|
||||
import Reanimate.LaTeX
|
||||
import Reanimate.Monad
|
||||
import Reanimate.Animation
|
||||
import Reanimate.Svg
|
||||
import Reanimate.Signal
|
||||
|
||||
|
|
@ -29,40 +29,44 @@ run out.
|
|||
-}
|
||||
main :: IO ()
|
||||
main = reanimate $ pauseAtEnd 2
|
||||
(mkAnimation 0 $ emit $ mkBackground "black") `sim`
|
||||
(animate $ const $ mkBackground "black") `parA`
|
||||
drawBox
|
||||
|
||||
drawBox :: Animation
|
||||
drawBox = mkAnimation 5 $ do
|
||||
emit $ withFillColor "white" $
|
||||
drawBox = mkAnimation 5 $ \t ->
|
||||
mkGroup
|
||||
[ withFillColor "white" $
|
||||
translate 0 (-70) $
|
||||
scale 2 $ center $ latex "Baker's Algorithm"
|
||||
s <- getSignal $ signalFromList [(0.7, signalFlat 0), (1, signalLinear)]
|
||||
d <- getSignal $ signalFromList [(0.7, signalFlat 0), (1, signalLinear)]
|
||||
draw <- getSignal $ signalFromList [(0.5, signalLinear), (1, signalFlat 1)]
|
||||
let mlc = MemoryLineChart
|
||||
{ mlcWidth = 230
|
||||
, mlcHeight = 50 + s*50
|
||||
, mlcDivider = d
|
||||
, mlcOuterBox = draw }
|
||||
emit $ translate 0 20 $ renderMemoryLineChart mlc
|
||||
, let s = fromListS [(0.7, constantS 0), (1, id)] t
|
||||
d = fromListS [(0.7, constantS 0), (1, id)] t
|
||||
draw = fromListS [(0.5, id), (1, constantS 1)] t
|
||||
mlc = MemoryLineChart
|
||||
{ mlcWidth = 230
|
||||
, mlcHeight = 50 + s*50
|
||||
, mlcDivider = d
|
||||
, mlcOuterBox = draw }
|
||||
in translate 0 20 $ renderMemoryLineChart mlc
|
||||
]
|
||||
|
||||
highlightBox :: Animation
|
||||
highlightBox = mkAnimation 2 $ do
|
||||
emit $ withFillColor "white" $
|
||||
highlightBox = mkAnimation 2 $ \t ->
|
||||
mkGroup
|
||||
[ withFillColor "white" $
|
||||
translate 0 (-70) $
|
||||
scale 2 $ center $ latex "Highlightbox"
|
||||
let boxX = negate mlcWidth / 2
|
||||
boxY = negate mlcHeight / 2
|
||||
mlcWidth = 230
|
||||
mlcHeight = 50
|
||||
s <- getSignal $ signalFromList [(0.0, signalFlat 0), (1, signalBell 2)]
|
||||
emit $
|
||||
, let boxX = negate mlcWidth / 2
|
||||
boxY = negate mlcHeight / 2
|
||||
mlcWidth = 230
|
||||
mlcHeight = 50
|
||||
s = fromListS [(0.0, constantS 0), (1, bellS 2)] t
|
||||
in
|
||||
withStrokeColor "white" $
|
||||
withStrokeWidth (Num $ 0.5 + s) $
|
||||
withStrokeWidth (0.5 + s) $
|
||||
withFillOpacity 0 $
|
||||
translate (boxX + mlcWidth/2) (boxY + mlcHeight/2) $
|
||||
mkRect (Num mlcWidth) (Num mlcHeight)
|
||||
mkRect mlcWidth mlcHeight
|
||||
]
|
||||
|
||||
data MemoryLineChart = MemoryLineChart
|
||||
{ mlcWidth :: Double
|
||||
|
|
@ -80,15 +84,15 @@ mlcBox MemoryLineChart{..} = (boxX, boxY, mlcWidth, mlcHeight)
|
|||
renderMemoryLineChart :: MemoryLineChart -> Tree
|
||||
renderMemoryLineChart MemoryLineChart{..} = mkGroup
|
||||
[ withStrokeColor "white" $
|
||||
withStrokeWidth (Num 0.5) $
|
||||
withStrokeWidth 0.5 $
|
||||
withFillOpacity 0 $
|
||||
partialSvg mlcOuterBox $ pathify $
|
||||
translate (boxX + mlcWidth/2) (boxY + mlcHeight/2) $
|
||||
mkRect (Num mlcWidth) (Num mlcHeight)
|
||||
mkRect mlcWidth mlcHeight
|
||||
, withStrokeColor "white" $
|
||||
withStrokeWidth (Num 0.5) $
|
||||
mkLine (Num (negate $ mlcWidth/2), Num 0)
|
||||
(Num (negate (mlcWidth/2) + lineWidth), Num 0)
|
||||
withStrokeWidth 0.5 $
|
||||
mkLine (negate (mlcWidth/2), 0)
|
||||
(negate (mlcWidth/2) + lineWidth, 0)
|
||||
, withFillColor "white" $
|
||||
translate (negate (mlcWidth/2) - 10) 0 $ rotate (-90) $
|
||||
center $ latex "Memory"
|
||||
|
|
|
|||
|
|
@ -23,8 +23,10 @@ import Reanimate.ColorSpace
|
|||
import Reanimate.Constants
|
||||
import Reanimate.Driver (reanimate)
|
||||
import Reanimate.LaTeX
|
||||
import Reanimate.Monad
|
||||
import Reanimate
|
||||
import Reanimate.Animation
|
||||
import Reanimate.Raster
|
||||
import Reanimate.Svg.BoundingBox
|
||||
import Reanimate.Scene
|
||||
import Reanimate.Effect
|
||||
import Reanimate.Signal
|
||||
|
|
@ -42,7 +44,7 @@ colorSpacesScene = sceneAnimation $ mdo
|
|||
beginT <- queryNow
|
||||
fork $ play $ frame
|
||||
# setDuration (endT-beginT)
|
||||
fork $ playZ 1 $ mkAnimation 1 (emit spectrumGrid)
|
||||
fork $ playZ 1 $ animate (const spectrumGrid)
|
||||
# setDuration (endT-beginT)
|
||||
dur <- withSceneDuration $ do
|
||||
fork $ play $ drawSensitivity 1 short blueName
|
||||
|
|
@ -131,12 +133,12 @@ colorSpacesScene = sceneAnimation $ mdo
|
|||
zCoords = [ (nm, z) | (nm, (x, y, z)) <- Map.toList bigXYZCoordinates ]
|
||||
|
||||
|
||||
frame = mkAnimation 2 $ do
|
||||
frame = mkAnimation 2 $ \t ->
|
||||
-- emit $ mkBackground "black"
|
||||
-- emit $ spectrumGrid
|
||||
s <- getSignal signalLinear
|
||||
let cm = hsv
|
||||
emit $ mkGroup
|
||||
let s = t
|
||||
cm = hsv
|
||||
in mkGroup
|
||||
[ mkClipPath "sRGB"
|
||||
[ simplify
|
||||
sRGBTriangle
|
||||
|
|
@ -150,7 +152,7 @@ frame = mkAnimation 2 $ do
|
|||
[ simplify $ lowerTransformations $
|
||||
translate 0 (margin/2) $
|
||||
pathify $
|
||||
mkRect (Num spectrumWidth) (Num $ spectrumHeight+margin)
|
||||
mkRect spectrumWidth (spectrumHeight+margin)
|
||||
]
|
||||
]
|
||||
|
||||
|
|
@ -278,7 +280,7 @@ spectrumWidth = screenWidth * 0.7
|
|||
|
||||
spectrumGrid :: Tree
|
||||
spectrumGrid =
|
||||
withStrokeWidth (Num strokeWidth) $
|
||||
withStrokeWidth strokeWidth $
|
||||
mkGroup
|
||||
[ center $
|
||||
withFillOpacity 0 $ withStrokeColor "white" $ mkPath $
|
||||
|
|
@ -337,9 +339,8 @@ spectrumGrid =
|
|||
|
||||
|
||||
drawSensitivity :: Double -> [(Nanometer, Double)] -> String -> Animation
|
||||
drawSensitivity maxHeight dat c = mkAnimation 1 $ do
|
||||
limit <- getSignal signalLinear
|
||||
emit $ sensitivitySVG maxHeight limit dat c
|
||||
drawSensitivity maxHeight dat c = animate $ \limit ->
|
||||
sensitivitySVG maxHeight limit dat c
|
||||
|
||||
morphSensitivity
|
||||
:: Double
|
||||
|
|
@ -348,12 +349,12 @@ morphSensitivity
|
|||
-> [(Nanometer, Double)]
|
||||
-> String
|
||||
-> Animation
|
||||
morphSensitivity maxHeightA maxHeightB datA datB c = mkAnimation 1 $ do
|
||||
m <- getSignal $ signalCurve 2 -- signalLinear
|
||||
let maxHeight = signalFromTo maxHeightA maxHeightB id m
|
||||
dat = [ (nm, signalFromTo a b id m)
|
||||
morphSensitivity maxHeightA maxHeightB datA datB c = animate $ \t ->
|
||||
let m = curveS 2 t
|
||||
maxHeight = fromToS maxHeightA maxHeightB m
|
||||
dat = [ (nm, fromToS a b m)
|
||||
| ((nm,a),(_,b)) <- zip datA datB ]
|
||||
emit $ sensitivitySVG maxHeight 1 dat c
|
||||
in sensitivitySVG maxHeight 1 dat c
|
||||
|
||||
-- emit $
|
||||
-- withClipPathRef (Ref "spectrum") $
|
||||
|
|
@ -380,8 +381,7 @@ sensitivitySVG maxHeight limit dat c =
|
|||
lastNM = 700 -- fromIntegral $ fst (last dat)
|
||||
|
||||
drawLabel :: Text -> Double -> [(Nanometer, Double)] -> String -> Animation
|
||||
drawLabel label maxHeight dat c = mkAnimation 1 $ do
|
||||
emit $
|
||||
drawLabel label maxHeight dat c = animate $ const $
|
||||
translate (0) (svgHeight labelSVG) $
|
||||
translate (spectrumWidth*percent) labelY $
|
||||
translate (-spectrumWidth/2) (-spectrumHeight/2) $
|
||||
|
|
|
|||
|
|
@ -21,10 +21,12 @@ import Numeric
|
|||
import Reanimate.ColorMap
|
||||
import Reanimate.Driver (reanimate)
|
||||
import Reanimate.LaTeX
|
||||
import Reanimate.Monad
|
||||
import Reanimate
|
||||
import Reanimate.Animation
|
||||
import Reanimate.Raster
|
||||
import Reanimate.Scene
|
||||
import Reanimate.Signal
|
||||
import Reanimate.Effect
|
||||
import Reanimate.Svg
|
||||
import Reanimate.ColorSpace
|
||||
import Reanimate.Constants
|
||||
|
|
@ -35,17 +37,14 @@ import Colorspace
|
|||
highdef = True
|
||||
|
||||
takeA :: Double -> Animation -> Animation
|
||||
takeA d1 (Animation d2 f) = Animation d $ Frame $ \_ t -> unFrame f d (min d t)
|
||||
where
|
||||
d = min d1 d2
|
||||
takeA = undefined
|
||||
|
||||
dropA :: Double -> Animation -> Animation
|
||||
dropA d1 (Animation d2 f) = Animation (max 0 (d2-d1)) $
|
||||
Frame $ \d t -> unFrame f d (t+d1)
|
||||
dropA = undefined
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $
|
||||
(mkAnimation 0 $ emit $ mkBackground "black") `sim`
|
||||
(animate $ const $ mkBackground "black") `parA`
|
||||
-- monalisaScene
|
||||
colorSpacesScene
|
||||
-- clipPathTest
|
||||
|
|
@ -140,34 +139,33 @@ interpolateColorMap d cmap1 cmap2 =
|
|||
i a b = round (fromIntegral a + (fromIntegral b-fromIntegral a)*d)
|
||||
in PixelRGB8 (i r1 r2) (i g1 g2) (i b1 b2)
|
||||
|
||||
sceneFalseColorChain (x:y:xs) = sceneFalseColor x y `before` sceneFalseColorChain (y:xs)
|
||||
sceneFalseColorChain (x:y:xs) = sceneFalseColor x y `seqA` sceneFalseColorChain (y:xs)
|
||||
sceneFalseColorChain _ = pause 0
|
||||
|
||||
sceneFalseColorIntro :: Animation
|
||||
sceneFalseColorIntro = mkAnimation 2 $ do
|
||||
s <- getSignal $ signalFromTo 1 2 $ signalCurve 3
|
||||
d <- getSignal $ signalCurve 3
|
||||
emit $
|
||||
translate ((screenWidth/4 - 0.75)*d) 0 $
|
||||
sceneFalseColorIntro = mkAnimation 2 $ \t ->
|
||||
let s = fromToS 1 2 $ curveS 3 t
|
||||
d = curveS 3 t
|
||||
in mkGroup
|
||||
[ translate ((screenWidth/4 - 0.75)*d) 0 $
|
||||
scaleToSize (screenWidth/s) (screenHeight/s) $
|
||||
center $ embedImage monalisaLarge
|
||||
emit $
|
||||
withGroupOpacity d $
|
||||
, withGroupOpacity d $
|
||||
translate ((screenWidth/4 - 0.75)*d) 0 $
|
||||
scaleToSize (screenWidth/s) (screenHeight/s) $
|
||||
embedImage monalisa
|
||||
embedImage monalisa ]
|
||||
|
||||
sceneFalseColor :: (Double -> PixelRGB8) -> (Double -> PixelRGB8) -> Animation
|
||||
sceneFalseColor cmap1 cmap2 = mkAnimation 5 $ do
|
||||
s <- getSignal $ signalCurve 3
|
||||
let cm = interpolateColorMap s cmap1 cmap2
|
||||
emit $ translate (screenWidth/4 - 0.75) 0 $
|
||||
sceneFalseColor cmap1 cmap2 = mkAnimation 5 $ \t ->
|
||||
let s = curveS 3 t
|
||||
cm = interpolateColorMap s cmap1 cmap2
|
||||
in translate (screenWidth/4 - 0.75) 0 $
|
||||
scaleToSize (screenWidth/2) (screenHeight/2) $ embedImage $
|
||||
applyColorMap cm monalisa
|
||||
|
||||
sceneColorMaps :: Animation
|
||||
sceneColorMaps = mkAnimation 5 $ do
|
||||
emit $ mkGroup
|
||||
sceneColorMaps = mkAnimation 5 $ const $
|
||||
mkGroup
|
||||
[ translate xOffset (yInit - n*yStep) $
|
||||
mkGroup
|
||||
[ renderColorMap width height cmap
|
||||
|
|
@ -199,45 +197,33 @@ limitGreyPixels limit img =
|
|||
let pixel@(PixelRGB8 r _ _) = pixelAt img x y
|
||||
in if r < limit then promotePixel pixel else PixelRGBA8 0 0 0 1 --limit limit limit
|
||||
|
||||
latexTest :: Animation
|
||||
latexTest = mkAnimation 5 $ do
|
||||
let (_,_,baseW,baseH) = boundingBox $ latex "Hello world"
|
||||
(_,_,txtW, txtH) = boundingBox $ latex "aa"
|
||||
emit $ withFillColor "white" $ latex "Hello world"
|
||||
emit $ translate (-10) (baseH-txtH) $ withFillColor "white" $ latex "aa"
|
||||
emit $ withStrokeWidth (Num 0.3) $ withStrokeColor "white" $
|
||||
mkGroup
|
||||
[ mkLine (Num (-100), Num 0) (Num 100, Num 0)
|
||||
, mkLine (Num 0, Num (-100)) (Num 0, Num 100)]
|
||||
|
||||
renderColorMap :: Double -> Double -> (Double -> PixelRGB8) -> Tree
|
||||
renderColorMap width height cmap = mkGroup
|
||||
[ scaleToSize width height $ mkColorMap cmap
|
||||
, center $ withStrokeWidth (Num 0.01) $
|
||||
, center $ withStrokeWidth 0.01 $
|
||||
withStrokeColor "white" $ withFillOpacity 0 $
|
||||
mkRect (Num width) (Num height)
|
||||
mkRect width height
|
||||
]
|
||||
|
||||
showColorMap :: Double -> Double -> Animation
|
||||
showColorMap start end = mkAnimation 2 $ do
|
||||
s <- getSignal $ signalCurve 2
|
||||
let n = signalFromTo start end id s
|
||||
emit $
|
||||
translate 0 offsetY $
|
||||
showColorMap start end = mkAnimation 2 $ \t ->
|
||||
let s = curveS 2 t
|
||||
n = fromToS start end s
|
||||
in translate 0 offsetY $
|
||||
mkGroup
|
||||
[ withGroupOpacity 0.9 $
|
||||
withFillColor "black" $
|
||||
translate 0 (0) $
|
||||
center $
|
||||
mkRect (Num $ width + height*2) (Num $ height*3)
|
||||
, scaleToSize width height $ mkColorMap (cm . signalFromTo start end id)
|
||||
mkRect (width + height*2) (height*3)
|
||||
, scaleToSize width height $ mkColorMap (cm . fromToS start end)
|
||||
, translate (s*width - width/2) 0 $
|
||||
center $
|
||||
withStrokeColor "black" $
|
||||
mkLine (Num 0, Num 0) (Num 0, Num height)
|
||||
mkLine (0, 0) (0, height)
|
||||
, center $ --withStrokeWidth (Num 0.5) $
|
||||
withStrokeColor "white" $ withFillOpacity 0 $
|
||||
mkRect (Num width) (Num height)
|
||||
mkRect width height
|
||||
, translate (s*width - width/2) (height) $
|
||||
scale 0.3 $
|
||||
centerX $
|
||||
|
|
@ -269,26 +255,27 @@ mkColorMap f = center $ embedImage img
|
|||
|
||||
|
||||
drawPixelImage :: Double -> Double -> Animation
|
||||
drawPixelImage start end = mkAnimation 2 $ do
|
||||
limit <- getSignal $ signalFromTo start end $ signalCurve 2
|
||||
emit $ scaleToSize screenWidth screenHeight $ center $ embedImage $
|
||||
limitGreyPixels (floor (limit*255)) monalisaLarge
|
||||
drawPixelImage start end = mkAnimation 2 $ \t ->
|
||||
let limit = fromToS start end $ curveS 2 t
|
||||
in scaleToSize screenWidth screenHeight $ center $ embedImage $
|
||||
limitGreyPixels (floor (limit*255)) monalisaLarge
|
||||
|
||||
drawHexPixels :: Animation
|
||||
drawHexPixels = mkAnimation 1 $ do
|
||||
when highdef $
|
||||
emit $ defs
|
||||
emit $ withFillOpacity 1 $ withStrokeWidth (Num 0) $ withFillColor "white" $
|
||||
drawHexPixels = mkAnimation 1 $ \_ ->
|
||||
mkGroup
|
||||
[ if highdef then defs else None
|
||||
, withFillOpacity 1 $ withStrokeWidth 0 $ withFillColor "white" $
|
||||
mkGroup
|
||||
[ translate ((fromIntegral x+0.5)/fromIntegral width*screenWidth - screenWidth/2)
|
||||
(screenHeight/2 - (fromIntegral y+0.5)/fromIntegral height*screenHeight) $
|
||||
if highdef
|
||||
then mkUse ("tag" ++ show r)
|
||||
else mkCircle (Num 0.5)
|
||||
else mkCircle 0.5
|
||||
| x <- [0..width-1]
|
||||
, y <- [0..height-1]
|
||||
, let pixel@(PixelRGB8 r _ _) = pixelAt monalisa x y
|
||||
]
|
||||
]
|
||||
where
|
||||
defs = preRender $ mkDefinitions images
|
||||
getNthSet n = centerX $ snd (splitGlyphs [n*2,n*2+1] allGlyphs)
|
||||
|
|
@ -309,14 +296,7 @@ drawHexPixels = mkAnimation 1 $ do
|
|||
|
||||
|
||||
fadeIn :: Double -> Animation -> Animation
|
||||
fadeIn fadeDuration (Animation d genFrame) = Animation d $ do
|
||||
t <- askTime
|
||||
mapF (withGroupOpacity (max 0 $ min 1 (t/fadeDuration))) genFrame
|
||||
fadeIn t = applyE (overBeginning t fadeInE)
|
||||
|
||||
fadeOut :: Double -> Animation -> Animation
|
||||
fadeOut fadeDuration (Animation d genFrame) = Animation d $ do
|
||||
t <- askTime
|
||||
mapF (withGroupOpacity (max 0 $ min 1 ((d-t)/fadeDuration))) genFrame
|
||||
|
||||
askTime :: Frame Time
|
||||
askTime = Frame $ \_dur t -> return t
|
||||
fadeOut t = applyE (overEnding t fadeOutE)
|
||||
|
|
|
|||
|
|
@ -1,63 +1,61 @@
|
|||
#!/usr/bin/env stack
|
||||
-- stack --resolver lts-13.14 runghc --package reanimate
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Main (main) where
|
||||
|
||||
import Control.Lens ()
|
||||
import Control.Lens ()
|
||||
|
||||
import Graphics.SvgTree (Number(..), Tree)
|
||||
import Reanimate.Driver (reanimate)
|
||||
import Reanimate.LaTeX
|
||||
import Reanimate.Monad
|
||||
import Reanimate.Svg
|
||||
import Reanimate.Signal
|
||||
import Reanimate.ColorMap
|
||||
import Codec.Picture.Types
|
||||
import Data.Fixed
|
||||
import Data.List
|
||||
import qualified Data.Text as T
|
||||
import qualified Geom2D.CubicBezier as Bezier
|
||||
import Graphics.SvgTree (Number (..), Tree)
|
||||
import Numeric
|
||||
import qualified Data.Text as T
|
||||
import qualified Geom2D.CubicBezier as Bezier
|
||||
import Data.Fixed
|
||||
import System.Random.Shuffle
|
||||
import System.Random
|
||||
import Data.List
|
||||
import Reanimate.Animation
|
||||
import Reanimate.ColorMap
|
||||
import Reanimate.Driver (reanimate)
|
||||
import Reanimate.LaTeX
|
||||
import Reanimate.Signal
|
||||
import Reanimate.Svg
|
||||
import System.Random
|
||||
import System.Random.Shuffle
|
||||
|
||||
fixed :: Tree -> Animation -> Animation
|
||||
fixed svg ani = mkAnimation 0 (emit svg) `sim` ani
|
||||
fixed svg ani = animate (const svg) `parA` ani
|
||||
|
||||
digitWidth = 25
|
||||
digitCount = 10
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ fixed bg $ pauseAtEnd 1 $
|
||||
mkAnimation 5 $ do
|
||||
s <- getSignal $ signalLinear
|
||||
emit $ withFillColor "white" $ translate (negate $ digitWidth*digitCount/2) 0 $
|
||||
mkAnimation 5 $ \t ->
|
||||
withFillColor "white" $ translate (negate $ digitWidth*digitCount/2) 0 $
|
||||
-- sortingTransition (zip [9,0,1,2,3,4,5,6,8,7] squares) s
|
||||
-- sortingTransition (zip [9,0,1,2,3,4,5,6,8,7] digits) s
|
||||
-- sortingTransition (zip [1,0,2,3,4,5,6,7,8,9] digiSquares) s
|
||||
-- jumpTransition (zip [1,0,2,3,4,5,6,7,8,9] digiSquares) s
|
||||
renderSortElements (mkJumpSorted lst) s
|
||||
renderSortElements (mkJumpSorted lst) t
|
||||
where
|
||||
seed = 0xDEADBEEF
|
||||
lst = shuffle' (zip [0..] digiSquares) 10 (mkStdGen seed)
|
||||
bg = mkBackground "black"
|
||||
msg = "0 1 2 3 4 5 6 7 8 9"
|
||||
digits =
|
||||
map (withStrokeColor "black" . withStrokeWidth (Num 0.2)) $
|
||||
map (withStrokeColor "black" . withStrokeWidth 0.2) $
|
||||
map (lowerTransformations . scale 3 . pathify . center . latex . T.pack . show) [0..9]
|
||||
squares = map center [ withFillColorPixel (promotePixel $ viridis (n/9)) $
|
||||
mkRect (Num $ digitWidth+0.2) (Num digitWidth) | n <- [0..9]]
|
||||
mkRect (digitWidth+0.2) digitWidth | n <- [0..9]]
|
||||
|
||||
digiSquares = zipWith (\a b -> mkGroup [a,b]) squares digits
|
||||
|
||||
-- msg = "Eve"
|
||||
glyphs = lowerTransformations $ scale 3 $ pathify $ center $ latexAlign msg
|
||||
fillText = mkAnimation 1 $ do
|
||||
s <- getSignal signalLinear
|
||||
sat <- getSignal $ signalFromTo 0 0.7 signalLinear
|
||||
emit $ withFillColor "white" $ withStrokeColor "white" $ withStrokeWidth (Num $ 0.4 * (1-s)) $
|
||||
withFillOpacity s glyphs
|
||||
fillText = mkAnimation 1 $ \t ->
|
||||
let sat = fromToS 0 0.7 t in
|
||||
withFillColor "white" $ withStrokeColor "white" $ withStrokeWidth (0.4 * (1-t)) $
|
||||
withFillOpacity t glyphs
|
||||
-- withSubglyphs [0] (withFillColorPixel $ toRGBString sat 0.0) $
|
||||
-- withSubglyphs [1] (withFillColorPixel $ toRGBString sat 0.1) $
|
||||
-- withSubglyphs [2] (withFillColorPixel $ toRGBString sat 0.2) $
|
||||
|
|
@ -69,22 +67,20 @@ main = reanimate $ fixed bg $ pauseAtEnd 1 $
|
|||
-- withSubglyphs [8] (withFillColorPixel $ toRGBString sat 0.8) $
|
||||
-- withSubglyphs [9] (withFillColorPixel $ toRGBString sat 0.9) $
|
||||
-- glyphs
|
||||
drawText = mkAnimation 2 $ do
|
||||
s <- getSignal signalLinear
|
||||
emit $
|
||||
withStrokeColor "white" $ withFillOpacity 0 $ withStrokeWidth (Num 0.4) $
|
||||
partialSvg s glyphs
|
||||
drawText = mkAnimation 2 $ \t ->
|
||||
withStrokeColor "white" $ withFillOpacity 0 $ withStrokeWidth 0.4 $
|
||||
partialSvg t glyphs
|
||||
|
||||
data Direction = Up | Down | Sideways
|
||||
type Delay = Double
|
||||
type Position = Int
|
||||
data SortElement = SortElement
|
||||
{ sortElementDirection :: Direction
|
||||
, sortElementStartTime :: Double
|
||||
, sortElementDuration :: Double
|
||||
{ sortElementDirection :: Direction
|
||||
, sortElementStartTime :: Double
|
||||
, sortElementDuration :: Double
|
||||
, sortElementStartPosition :: Position
|
||||
, sortElementEndPosition :: Position
|
||||
, sortElementTree :: Tree }
|
||||
, sortElementEndPosition :: Position
|
||||
, sortElementTree :: Tree }
|
||||
|
||||
|
||||
mkJumpSorted :: [(Int, Tree)] -> [SortElement]
|
||||
|
|
@ -100,7 +96,7 @@ mkJumpSorted = fixParameters . worker Up . zip [0..]
|
|||
, sortElementEndPosition = target
|
||||
, sortElementTree = elt
|
||||
} : worker (flip dir) (yoink target rest)
|
||||
flip Up = Down
|
||||
flip Up = Down
|
||||
flip Down = Up
|
||||
|
||||
-- 10
|
||||
|
|
@ -150,13 +146,13 @@ renderSortElement SortElement{..} t
|
|||
| t > sortElementStartTime + sortElementDuration =
|
||||
translate (fromIntegral sortElementEndPosition * digitWidth) 0 sortElementTree
|
||||
| otherwise =
|
||||
let pos = signalCurve 2 $ (t - sortElementStartTime) / sortElementDuration
|
||||
let pos = curveS 2 $ (t - sortElementStartTime) / sortElementDuration
|
||||
from = sortElementStartPosition
|
||||
to = sortElementEndPosition
|
||||
linear = fromIntegral from + (fromIntegral (to-from))*pos
|
||||
y = case sortElementDirection of
|
||||
Down -> (sin (pos*pi) * digitWidth)
|
||||
Up -> negate (sin (pos*pi) * digitWidth)
|
||||
Down -> (sin (pos*pi) * digitWidth)
|
||||
Up -> negate (sin (pos*pi) * digitWidth)
|
||||
Sideways -> 0 in
|
||||
translate (linear * digitWidth) y sortElementTree
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue