mirror of
https://github.com/reanimate/reanimate.git
synced 2026-09-09 07:03:11 +00:00
Fix some hlint warnings, and more consistency in examples (#167)
* Remove redundant brackets * Various hlint fixes * Remove unused language pragrams and other fixes * Use addStatic more consistently in examples * Rename remaining usages of sceneAnimation to scene
This commit is contained in:
Jan Hrcek
GitHub
parent
37aa90378e
commit
0aca2333e2
63 changed files with 240 additions and 275 deletions
|
|
@ -116,7 +116,7 @@ main = forever $ do
|
|||
"latex is missing"
|
||||
assertIO (findExecutable "xelatex") (/=Nothing)
|
||||
"xelatex is missing"
|
||||
exitWith ExitSuccess
|
||||
exitSuccess
|
||||
[] -> do
|
||||
tok <- getEnv "DISCORD_TOKEN"
|
||||
T.putStrLn =<< runDiscord def
|
||||
|
|
@ -168,7 +168,6 @@ eventHandler fastGhci slowGhci event = case event of
|
|||
-- }
|
||||
-- void $ restCall (R.CreateMessageEmbed (messageChannel m) "video.mp4" embed)
|
||||
void $ restCall (R.DeleteOwnReaction (messageChannel m, messageId m) "eyes")
|
||||
return ()
|
||||
Left err -> do
|
||||
liftIO $ putStrLn "Video failed!"
|
||||
Right dm <- restCall (R.CreateDM (userId $ messageAuthor m))
|
||||
|
|
|
|||
|
|
@ -183,7 +183,7 @@ API references:
|
|||
|
||||
# Step 4: Moving objects
|
||||
|
||||
Objects in reanimate encapsulate SVG nodes and makes it easier to animate properties such as position and scale. In the example below, we create an object from the `E` SVG node and 'tween' position properties to make it move around the canvas. [Tweening](https://en.wikipedia.org/wiki/Inbetweening) (or inbetweening) is an animation concept that simply meanings moving smoothly from one value to another.
|
||||
Objects in reanimate encapsulate SVG nodes and makes it easier to animate properties such as position and scale. In the example below, we create an object from the `E` SVG node and 'tween' position properties to make it move around the canvas. [Tweening](https://en.wikipedia.org/wiki/Inbetweening) (or inbetweening) is an animation concept that simply means moving smoothly from one value to another.
|
||||
|
||||
Reanimate exports many properties such as `oLeftX`, `oTopY` and `oCenterXY`. These properties manipulate the object's position with respect to its bounding box and margins. The position of an object is ultimately captured in the `oTranslate` property and resetting this property will undo any movements.
|
||||
|
||||
|
|
|
|||
|
|
@ -9,12 +9,10 @@ import NeatInterpolation
|
|||
import Reanimate
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ mkAnimation 5 $ \t ->
|
||||
let s = t * pi * 2 in
|
||||
mkGroup
|
||||
[ mkBackground "black"
|
||||
, blender (script $ T.pack $ show s)
|
||||
]
|
||||
main = reanimate $ addStatic (mkBackground "black") $ mkAnimation 5 $ \t ->
|
||||
let s = t * pi * 2
|
||||
in blender (script $ T.pack $ show s)
|
||||
|
||||
|
||||
texture :: T.Text
|
||||
texture = T.pack $ svgAsPngFile (mkGroup
|
||||
|
|
@ -65,8 +63,7 @@ checker w h =
|
|||
withStrokeColor "white" $
|
||||
withStrokeWidth 0.1 $
|
||||
mkGroup
|
||||
[ withStrokeWidth 0 $
|
||||
withFillOpacity 0.8 $ mkBackground "blue"
|
||||
[ withFillOpacity 0.8 $ mkBackground "blue"
|
||||
, mkGroup
|
||||
[ translate (stepX*x-offsetX + stepX/2) 0 $
|
||||
mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9)
|
||||
|
|
|
|||
|
|
@ -10,11 +10,11 @@ main :: IO ()
|
|||
main = reanimate bbox
|
||||
|
||||
bbox :: Animation
|
||||
bbox = bg `parA`
|
||||
bbox = addStatic bg $
|
||||
mapA (translate (-screenWidth/4) 0) bbox1 `parA`
|
||||
mapA (translate (screenWidth/4) 0) bbox2
|
||||
where
|
||||
bg = animate $ const $ mkBackground "black"
|
||||
bg = mkBackground "black"
|
||||
|
||||
bbox1 :: Animation
|
||||
bbox1 = mkAnimation 5 $ \t ->
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ starAnimation = mkAnimation 10 $ \t ->
|
|||
in withStrokeWidth 0 $ rotate (t * 360) $ mkGroup
|
||||
[ translate (x / newZ) (y / newZ) $ dot (1 - newZ)
|
||||
| (x, y, z) <-
|
||||
reverse $ take nStars $ dropWhile (\(_, _, z) -> z < camZ) $ allStars
|
||||
reverse $ take nStars $ dropWhile (\(_, _, z) -> z < camZ) allStars
|
||||
, let newZ = z - camZ
|
||||
]
|
||||
where
|
||||
|
|
|
|||
|
|
@ -35,33 +35,33 @@ drawTangent alpha = mapTree worker
|
|||
V2 midX midY = lerp 0.5 0 normed
|
||||
V2 normVectX normVectY = normalize tangent ^* (svgWidth normalTxt*1.1)
|
||||
tangentSvg =
|
||||
translate (posX) (posY) $
|
||||
translate posX posY $
|
||||
rotate (unangle normed/pi*180 + 180) $
|
||||
translate 0 (svgHeight tangentTxt/2) $
|
||||
translate 0 (svgHeight tangentTxt/2)
|
||||
tangentTxt
|
||||
normalSvg =
|
||||
translate (posX) (posY) $
|
||||
translate posX posY $
|
||||
rotate (unangle normed/pi*180 + 90) $
|
||||
translate (svgWidth normalTxt/2*1.1) (svgHeight normalTxt/2*1.3) $
|
||||
translate (svgWidth normalTxt/2*1.1) (svgHeight normalTxt/2*1.3)
|
||||
normalTxt
|
||||
in mkGroup
|
||||
[ withStrokeWidth (defaultStrokeWidth) $
|
||||
[ withStrokeWidth defaultStrokeWidth $
|
||||
withStrokeColor "black" $
|
||||
translate (posX-midX) (posY-midY) $
|
||||
mkLine (0, 0) (tangentX, tangentY)
|
||||
, withStrokeWidth (defaultStrokeWidth) $
|
||||
, withStrokeWidth defaultStrokeWidth $
|
||||
withStrokeColor "black" $
|
||||
translate (posX) (posY) $
|
||||
translate posX posY $
|
||||
mkLine (0, 0) (-normVectY, normVectX)
|
||||
, withStrokeWidth (defaultStrokeWidth*2) $
|
||||
withStrokeColor "white" $
|
||||
withStrokeColor "white"
|
||||
tangentSvg
|
||||
, withFillOpacity 1 $ withFillColor "black" $ withStrokeWidth 0 $
|
||||
, withFillOpacity 1 $ withFillColor "black" $ withStrokeWidth 0
|
||||
tangentSvg
|
||||
, withStrokeWidth (defaultStrokeWidth*2) $
|
||||
withStrokeColor "white" $
|
||||
withStrokeColor "white"
|
||||
normalSvg
|
||||
, withFillOpacity 1 $ withFillColor "black" $ withStrokeWidth 0 $
|
||||
, withFillOpacity 1 $ withFillColor "black" $ withStrokeWidth 0
|
||||
normalSvg
|
||||
]
|
||||
worker t = t
|
||||
|
|
@ -81,7 +81,7 @@ atPartial alpha cmds = evalState (worker 0 cmds) zero
|
|||
else do
|
||||
let bezier = lineCommandToBezier from cmd
|
||||
(pos, tangent) = evalBezierDeriv bezier frac
|
||||
pure $ (pos, tangent)
|
||||
pure (pos, tangent)
|
||||
totalLen = evalState (sum <$> mapM lineLength cmds) zero
|
||||
targetLen = totalLen * alpha
|
||||
|
||||
|
|
|
|||
|
|
@ -11,5 +11,5 @@ main :: IO ()
|
|||
main = reanimate $ docEnv $ pauseAtEnd 1 $ signalT (curveS 2) slideDownT left right
|
||||
where
|
||||
left = drawCircle
|
||||
right = staticFrame 1 (withFillOpacity 1 $ mkBackground "black") `parA`
|
||||
right = staticFrame 1 (mkBackground "black") `parA`
|
||||
mapA (flipXAxis . withStrokeColor "white") drawCircle
|
||||
|
|
|
|||
|
|
@ -11,5 +11,5 @@ main :: IO ()
|
|||
main = reanimate $ docEnv $ pauseAtEnd 1 $ signalT (curveS 2) slideLeftT left right
|
||||
where
|
||||
left = drawCircle
|
||||
right = staticFrame 1 (withFillOpacity 1 $ mkBackground "black") `parA`
|
||||
right = staticFrame 1 (mkBackground "black") `parA`
|
||||
mapA (flipXAxis . withStrokeColor "white") drawCircle
|
||||
|
|
|
|||
|
|
@ -11,5 +11,5 @@ main :: IO ()
|
|||
main = reanimate $ docEnv $ pauseAtEnd 1 $ signalT (curveS 2) slideUpT left right
|
||||
where
|
||||
left = drawCircle
|
||||
right = staticFrame 1 (withFillOpacity 1 $ mkBackground "black") `parA`
|
||||
right = staticFrame 1 (mkBackground "black") `parA`
|
||||
mapA (flipXAxis . withStrokeColor "white") drawCircle
|
||||
|
|
|
|||
|
|
@ -75,11 +75,11 @@ main = reanimate $ scene $ do
|
|||
-- & maskWidth .~ Percent 2
|
||||
-- & maskHeight .~ Percent 2
|
||||
newSpriteSVG_ $
|
||||
FilterTree $ mkFilter ("gooey")
|
||||
FilterTree $ mkFilter "gooey"
|
||||
[ FEGaussianBlur $ defaultSvg
|
||||
& gaussianBlurStdDeviationX .~ Num 0.2
|
||||
& gaussianBlurEdgeMode .~ EdgeNone
|
||||
& filterResult .~ Just "blur"
|
||||
& filterResult ?~ "blur"
|
||||
, FEColorMatrix $ defaultSvg
|
||||
& colorMatrixType .~ Matrix
|
||||
& colorMatrixValues .~
|
||||
|
|
@ -88,7 +88,7 @@ main = reanimate $ scene $ do
|
|||
\0 0 1 0 0 \
|
||||
\0 0 0 19 -10"
|
||||
& colorMatrixIn .~ pure (SourceRef "blur")
|
||||
& filterResult .~ Just "colormatrix"
|
||||
& filterResult ?~ "colormatrix"
|
||||
]
|
||||
newSprite_ $ do
|
||||
t <- spriteT
|
||||
|
|
@ -100,11 +100,11 @@ main = reanimate $ scene $ do
|
|||
[ mkGroup
|
||||
[ whiteGithub
|
||||
, withFillColor "white" $ mkGroup
|
||||
[(translate x y $ mkCircle (r*2))
|
||||
[ translate x y $ mkCircle (r*2)
|
||||
| (ang, offset, len) <- balls
|
||||
, let dir = angle ang
|
||||
r = 1 - (mod' (t/d+offset) 1)
|
||||
V2 x y = dir ^* (screenTop * len * (mod' (t/d+offset) 1)) ]
|
||||
r = 1 - mod' (t/d+offset) 1
|
||||
V2 x y = dir ^* (screenTop * len * mod' (t/d+offset) 1) ]
|
||||
] & filterRef .~ pure (Ref "gooey")
|
||||
, withFillColor "black" $ mkCircle (screenTop*0.99)
|
||||
, whiteGithub
|
||||
|
|
@ -117,15 +117,15 @@ main = reanimate $ scene $ do
|
|||
newSpriteSVG_ $
|
||||
ctx $
|
||||
mkGroup [scale 2 $ mkBackground "white"]
|
||||
& maskRef .~ (pure $ Ref "clip")
|
||||
& maskRef .~ pure (Ref "clip")
|
||||
newSpriteSVG_ $
|
||||
FilterTree $ mkFilter ("blur") $
|
||||
FilterTree $ mkFilter "blur"
|
||||
[ FEGaussianBlur $ defaultSvg
|
||||
& gaussianBlurStdDeviationX .~ Num 0.1
|
||||
& gaussianBlurEdgeMode .~ EdgeNone
|
||||
& filterX .~ pure (Percent 0)
|
||||
& filterY .~ pure (Percent 0)
|
||||
& filterResult .~ Just "blur"
|
||||
& filterResult ?~ "blur"
|
||||
& filterWidth .~ pure (Percent 1)
|
||||
& filterHeight .~ pure (Percent 1)
|
||||
, FETurbulence $ defaultSvg
|
||||
|
|
@ -134,14 +134,14 @@ main = reanimate $ scene $ do
|
|||
& turbulenceNumOctaves .~ 1
|
||||
& turbulenceSeed .~ 1
|
||||
& turbulenceStitchTiles .~ Stitch
|
||||
& filterResult .~ Just "turbulence"
|
||||
& filterResult ?~ "turbulence"
|
||||
, FEDisplacementMap $ defaultSvg
|
||||
& displacementMapScale .~ pure 2
|
||||
& displacementMapIn .~ pure (SourceRef "blur")
|
||||
& displacementMapIn2 .~ pure (SourceRef "turbulence")
|
||||
& displacementMapXChannelSelector .~ ChannelR
|
||||
& displacementMapYChannelSelector .~ ChannelA
|
||||
& filterResult .~ Just "displacementMap"
|
||||
& filterResult ?~ "displacementMap"
|
||||
]
|
||||
|
||||
-- Color wheels:
|
||||
|
|
@ -149,11 +149,11 @@ main = reanimate $ scene $ do
|
|||
fork $ play $ mkAnimation 5 $ \t' ->
|
||||
let t = (t' + offset) `mod'` 1
|
||||
in ctx $ mkGroup
|
||||
[ mkGroup [(rotate (fromToS 0 dst $ curveS 2 $ oscillateS $ t) $
|
||||
[ mkGroup [ rotate (fromToS 0 dst $ curveS 2 $ oscillateS t) $
|
||||
rotate pos $
|
||||
withStrokeColorPixel (promotePixel color) slice)]
|
||||
withStrokeColorPixel (promotePixel color) slice]
|
||||
& filterRef .~ pure (Ref "blur")
|
||||
] & maskRef .~ (pure $ Ref "clip")
|
||||
] & maskRef .~ pure (Ref "clip")
|
||||
wait 5
|
||||
|
||||
slice :: SVG
|
||||
|
|
|
|||
|
|
@ -2,7 +2,6 @@
|
|||
-- stack runghc --package reanimate
|
||||
{-# LANGUAGE ApplicativeDo #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ParallelListComp #-}
|
||||
module Main(main) where
|
||||
|
||||
import Text.Printf
|
||||
|
|
@ -36,7 +35,7 @@ main = reanimate $ scene $ do
|
|||
, mkGroup
|
||||
[ lowerTransformations $ center $ withFillColor "black" $ latex "Text"
|
||||
, mkGroup
|
||||
[rotate (t*rot) $ translate (fromToS 0 3.5 $ bellS 2 $ t) 0 $
|
||||
[rotate (t*rot) $ translate (fromToS 0 3.5 $ bellS 2 t) 0 $
|
||||
withFillColorPixel (promotePixel c) $ mkCircle (size*1.5)
|
||||
| (n,(rot, size)) <- zip [0..] circles
|
||||
, let c = turbo (n/fromIntegral (length circles-1))
|
||||
|
|
@ -48,11 +47,11 @@ main = reanimate $ scene $ do
|
|||
|
||||
mkGooeyFilter :: Double -> SVG
|
||||
mkGooeyFilter blur =
|
||||
FilterTree $ mkFilter ("gooey")
|
||||
FilterTree $ mkFilter "gooey"
|
||||
[ FEGaussianBlur $ defaultSvg
|
||||
& gaussianBlurStdDeviationX .~ Num blur
|
||||
& gaussianBlurEdgeMode .~ EdgeNone
|
||||
& filterResult .~ Just "blur"
|
||||
& filterResult ?~ "blur"
|
||||
, FEColorMatrix $ defaultSvg
|
||||
& colorMatrixType .~ Matrix
|
||||
& colorMatrixValues .~ printf
|
||||
|
|
@ -61,7 +60,7 @@ mkGooeyFilter blur =
|
|||
\0 0 1 0 0 \
|
||||
\0 0 0 %f %f" mul sub
|
||||
& colorMatrixIn .~ pure (SourceRef "blur")
|
||||
& filterResult .~ Just "colormatrix"
|
||||
& filterResult ?~ "colormatrix"
|
||||
]
|
||||
where
|
||||
-- Increase alpha contrast. Turns alphaMin to 0x00 and alphaMax to 0xFF.
|
||||
|
|
|
|||
|
|
@ -33,10 +33,10 @@ main = reanimate $ scene $ do
|
|||
wait 1
|
||||
moveDot (V2 0 1) (V2 4 2)
|
||||
moveDot (V2 (-1) 0) (V2 (-4) 3)
|
||||
moveDot (V2 (0) 0) (V2 (-4) (-3))
|
||||
moveDot (V2 (0) 0) (V2 (5) (-2))
|
||||
moveDot (V2 (6) 2) (V2 2 1)
|
||||
moveDot (V2 (0) 0) (V2 0 0)
|
||||
moveDot (V2 0 0) (V2 (-4) (-3))
|
||||
moveDot (V2 0 0) (V2 5 (-2))
|
||||
moveDot (V2 6 2) (V2 2 1)
|
||||
moveDot (V2 0 0) (V2 0 0)
|
||||
|
||||
redDot :: V2 Double -> SVG
|
||||
redDot (V2 x y) = translate x y $ mkGroup
|
||||
|
|
@ -89,12 +89,12 @@ grid = withStrokeColor "grey" $ withStrokeWidth (defaultStrokeWidth * 0.5) $ mkG
|
|||
[ mkGroup
|
||||
[ translate
|
||||
0
|
||||
(i / (screenHeight) * screenHeight - screenHeight / 2 - screenHeight / 18)
|
||||
(i / screenHeight * screenHeight - screenHeight / 2 - screenHeight / 18)
|
||||
$ mkLine (-screenWidth, 0) (screenWidth, 0)
|
||||
| i <- [0 .. screenHeight]
|
||||
]
|
||||
, mkGroup
|
||||
[ translate (i / (screenWidth) * screenWidth - screenWidth / 2) 0
|
||||
[ translate (i / screenWidth * screenWidth - screenWidth / 2) 0
|
||||
$ mkLine (0, -screenHeight) (0, screenHeight)
|
||||
| i <- [0 .. screenWidth]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -36,10 +36,10 @@ main = reanimate $ mapA squareViewBox $ scene $ do
|
|||
wait 1
|
||||
moveDot (V2 0 1) (V2 2 1)
|
||||
moveDot (V2 (-1) 0) (V2 (-1) 1.5)
|
||||
moveDot (V2 (0) 0) (V2 (-2) (-3))
|
||||
moveDot (V2 (0) 0) (V2 (2.5) (-1))
|
||||
moveDot (V2 (3) 1.5) (V2 1.5 1)
|
||||
moveDot (V2 (0) 0) (V2 0 0)
|
||||
moveDot (V2 0 0) (V2 (-2) (-3))
|
||||
moveDot (V2 0 0) (V2 2.5 (-1))
|
||||
moveDot (V2 3 1.5) (V2 1.5 1)
|
||||
moveDot (V2 0 0) (V2 0 0)
|
||||
|
||||
squareViewBox :: SVG -> SVG
|
||||
squareViewBox = withViewBox (-4, -4, 8, 8)
|
||||
|
|
@ -95,12 +95,12 @@ grid = withStrokeColor "grey" $ withStrokeWidth (defaultStrokeWidth * 0.5) $ mkG
|
|||
[ mkGroup
|
||||
[ translate
|
||||
0
|
||||
(i / (screenHeight) * screenHeight - screenHeight / 2 - screenHeight / 18)
|
||||
(i / screenHeight * screenHeight - screenHeight / 2 - screenHeight / 18)
|
||||
$ mkLine (-screenWidth, 0) (screenWidth, 0)
|
||||
| i <- [0 .. screenHeight]
|
||||
]
|
||||
, mkGroup
|
||||
[ translate (i / (screenWidth) * screenWidth - screenWidth / 2) 0
|
||||
[ translate (i / screenWidth * screenWidth - screenWidth / 2) 0
|
||||
$ mkLine (0, -screenHeight) (0, screenHeight)
|
||||
| i <- [0 .. screenWidth]
|
||||
]
|
||||
|
|
|
|||
|
|
@ -58,4 +58,4 @@ placeBelow a b = do
|
|||
oTopY .~ bBot
|
||||
|
||||
newLaTeX :: [Text] -> Scene s [Object s SVG]
|
||||
newLaTeX chunks = mapM newObject $ map (translate (-4) 0) $ latexChunks chunks
|
||||
newLaTeX chunks = mapM (newObject . translate (-4) 0) $ latexChunks chunks
|
||||
|
|
|
|||
|
|
@ -7,9 +7,9 @@ import Reanimate
|
|||
|
||||
main :: IO ()
|
||||
main = reanimate $
|
||||
bg `parA` (playThenReverseA $ drawText `andThen` fillText)
|
||||
addStatic bg $ playThenReverseA $ drawText `andThen` fillText
|
||||
where
|
||||
bg = animate $ const $ mkBackground "black"
|
||||
bg = mkBackground "black"
|
||||
msg = "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
|
||||
glyphs = withStrokeWidth 0.01 $ center $ latexAlign msg
|
||||
fillText = mkAnimation 1 $ \t ->
|
||||
|
|
|
|||
|
|
@ -10,9 +10,9 @@ import Graphics.SvgTree (Tree)
|
|||
import Reanimate
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ bg `parA` mainScene
|
||||
main = reanimate $ addStatic bg mainScene
|
||||
where
|
||||
bg = animate $ const $ mkBackground "black"
|
||||
bg = mkBackground "black"
|
||||
|
||||
mainScene :: Animation
|
||||
mainScene = scene $ mdo
|
||||
|
|
@ -76,5 +76,5 @@ drawSVG :: Tree -> Animation
|
|||
drawSVG svg = animate $ \t ->
|
||||
withStrokeColor "white" $
|
||||
rotate (t*360) $
|
||||
translate 0 radius $
|
||||
translate 0 radius
|
||||
svg
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ main = reanimate $
|
|||
withStrokeWidth 0 $ translate (-4) 4 $
|
||||
center $ latex "no-op"
|
||||
_ <- newSpriteSVG $
|
||||
withStrokeWidth 0 $ translate (4) 4 $
|
||||
withStrokeWidth 0 $ translate 4 4 $
|
||||
center $ latex "closest"
|
||||
forM_ pairs $ uncurry showPair
|
||||
where
|
||||
|
|
@ -38,7 +38,7 @@ main = reanimate $
|
|||
& mapA (translate (-4) (-0.5))
|
||||
& signalA (curveS 4)
|
||||
fork $ play $ mkAnimation 4 (morph linear from to)
|
||||
& mapA (translate (4) (-0.5))
|
||||
& mapA (translate 4 (-0.5))
|
||||
& signalA (curveS 4)
|
||||
|
||||
pairs = zip stages (tail stages ++ [head stages])
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
#!/usr/bin/env stack
|
||||
-- stack runghc --package reanimate
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ParallelListComp #-}
|
||||
module Main(main) where
|
||||
|
||||
import Codec.Picture
|
||||
|
|
@ -33,5 +32,5 @@ main = reanimate $
|
|||
stage2 = translate 3 0 $ withFillColor "blue" $ mkRect (radius*2) (radius*2)
|
||||
stage3 = mkGroup
|
||||
[translate (-1) (-1) $ withFillColor "green" $ mkRect (radius*0.5) (radius*0.5)
|
||||
,translate 1 (1) $ withFillColor "black" $ mkRect (radius*0.5) (radius*0.5) ]
|
||||
,translate 1 1 $ withFillColor "black" $ mkRect (radius*0.5) (radius*0.5) ]
|
||||
stage4 = translate (-3) 0 $ withFillColor "purple" $ mkCircle (radius*0.24)
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ main = reanimate $
|
|||
showPair (from:to:rest) =
|
||||
waitOn $ do
|
||||
toS <- newSpriteSVG $
|
||||
translate (4) 0 to
|
||||
translate 4 0 to
|
||||
spriteE toS $ overBeginning 0.2 fadeInE
|
||||
spriteE toS $ overEnding 0.2 fadeOutE
|
||||
m <- fork $ newSpriteA $ animate (morph linear from to)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
#!/usr/bin/env stack
|
||||
-- stack runghc --package reanimate
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ParallelListComp #-}
|
||||
module Main(main) where
|
||||
|
||||
import Codec.Picture
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
#!/usr/bin/env stack
|
||||
-- stack runghc --package reanimate
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ParallelListComp #-}
|
||||
module Main(main) where
|
||||
|
||||
import Codec.Picture
|
||||
|
|
@ -45,7 +44,7 @@ main = reanimate $
|
|||
offset <- newVar 0
|
||||
slide <- newVar 0
|
||||
_ <- newSprite $ pl2 <$> unVar offset <*> unVar slide
|
||||
_ <- newSpriteSVG $ pl1
|
||||
_ <- newSpriteSVG pl1
|
||||
let slideLeft = do
|
||||
tweenVar slide 1 $ \v -> fromToS v 1 . curveS 4
|
||||
writeVar slide 0
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ main = reanimate $
|
|||
withStrokeWidth 0 $ translate (-3) 4 $
|
||||
center $ latex "linear"
|
||||
_ <- newSpriteSVG $
|
||||
withStrokeWidth 0 $ translate (3) 4 $
|
||||
withStrokeWidth 0 $ translate 3 4 $
|
||||
center $ latex "rotational"
|
||||
forM_ pairs $ uncurry showPair
|
||||
where
|
||||
|
|
@ -39,7 +39,7 @@ main = reanimate $
|
|||
& mapA (translate (-3) (-0.5))
|
||||
& signalA (curveS 4)
|
||||
fork $ play $ mkAnimation 4 (morph myMorph from to)
|
||||
& mapA (translate (3) (-0.5))
|
||||
& mapA (translate 3 (-0.5))
|
||||
& signalA (curveS 4)
|
||||
myMorph = linear{morphTrajectory = rotationalTrajectory origin }
|
||||
origin = (0.5, 0.5)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,6 @@
|
|||
-- stack runghc --package reanimate
|
||||
{-# LANGUAGE ApplicativeDo #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ParallelListComp #-}
|
||||
module Main(main) where
|
||||
|
||||
import Codec.Picture
|
||||
|
|
@ -48,7 +47,7 @@ main = reanimate $
|
|||
withStrokeWidth 0 $ translate (-4) 4 $
|
||||
center $ latex "linear"
|
||||
_ <- newSpriteSVG $
|
||||
withStrokeWidth 0 $ translate (4) 4 $
|
||||
withStrokeWidth 0 $ translate 4 4 $
|
||||
center $ latex "rotational"
|
||||
originVar <- newVar (0.5, 0.5)
|
||||
|
||||
|
|
@ -79,7 +78,7 @@ main = reanimate $
|
|||
_ <- newSprite $ do
|
||||
origin <- unVar originVar
|
||||
pure $
|
||||
translate (4) (-0.5) $
|
||||
translate 4 (-0.5) $
|
||||
genTrails (map (rotationalTrajectory origin) [(spike1, spike2)])
|
||||
return ()
|
||||
showPair originVar from to =
|
||||
|
|
@ -99,7 +98,7 @@ main = reanimate $
|
|||
originDst = polygonOrigin to origin
|
||||
V2 originX originY = lerp localTime originDst originSrc
|
||||
in
|
||||
translate (4) (-0.5) $ mkGroup
|
||||
translate 4 (-0.5) $ mkGroup
|
||||
[ withFillColor "cyan" $
|
||||
morph myMorph (polygonShape from) (polygonShape to) localTime
|
||||
, withFillColor "red" $ translate originX originY $
|
||||
|
|
@ -108,7 +107,7 @@ main = reanimate $
|
|||
wait 2
|
||||
destroySprite s
|
||||
|
||||
genTrails :: [(Double -> Polygon)] -> SVG
|
||||
genTrails :: [Double -> Polygon] -> SVG
|
||||
genTrails plotters =
|
||||
withFillOpacity 0 $
|
||||
withStrokeWidth (defaultStrokeWidth*0.5) $
|
||||
|
|
|
|||
|
|
@ -6,11 +6,9 @@ import Reanimate
|
|||
import Codec.Picture
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ mkAnimation 5 $ \t ->
|
||||
mkGroup
|
||||
[ mkBackground "black"
|
||||
, rotate (t*360) $ scaleToWidth 6 $ embedImage img
|
||||
]
|
||||
main = reanimate $ addStatic bg $ mkAnimation 5 $ \t ->
|
||||
rotate (t*360) $ scaleToWidth 6 $ embedImage img
|
||||
where
|
||||
bg = mkBackground "black"
|
||||
img = generateImage pixelRenderer 255 255
|
||||
pixelRenderer x y = PixelRGB8 (fromIntegral x) (fromIntegral y) 128
|
||||
|
|
|
|||
|
|
@ -135,7 +135,7 @@ mergeSortUp = do
|
|||
snapshot
|
||||
len <- inputLength
|
||||
let chunkSizes = takeWhile (< len) $ map (2^) [0::Int ..]
|
||||
forM_ chunkSizes $ bottomUpMergeSort'
|
||||
forM_ chunkSizes bottomUpMergeSort'
|
||||
|
||||
bottomUpMergeSort' :: Int -> S s ()
|
||||
bottomUpMergeSort' chunkSize = do
|
||||
|
|
@ -215,7 +215,7 @@ quicksort = do
|
|||
pivot <- readS (lo + (hi-lo) `div` 2)
|
||||
p <- partition pivot lo hi
|
||||
snapshot
|
||||
worker $ insertWork (lo, p) $ insertWork (p+1, hi) $ rest
|
||||
worker $ insertWork (lo, p) $ insertWork (p+1, hi) rest
|
||||
|
||||
partition pivot lo hi = do
|
||||
loVal <- readS lo
|
||||
|
|
|
|||
|
|
@ -19,13 +19,13 @@ transitionTime :: Double
|
|||
transitionTime = 0.5
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ bg `parA`
|
||||
main = reanimate $ addStatic bg $
|
||||
chainT transition
|
||||
[animateCircleR, animateCircleP, animateRectR, animateColor
|
||||
,signalA (constantS 0) $ setDuration transitionTime animateCircleR]
|
||||
where
|
||||
transition = overlapT transitionTime fadeT
|
||||
bg = animate $ const $ mkBackgroundPixel bgColor
|
||||
bg = mkBackgroundPixel bgColor
|
||||
|
||||
animateCircleR :: Animation
|
||||
animateCircleR = mkSegment "radius" $ \t -> mkCircle (t*2)
|
||||
|
|
|
|||
|
|
@ -172,8 +172,7 @@ checker w h =
|
|||
withStrokeColor "lightgrey" $
|
||||
withStrokeWidth (defaultStrokeWidth/2) $
|
||||
mkGroup
|
||||
[ withStrokeWidth 0 $
|
||||
withFillOpacity 1 $ mkBackground "darkgrey"
|
||||
[ mkBackground "darkgrey"
|
||||
, mkGroup
|
||||
[ translate (stepX*x-offsetX + stepX/2) 0 $
|
||||
mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9)
|
||||
|
|
@ -207,11 +206,11 @@ latexExample = scene $ do
|
|||
newSpriteSVG $ fn elt
|
||||
-- Yoink each glyph
|
||||
forM_ (reverse sprites) $ \sprite -> do
|
||||
spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE)
|
||||
spriteE sprite (overBeginning 1 $ aroundCenterE highlightE)
|
||||
wait 0.5
|
||||
-- Flash glyphs randomly with color
|
||||
forM_ (shuffleList (sprites++sprites)) $ \sprite -> do
|
||||
spriteE sprite (overBeginning 0.5 $ aroundCenterE $ flashE)
|
||||
spriteE sprite (overBeginning 0.5 $ aroundCenterE flashE)
|
||||
wait 0.1
|
||||
wait 0.5
|
||||
mapM_ destroySprite sprites
|
||||
|
|
@ -258,7 +257,7 @@ drawAnimation' mbSeed fillDur step svg = scene $ do
|
|||
_ -> defaultStrokeWidth
|
||||
fork $ do
|
||||
wait (n*step)
|
||||
play $ mapA fn $ (animate (\t -> withFillOpacity 0 $ partialSvg t tree)
|
||||
play $ mapA fn (animate (\t -> withFillOpacity 0 $ partialSvg t tree)
|
||||
& applyE (overEnding fillDur $ fadeLineOutE sWidth))
|
||||
fork $ do
|
||||
wait (n*step+(1-fillDur))
|
||||
|
|
|
|||
|
|
@ -16,9 +16,9 @@ import Graphics.SvgTree (Tree)
|
|||
import Reanimate
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ bg `parA` mainScene
|
||||
main = reanimate $ addStatic bg mainScene
|
||||
where
|
||||
bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)
|
||||
bg = mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)
|
||||
|
||||
mainScene :: Animation
|
||||
mainScene = scene $ mdo
|
||||
|
|
@ -84,5 +84,5 @@ drawSVG :: Tree -> Animation
|
|||
drawSVG svg = animate $ \t ->
|
||||
withStrokeColor "black" $
|
||||
rotate (t*360) $
|
||||
translate 0 radius $
|
||||
translate 0 radius
|
||||
svg
|
||||
|
|
|
|||
|
|
@ -17,9 +17,9 @@ import System.Random
|
|||
import "random-shuffle" System.Random.Shuffle
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ parA bg latexExample
|
||||
main = reanimate $ addStatic bg latexExample
|
||||
where
|
||||
bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)
|
||||
bg = mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)
|
||||
|
||||
latexExample :: Animation
|
||||
latexExample = scene $ do
|
||||
|
|
@ -29,11 +29,11 @@ latexExample = scene $ do
|
|||
newSpriteSVG $ fn elt
|
||||
-- Yoink each glyph
|
||||
forM_ (reverse sprites) $ \sprite -> do
|
||||
spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE)
|
||||
spriteE sprite (overBeginning 1 $ aroundCenterE highlightE)
|
||||
wait 0.5
|
||||
-- Flash glyphs randomly with color
|
||||
forM_ (shuffleList (sprites++sprites)) $ \sprite -> do
|
||||
spriteE sprite (overBeginning 0.5 $ aroundCenterE $ flashE)
|
||||
spriteE sprite (overBeginning 0.5 $ aroundCenterE flashE)
|
||||
wait 0.1
|
||||
wait 0.5
|
||||
mapM_ destroySprite sprites
|
||||
|
|
@ -80,7 +80,7 @@ drawAnimation' mbSeed fillDur step svg = scene $ do
|
|||
_ -> defaultStrokeWidth
|
||||
fork $ do
|
||||
wait (n*step)
|
||||
play $ mapA fn $ (animate (\t -> withFillOpacity 0 $ partialSvg t tree)
|
||||
play $ mapA fn (animate (\t -> withFillOpacity 0 $ partialSvg t tree)
|
||||
& applyE (overEnding fillDur $ fadeLineOutE sWidth))
|
||||
fork $ do
|
||||
wait (n*step+(1-fillDur))
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ import qualified Data.Text as T
|
|||
import NeatInterpolation
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ parA bg $ scene $ do
|
||||
main = reanimate $ addStatic bg $ scene $ do
|
||||
play $ mkAnimation drawDuration $ \t -> partialSvg t (wireframe (-45) 220)
|
||||
xRot <- newVar (-45)
|
||||
yRot <- newVar 220
|
||||
|
|
@ -32,7 +32,7 @@ main = reanimate $ parA bg $ scene $ do
|
|||
wobbles = 3
|
||||
wobbleDur = 3
|
||||
spinDur = fromIntegral wobbles * wobbleDur
|
||||
bg = animate $ const $ mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF
|
||||
bg = mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF
|
||||
|
||||
wireframe :: Double -> Double -> SVG
|
||||
wireframe rotX rotY =
|
||||
|
|
|
|||
|
|
@ -100,11 +100,11 @@ latexExample = scene $ do
|
|||
newSpriteSVG $ fn elt
|
||||
-- Yoink each glyph
|
||||
forM_ (reverse sprites) $ \sprite -> do
|
||||
spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE)
|
||||
spriteE sprite (overBeginning 1 $ aroundCenterE highlightE)
|
||||
wait 0.5
|
||||
-- Flash glyphs randomly with color
|
||||
forM_ (shuffleList (sprites++sprites)) $ \sprite -> do
|
||||
spriteE sprite (overBeginning 0.5 $ aroundCenterE $ flashE)
|
||||
spriteE sprite (overBeginning 0.5 $ aroundCenterE flashE)
|
||||
wait 0.1
|
||||
wait 0.5
|
||||
mapM_ destroySprite sprites
|
||||
|
|
@ -151,7 +151,7 @@ drawAnimation' mbSeed fillDur step svg = scene $ do
|
|||
_ -> defaultStrokeWidth
|
||||
fork $ do
|
||||
wait (n*step)
|
||||
play $ mapA fn $ (animate (\t -> withFillOpacity 0 $ partialSvg t tree)
|
||||
play $ mapA fn (animate (\t -> withFillOpacity 0 $ partialSvg t tree)
|
||||
& applyE (overEnding fillDur $ fadeLineOutE sWidth))
|
||||
fork $ do
|
||||
wait (n*step+(1-fillDur))
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ import "random-shuffle" System.Random.Shuffle
|
|||
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ parA bg $ scene $ do
|
||||
main = reanimate $ addStatic bg $ scene $ do
|
||||
xRot <- newVar (-30)
|
||||
yRot <- newVar 180
|
||||
zRot <- newVar 0
|
||||
|
|
@ -46,7 +46,7 @@ main = reanimate $ parA bg $ scene $ do
|
|||
wait tDuration
|
||||
wait 2
|
||||
where
|
||||
bg = animate $ const $ mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF
|
||||
bg = mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF
|
||||
|
||||
texture :: Double -> SVG
|
||||
texture t = mkGroup
|
||||
|
|
@ -103,8 +103,7 @@ checker w h =
|
|||
withStrokeColor "lightblue" $
|
||||
withStrokeWidth (defaultStrokeWidth/2) $
|
||||
mkGroup
|
||||
[ withStrokeWidth 0 $
|
||||
withFillOpacity 0.8 $ mkBackground "white"
|
||||
[ withFillOpacity 0.8 $ mkBackground "white"
|
||||
, mkGroup
|
||||
[ translate (stepX*x-offsetX + stepX/2) 0 $
|
||||
mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9)
|
||||
|
|
@ -138,11 +137,11 @@ latexExample = scene $ do
|
|||
newSpriteSVG $ fn elt
|
||||
-- Yoink each glyph
|
||||
forM_ (reverse sprites) $ \sprite -> do
|
||||
spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE)
|
||||
spriteE sprite (overBeginning 1 $ aroundCenterE highlightE)
|
||||
wait 0.5
|
||||
-- Flash glyphs randomly with color
|
||||
forM_ (shuffleList (sprites++sprites)) $ \sprite -> do
|
||||
spriteE sprite (overBeginning 0.5 $ aroundCenterE $ flashE)
|
||||
spriteE sprite (overBeginning 0.5 $ aroundCenterE flashE)
|
||||
wait 0.1
|
||||
wait 0.5
|
||||
mapM_ destroySprite sprites
|
||||
|
|
@ -189,7 +188,7 @@ drawAnimation' mbSeed fillDur step svg = scene $ do
|
|||
_ -> defaultStrokeWidth
|
||||
fork $ do
|
||||
wait (n*step)
|
||||
play $ mapA fn $ (animate (\t -> withFillOpacity 0 $ partialSvg t tree)
|
||||
play $ mapA fn (animate (\t -> withFillOpacity 0 $ partialSvg t tree)
|
||||
& applyE (overEnding fillDur $ fadeLineOutE sWidth))
|
||||
fork $ do
|
||||
wait (n*step+(1-fillDur))
|
||||
|
|
|
|||
|
|
@ -22,10 +22,10 @@ transitionTime :: Double
|
|||
transitionTime = 0.5
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ bg `parA` chainT (overlapT transitionTime fadeT)
|
||||
main = reanimate $ addStatic bg $ chainT (overlapT transitionTime fadeT)
|
||||
[comp1, comp2, comp3, comp4, comp5, comp6, comp7, setDuration transitionTime comp1]
|
||||
where
|
||||
bg = animate $ const $ mkBackgroundPixel bgColor
|
||||
bg = mkBackgroundPixel bgColor
|
||||
comp1 = svgComponent "Circles" (mkCircle 2)
|
||||
comp2 = svgComponent "Rects" (mkRect 4 3)
|
||||
comp3 = svgComponent "Lines" (mkLine (-2,0) (2,0))
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Animation where
|
||||
import Reanimate
|
||||
import Reanimate.Builtin.Documentation
|
||||
|
|
|
|||
|
|
@ -19,12 +19,12 @@ drawLatex txt = do
|
|||
-- Fade outline
|
||||
play $ animate $ \t ->
|
||||
withFillOpacity 0 $
|
||||
withStrokeWidth (defaultStrokeWidth*(1-t)) $
|
||||
withStrokeWidth (defaultStrokeWidth*(1-t))
|
||||
svg
|
||||
wait 0.7
|
||||
-- Fill in letters
|
||||
play $ animate $ \t ->
|
||||
withFillOpacity t $ withStrokeWidth 0 $
|
||||
withFillOpacity t $ withStrokeWidth 0
|
||||
svg
|
||||
-- Hold static image and then fade out
|
||||
play $ staticFrame 2 (withStrokeWidth 0 svg)
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ label txt =
|
|||
scale 0.7 $
|
||||
center $
|
||||
withStrokeWidth 0 $
|
||||
withFillOpacity 1 $
|
||||
withFillOpacity 1
|
||||
svg
|
||||
where
|
||||
svg = latex txt
|
||||
|
|
|
|||
|
|
@ -270,7 +270,7 @@ newBackend = do
|
|||
now <- getCurrentTime
|
||||
emptyQueue <- isEmptyMVar queue
|
||||
let timeLimit = if emptyQueue then totalTimeLimitLong else totalTimeLimitShort
|
||||
if (diffUTCTime now startTime < timeLimit)
|
||||
if diffUTCTime now startTime < timeLimit
|
||||
then action
|
||||
else do
|
||||
renderWarning req "Render timed out"
|
||||
|
|
|
|||
|
|
@ -24,12 +24,12 @@ main = reanimate $
|
|||
mapA (withStrokeColor "black") $
|
||||
mapA (withStrokeLineJoin JoinRound) $
|
||||
mapA (withFillOpacity 1) $
|
||||
sceneAnimation $ do
|
||||
scene $ do
|
||||
_ <- newSpriteSVG $
|
||||
withStrokeWidth 0 $ translate (-3) 4 $
|
||||
center $ latex "linear"
|
||||
_ <- newSpriteSVG $
|
||||
withStrokeWidth 0 $ translate (3) 4 $
|
||||
withStrokeWidth 0 $ translate 3 4 $
|
||||
center $ latex "least-work"
|
||||
forM_ pairs $ uncurry showPair
|
||||
where
|
||||
|
|
@ -39,7 +39,7 @@ main = reanimate $
|
|||
& mapA (translate (-3) (-0.5))
|
||||
& signalA (curveS 4)
|
||||
fork $ play $ mkAnimation 4 (morph myMorph from to)
|
||||
& mapA (translate (3) (-0.5))
|
||||
& mapA (translate 3 (-0.5))
|
||||
& signalA (curveS 4)
|
||||
|
||||
stretchCosts = defaultStretchCosts
|
||||
|
|
|
|||
|
|
@ -24,12 +24,12 @@ main = reanimate $
|
|||
mapA (withStrokeColor "black") $
|
||||
mapA (withStrokeLineJoin JoinRound) $
|
||||
mapA (withFillOpacity 1) $
|
||||
sceneAnimation $ do
|
||||
scene $ do
|
||||
_ <- newSpriteSVG $
|
||||
withStrokeWidth 0 $ translate (-3) 4 $
|
||||
center $ latex "linear"
|
||||
_ <- newSpriteSVG $
|
||||
withStrokeWidth 0 $ translate (3) 4 $
|
||||
withStrokeWidth 0 $ translate 3 4 $
|
||||
center $ latex "line bend"
|
||||
forM_ pairs $ uncurry showPair
|
||||
where
|
||||
|
|
@ -39,7 +39,7 @@ main = reanimate $
|
|||
& mapA (translate (-3) (-0.5))
|
||||
& signalA (curveS 4)
|
||||
fork $ play $ mkAnimation 4 (morph myMorph from to)
|
||||
& mapA (translate (3) (-0.5))
|
||||
& mapA (translate 3 (-0.5))
|
||||
& signalA (curveS 4)
|
||||
|
||||
myMorph = linear{morphTrajectory = lineBend }
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
#!/usr/bin/env stack
|
||||
-- stack runghc --package reanimate
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ParallelListComp #-}
|
||||
module Main(main) where
|
||||
|
||||
import Codec.Picture
|
||||
|
|
@ -47,12 +46,12 @@ main = reanimate $
|
|||
mapA (withStrokeColor "black") $
|
||||
mapA (withStrokeLineJoin JoinRound) $
|
||||
mapA (withFillOpacity 1) $
|
||||
sceneAnimation $ do
|
||||
scene $ do
|
||||
_ <- newSpriteSVG $
|
||||
withStrokeWidth 0 $ translate (-4) 4 $
|
||||
center $ latex "linear"
|
||||
_ <- newSpriteSVG $
|
||||
withStrokeWidth 0 $ translate (4) 4 $
|
||||
withStrokeWidth 0 $ translate 4 4 $
|
||||
center $ latex "line bend"
|
||||
showTrails
|
||||
forM_ pairs $ uncurry showPair
|
||||
|
|
@ -62,7 +61,7 @@ main = reanimate $
|
|||
translate (-4) (-0.5) $
|
||||
genTrails (map linearTrajectory pairs)
|
||||
_ <- newSpriteSVG $
|
||||
translate (4) (-0.5) $
|
||||
translate 4 (-0.5) $
|
||||
genTrails (map lineBend pairs)
|
||||
return ()
|
||||
showPair from to =
|
||||
|
|
@ -72,7 +71,7 @@ main = reanimate $
|
|||
& mapA (withFillColor "lightgreen")
|
||||
& signalA (curveS 4)
|
||||
fork $ play $ mkAnimation 4 (morph myMorph (polygonShape from) (polygonShape to))
|
||||
& mapA (translate (4) (-0.5))
|
||||
& mapA (translate 4 (-0.5))
|
||||
& mapA (withFillColor "cyan")
|
||||
& signalA (curveS 4)
|
||||
myMorph = linear{morphTrajectory = lineBend }
|
||||
|
|
@ -83,7 +82,7 @@ main = reanimate $
|
|||
, spike3
|
||||
]
|
||||
|
||||
genTrails :: [(Double -> Polygon)] -> SVG
|
||||
genTrails :: [Double -> Polygon] -> SVG
|
||||
genTrails plotters =
|
||||
withFillOpacity 0 $
|
||||
withStrokeWidth (defaultStrokeWidth*0.5) $
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Reanimate.Math.Compatible where
|
||||
|
||||
|
|
@ -285,14 +284,14 @@ showSolution _a _b (_nodeL, _nodeR) = mkGroup []
|
|||
-- -- mkCircle 0.05
|
||||
-- , withFillColor "white" $ latex $ T.pack $ show (nodeL, nodeR)
|
||||
-- ]
|
||||
where
|
||||
--where
|
||||
-- V2 xA yA = realToFrac <$> steiner2Link a nodeL nodeR
|
||||
-- V2 xB yB = steiner2Link b nodeL nodeR
|
||||
|
||||
compatiblyTriangulateP' :: (Real a, Fractional a) => APolygon a -> APolygon a -> APolygon a -> [(APolygon a, APolygon a)]
|
||||
compatiblyTriangulateP' aOrigin a b
|
||||
-- | trace (show (pSize a, pSize b)) False = undefined
|
||||
| n == 3 = traceSVG (showStep a b) $ {- trace ("Done") $ -} [(a, b)]
|
||||
| n == 3 = traceSVG (showStep a b) {- trace ("Done") $ -} [(a, b)]
|
||||
| otherwise =
|
||||
-- trace ("PolygonA " ++ show a) $
|
||||
-- trace ("PolygonB " ++ show b) $
|
||||
|
|
@ -305,7 +304,7 @@ compatiblyTriangulateP' aOrigin a b
|
|||
-- trace ("bestTwoLink: " ++ show bestTwoLink) $
|
||||
traceSVG (showStep a b) $ case bestOneLink of
|
||||
Nothing -> case bestTwoLink of
|
||||
Nothing -> error $ "no 2-links"
|
||||
Nothing -> error "no 2-links"
|
||||
Just (nodeL, nodeR) -> --trace ("Creating steiner node: " ++ show (nodeL, nodeR)) $
|
||||
let isTwolink =
|
||||
(nodeL, nodeR) `notElem` aOneLink ||
|
||||
|
|
@ -316,7 +315,7 @@ compatiblyTriangulateP' aOrigin a b
|
|||
(bL, bR) = if (nodeL, nodeR) `elem` bOneLink
|
||||
then split1Link b nodeL nodeR 1
|
||||
else split2Link b nodeL nodeR
|
||||
in (if isTwolink then traceSVG (showSolution a b (nodeL, nodeR)) else id) $
|
||||
in (if isTwolink then traceSVG (showSolution a b (nodeL, nodeR)) else id)
|
||||
(compatiblyTriangulateP' aOrigin aL bL
|
||||
++ compatiblyTriangulateP' aOrigin aR bR
|
||||
)
|
||||
|
|
@ -355,7 +354,7 @@ oneBendBetween p a b =
|
|||
(pAccess p a)
|
||||
(pAccess p (pParent p a b))
|
||||
(pAccess p b)) < epsilon
|
||||
where
|
||||
--where
|
||||
-- obstructedBy n =
|
||||
-- case pParent p a n of
|
||||
-- i -> if i == a then n else obstructedBy i
|
||||
|
|
|
|||
|
|
@ -263,7 +263,7 @@ getVertex position = do
|
|||
case L.find comparingPosition (M.assocs vs) of
|
||||
Nothing -> createVertex position
|
||||
Just (k, _) -> return k
|
||||
where comparingPosition (_k, v) = (_vertexPosition v) == position
|
||||
where comparingPosition (_k, v) = _vertexPosition v == position
|
||||
|
||||
requireVertex :: VertexId -> MeshM a (Vertex a)
|
||||
requireVertex vid = do
|
||||
|
|
@ -280,7 +280,7 @@ getEdge e = do
|
|||
edges <- gets _meshEdges
|
||||
maybe (bug edges) return $ M.lookup e edges
|
||||
--return $ fromJust $ M.lookup e edges
|
||||
where bug _edges = error $ "Can't find edge with id " ++ (show e)
|
||||
where bug _edges = error $ "Can't find edge with id " ++ show e
|
||||
|
||||
withEdge :: EdgeId -> (Edge -> State (Mesh a) ()) -> State (Mesh a) ()
|
||||
withEdge e f = f =<< getEdge e
|
||||
|
|
@ -360,7 +360,7 @@ getFace :: FaceId -> State (Mesh a) Face
|
|||
getFace f = do
|
||||
faces <- gets _meshFaces
|
||||
maybe bug return (M.lookup f faces)
|
||||
where bug = error $ "Can't find face with id " ++ (show f)
|
||||
where bug = error $ "Can't find face with id " ++ show f
|
||||
|
||||
|
||||
buildMesh :: State (Mesh a) b -> Mesh a
|
||||
|
|
@ -561,7 +561,7 @@ smoothVertex steiner = do
|
|||
let ps = V.fromList (map _vertexPosition vs')
|
||||
vs' = sortVertices self vs
|
||||
angleBased = angleSmooth self ps
|
||||
laplacian = sum ps ^/ (fromIntegral $ length ps) -- laplacian
|
||||
laplacian = sum ps ^/ fromIntegral (length ps) -- laplacian
|
||||
-- trace ("self: " ++ show self) $ return ()
|
||||
-- trace ("angleBased: " ++ show angleBased) $ return ()
|
||||
-- trace ("Edges: " ++ show (map _vertexId vs')) $ return ()
|
||||
|
|
@ -585,7 +585,7 @@ smoothVertex steiner = do
|
|||
sortVertices self = sortOn (dirV self)
|
||||
-- Direction from south of 'a', to 'a', to 'b'.
|
||||
dir :: V2 Double -> V2 Double -> Double
|
||||
dir a b = (atan2 (crossZ (V2 0 1) (b - a)) (dot (V2 0 1) (b - a)))
|
||||
dir a b = atan2 (crossZ (V2 0 1) (b - a)) (dot (V2 0 1) (b - a))
|
||||
dirV :: V2 Double -> Vertex (V2 Double) -> Double
|
||||
dirV a v = dir a (_vertexPosition v)
|
||||
|
||||
|
|
@ -631,7 +631,7 @@ isValidLocation origin edges newLoc =
|
|||
< minAngle newLoc edges
|
||||
where
|
||||
dir :: V2 Double -> V2 Double -> Double
|
||||
dir a b = (atan2 (crossZ (V2 0 1) (b - a)) (dot (V2 0 1) (b - a)))
|
||||
dir a b = atan2 (crossZ (V2 0 1) (b - a)) (dot (V2 0 1) (b - a))
|
||||
|
||||
isCCW :: (Ord a, Num a) => V2 a -> V2 a -> V2 a -> Bool
|
||||
isCCW a b c = sum [fn a b, fn b c, fn c a] < 0
|
||||
|
|
@ -732,7 +732,7 @@ splitInternalEdges :: Mesh (V2 Double) -> Mesh (V2 Double) -> (Mesh (V2 Double),
|
|||
splitInternalEdges = applyCompatible splitInternalEdge internalEdges
|
||||
|
||||
splitInternalEdge :: EdgeId -> Mesh (V2 Double) -> Maybe (Mesh (V2 Double))
|
||||
splitInternalEdge eid m = evalState worker m
|
||||
splitInternalEdge eid = evalState worker
|
||||
where
|
||||
edgeFaces edge = do
|
||||
twin <- getEdge (edge^.edgeTwin)
|
||||
|
|
@ -753,8 +753,7 @@ splitInternalEdge eid m = evalState worker m
|
|||
, faceMinAngle f4 mAfter
|
||||
, faceMinAngle f5 mAfter
|
||||
, faceMinAngle f6 mAfter ]
|
||||
return ()
|
||||
if (afterAng < beforeAng)
|
||||
if afterAng < beforeAng
|
||||
then return Nothing
|
||||
else return (Just mAfter)
|
||||
|
||||
|
|
@ -765,7 +764,7 @@ splitLongestEdge m1 m2 =
|
|||
longest = longestEdge m1 m2
|
||||
|
||||
splitInternalEdgeForced :: EdgeId -> Mesh (V2 Double) -> Mesh (V2 Double)
|
||||
splitInternalEdgeForced eid m = execState worker m
|
||||
splitInternalEdgeForced eid = execState worker
|
||||
where
|
||||
worker = do
|
||||
edge <- getEdge eid
|
||||
|
|
@ -779,7 +778,7 @@ splitOuterEdges :: Mesh (V2 Double) -> Mesh (V2 Double) -> (Mesh (V2 Double), Me
|
|||
splitOuterEdges = applyCompatible splitOuterEdge outerEdges
|
||||
|
||||
splitOuterEdge :: EdgeId -> Mesh (V2 Double) -> Maybe (Mesh (V2 Double))
|
||||
splitOuterEdge eid m = evalState worker m
|
||||
splitOuterEdge eid = evalState worker
|
||||
where
|
||||
worker = do
|
||||
edge <- getEdge eid
|
||||
|
|
@ -795,7 +794,7 @@ splitOuterEdge eid m = evalState worker m
|
|||
let afterAng = minimum
|
||||
[ faceMinAngle f2 mAfter
|
||||
, faceMinAngle f3 mAfter ]
|
||||
if (afterAng < beforeAng)
|
||||
if afterAng < beforeAng
|
||||
then return Nothing
|
||||
else return (Just mAfter)
|
||||
|
||||
|
|
@ -880,5 +879,5 @@ renderMeshStats mesh = mkGroup
|
|||
angs = meshAngles mesh
|
||||
minAng = minimum angs
|
||||
meanAngle = L.sort angs !! (length angs `div` 2)
|
||||
avgAngle = sum angs / (fromIntegral $ length angs)
|
||||
avgAngle = sum angs / fromIntegral (length angs)
|
||||
maxAngle = maximum angs
|
||||
|
|
|
|||
|
|
@ -59,7 +59,7 @@ type Edge a = (V2 a, V2 a)
|
|||
data Topology = MutableSegment | ImmutableSegment Int
|
||||
deriving (Eq, Show)
|
||||
|
||||
{- INLINE pTopology -}
|
||||
{-# INLINE pTopology #-}
|
||||
pTopology :: Eq a => [Edge a] -> APolygon a -> [Topology]
|
||||
pTopology immutableEdges p = worker
|
||||
[ maybe MutableSegment ImmutableSegment isImmutable
|
||||
|
|
|
|||
|
|
@ -260,9 +260,9 @@ leastWork'' stretchCosts bendCosts src dst srcV dstV srcDist dstDist = runST $ d
|
|||
when cond $ do
|
||||
unsafeIOToST $ hPutStrLn stderr $ "West: " ++ show (i-1-prevWest, i-1, i)
|
||||
unsafeIOToST $ hPutStrLn stderr $ "West: " ++ show (j-prevNorth, j, j)
|
||||
unsafeIOToST $ hPutStrLn stderr $ "bWork: " ++ show (bWork)
|
||||
unsafeIOToST $ hPutStrLn stderr $ "len: " ++ show (len)
|
||||
unsafeIOToST $ hPutStrLn stderr $ "sWork: " ++ show (sWork)
|
||||
unsafeIOToST $ hPutStrLn stderr $ "bWork: " ++ show bWork
|
||||
unsafeIOToST $ hPutStrLn stderr $ "len: " ++ show len
|
||||
unsafeIOToST $ hPutStrLn stderr $ "sWork: " ++ show sWork
|
||||
return (prevWork + sWork + bWork + if prevWest==0&&prevNorth==1 then 10000 else 0)
|
||||
w1 <- if j==0 then return 0 else do
|
||||
prevWork <- readArray work (i,j-1)
|
||||
|
|
@ -294,9 +294,9 @@ leastWork'' stretchCosts bendCosts src dst srcV dstV srcDist dstDist = runST $ d
|
|||
when cond $ do
|
||||
unsafeIOToST $ hPutStrLn stderr $ "North: " ++ show (i-prevWest, i, i)
|
||||
unsafeIOToST $ hPutStrLn stderr $ "North: " ++ show (j-1-prevNorth, j-1, j)
|
||||
unsafeIOToST $ hPutStrLn stderr $ "bWork: " ++ show (bWork)
|
||||
unsafeIOToST $ hPutStrLn stderr $ "len: " ++ show (len)
|
||||
unsafeIOToST $ hPutStrLn stderr $ "sWork: " ++ show (sWork)
|
||||
unsafeIOToST $ hPutStrLn stderr $ "bWork: " ++ show bWork
|
||||
unsafeIOToST $ hPutStrLn stderr $ "len: " ++ show len
|
||||
unsafeIOToST $ hPutStrLn stderr $ "sWork: " ++ show sWork
|
||||
return (prevWork + sWork + bWork + if prevWest==1&&prevNorth==0 then 10000 else 0)
|
||||
w2 <- if j==0 || i==0 then return 0 else do
|
||||
prevWork <- readArray work (i-1,j-1)
|
||||
|
|
@ -333,7 +333,7 @@ leastWork'' stretchCosts bendCosts src dst srcV dstV srcDist dstDist = runST $ d
|
|||
when cond $ do
|
||||
unsafeIOToST $ hPutStrLn stderr $ "Diag: " ++ show (i-1-prevWest, i-1, i)
|
||||
unsafeIOToST $ hPutStrLn stderr $ "Diag: " ++ show (j-1-prevNorth, j-1, j)
|
||||
unsafeIOToST $ hPutStrLn stderr $ "bWork: " ++ show (bWork)
|
||||
unsafeIOToST $ hPutStrLn stderr $ "bWork: " ++ show bWork
|
||||
-- unsafeIOToST $ hPutStrLn stderr $ "bWork': " ++ show (bWork')
|
||||
return (prevWork + sWork + bWork)
|
||||
let goNorth = do
|
||||
|
|
@ -389,7 +389,7 @@ leastWork'' stretchCosts bendCosts src dst srcV dstV srcDist dstDist = runST $ d
|
|||
-- when (i==14) $
|
||||
-- unsafeIOToST $ hPrint stderr (i,j)
|
||||
let acc' = (i,j):acc
|
||||
if (i==0 && j==0)
|
||||
if i==0 && j==0
|
||||
then return acc'
|
||||
else do
|
||||
isNorth <- (==1) <$> readArray north (i,j)
|
||||
|
|
|
|||
|
|
@ -60,12 +60,12 @@ import Reanimate.Svg
|
|||
-- ]
|
||||
|
||||
-- drawCompatible :: Polygon -> Polygon -> Animation
|
||||
-- drawCompatible a b = sceneAnimation $ do
|
||||
-- drawCompatible a b = scene $ do
|
||||
-- newSpriteSVG $ translate (-3) 0 $ mkGroup
|
||||
-- [ withFillColor "grey" $ polygonShape a
|
||||
-- , withFillColor "grey" $ polygonNumDots a
|
||||
-- ]
|
||||
-- newSpriteSVG $ translate (3) 0 $ mkGroup
|
||||
-- newSpriteSVG $ translate 3 0 $ mkGroup
|
||||
-- [ withFillColor "grey" $ polygonShape b
|
||||
-- , withFillColor "grey" $ polygonNumDots b
|
||||
-- ]
|
||||
|
|
@ -75,7 +75,7 @@ import Reanimate.Svg
|
|||
-- translate (-3) 0 $ withStrokeColor "white" $ withStrokeWidth (defaultStrokeWidth*0.2) $
|
||||
-- withFillOpacity 0 $ polygonShape l
|
||||
-- fork $ play $ staticFrame 1 $
|
||||
-- translate (3) 0 $ withStrokeColor "white" $ withStrokeWidth (defaultStrokeWidth*0.2) $
|
||||
-- translate 3 0 $ withStrokeColor "white" $ withStrokeWidth (defaultStrokeWidth*0.2) $
|
||||
-- withFillOpacity 0 $ polygonShape r
|
||||
|
||||
-- drawWindow :: Polygon -> SVG
|
||||
|
|
@ -187,7 +187,7 @@ renderSSSP p s = withFillOpacity 0 $ withStrokeColor "white" $ mkGroup
|
|||
in (ax,ay) : if next == i then [] else lineFrom next
|
||||
|
||||
drawTriangulation :: Polygon -> (Ring Rational -> [Triangulation]) -> Animation
|
||||
drawTriangulation p gen = sceneAnimation $
|
||||
drawTriangulation p gen = scene $
|
||||
forM_ (gen $ pRing p) $ \t -> play $ staticFrame 1 $ renderTriangulation p t
|
||||
|
||||
renderTriangulation :: Polygon -> Triangulation -> SVG
|
||||
|
|
|
|||
|
|
@ -62,7 +62,7 @@ renderAMesh m = mkGroup
|
|||
[pA V.! a, pA V.! b, pA V.! c]
|
||||
| (a, b, c) <- V.toList (meshTriangles m)
|
||||
]
|
||||
, translate (1.5) 0 $ renderMesh
|
||||
, translate 1.5 0 $ renderMesh
|
||||
(mkPolygon outlineB)
|
||||
[ mkPolygon $ V.fromList $ map (fmap realToFrac)
|
||||
[pB V.! a, pB V.! b, pB V.! c]
|
||||
|
|
@ -135,7 +135,7 @@ smoothStep triangulation pts steiner =
|
|||
pt <- MV.read pts i
|
||||
edges <- V.fromList <$> (sortEdges pt =<< MV.read triangulation i)
|
||||
let angleBased = angleSmooth pt edges
|
||||
laplacian = sum edges ^/ (fromIntegral $ length edges) -- laplacian
|
||||
laplacian = sum edges ^/ fromIntegral (length edges) -- laplacian
|
||||
-- unsafeIOToST $ hPrint stderr (pt, edges, newX)
|
||||
if isValidLocation pt edges angleBased
|
||||
then MV.write pts i angleBased
|
||||
|
|
@ -149,7 +149,7 @@ smoothStep triangulation pts steiner =
|
|||
return $ sortOn (dir pt) edgePoints
|
||||
-- Direction from south of 'a', to 'a', to 'b'.
|
||||
dir :: V2 Double -> V2 Double -> Double
|
||||
dir a b = (atan2 (crossZ (V2 0 1) (b - a)) (dot (V2 0 1) (b - a)))
|
||||
dir a b = atan2 (crossZ (V2 0 1) (b - a)) (dot (V2 0 1) (b - a))
|
||||
|
||||
angleSmooth :: V2 Double -> V.Vector (V2 Double) -> V2 Double
|
||||
angleSmooth origin js = V.sum (V.generate n nth) ^/ V.sum (V.generate n factor)
|
||||
|
|
@ -192,7 +192,7 @@ isValidLocation origin edges newLoc =
|
|||
< minAngle newLoc edges
|
||||
where
|
||||
dir :: V2 Double -> V2 Double -> Double
|
||||
dir a b = (atan2 (crossZ (V2 0 1) (b - a)) (dot (V2 0 1) (b - a)))
|
||||
dir a b = atan2 (crossZ (V2 0 1) (b - a)) (dot (V2 0 1) (b - a))
|
||||
|
||||
minAngle :: V2 Double -> V.Vector (V2 Double) -> Double
|
||||
minAngle origin edges = minimum $ concat
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
{-# LANGUAGE DeriveFoldable #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Reanimate.Driver
|
||||
( reanimate
|
||||
|
|
|
|||
|
|
@ -1,6 +1,5 @@
|
|||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE MagicHash #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-|
|
||||
Module : Reanimate.GeoProjection
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# OPTIONS_GHC -w #-}
|
||||
-- {-# LANGUAGE TemplateHaskell #-}
|
||||
module Helpers where
|
||||
|
|
@ -32,7 +31,7 @@ instance Arbitrary PolyParam where
|
|||
, a' >= 0.01, b' >= 0.01
|
||||
]
|
||||
|
||||
data Parameters = Parameters [(Double, Double)]
|
||||
newtype Parameters = Parameters [(Double, Double)]
|
||||
deriving (Show)
|
||||
instance Arbitrary Parameters where
|
||||
arbitrary = do
|
||||
|
|
@ -45,7 +44,7 @@ instance Arbitrary Parameters where
|
|||
shrink (Parameters xs) =
|
||||
map Parameters (delete xs $ shrinkListByOne xs) ++
|
||||
map Parameters (delete xs $
|
||||
sequence $ map (map unParam . shrink . PolyParam) xs)
|
||||
mapM (map unParam . shrink . PolyParam) xs)
|
||||
|
||||
shrinkListByOne :: [a] -> [[a]]
|
||||
shrinkListByOne x | length x <= 4 = [x]
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# OPTIONS_GHC -w #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module Properties where
|
||||
|
|
@ -22,7 +21,7 @@ import Debug.Trace
|
|||
prop_pGenerate (PolyParam a) (PolyParam b) (PolyParam c) (PolyParam d) =
|
||||
pIsSimple $ pGenerate [a,b,c,d]
|
||||
|
||||
prop_pIsSimple p = pIsSimple p
|
||||
prop_pIsSimple = pIsSimple
|
||||
|
||||
prop_isBetween a b = percent $ \t ->
|
||||
a /= b ==>
|
||||
|
|
|
|||
|
|
@ -28,8 +28,8 @@ run out.
|
|||
[flat (1/3) 0, linear (1/3) 0 1, linear (1/3) 1 0]
|
||||
-}
|
||||
main :: IO ()
|
||||
main = reanimate $ pauseAtEnd 2
|
||||
(animate $ const $ mkBackground "black") `parA`
|
||||
main = reanimate $ pauseAtEnd 2 $
|
||||
addStatic (mkBackground "black")
|
||||
drawBox
|
||||
|
||||
drawBox :: Animation
|
||||
|
|
|
|||
|
|
@ -7,5 +7,5 @@ import Transcript
|
|||
|
||||
endScene :: Scene s ()
|
||||
endScene = do
|
||||
newSpriteSVG_ $ scale 0.5 $ githubWhiteIcon
|
||||
newSpriteSVG_ $ scale 0.5 githubWhiteIcon
|
||||
waitUntil $ wordEnd (findWord ["end"] "domain") + 1
|
||||
|
|
|
|||
|
|
@ -7,4 +7,4 @@ endScene :: Animation
|
|||
endScene = mkAnimation 10 $ const $
|
||||
mkGroup
|
||||
[ mkBackground "black"
|
||||
, scale 0.5 $ githubIcon ]
|
||||
, scale 0.5 githubIcon ]
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ import System.IO.Unsafe
|
|||
|
||||
|
||||
main :: IO ()
|
||||
main = seq equirectangular $ reanimate $ setDuration 59 $ sceneAnimation $ do
|
||||
main = seq equirectangular $ reanimate $ setDuration 59 $ scene $ do
|
||||
bg <- newSpriteSVG $ mkBackground "white"
|
||||
spriteZ bg (-1)
|
||||
prevProj <- newVar equirectangularP
|
||||
|
|
@ -49,7 +49,7 @@ main = seq equirectangular $ reanimate $ setDuration 59 $ sceneAnimation $ do
|
|||
,"distort"::String)
|
||||
imgFile = cacheImage imgKey $
|
||||
interpP src prev proj t
|
||||
in mkGroup $
|
||||
in mkGroup
|
||||
[ --scaleToSize screenWidth screenHeight $
|
||||
-- embedImage $ interP src prev proj t
|
||||
mkImage screenWidth screenHeight imgFile
|
||||
|
|
@ -59,7 +59,7 @@ main = seq equirectangular $ reanimate $ setDuration 59 $ sceneAnimation $ do
|
|||
fork $ tweenVar txtVar morphT $ \v t -> if t > 0 then mkLabel t else v
|
||||
play $ pauseAtEnd waitT $ signalA (curveS 2) $
|
||||
mkAnimation morphT $ \t ->
|
||||
mkGroup $
|
||||
mkGroup
|
||||
[ scaleToSize screenWidth screenHeight $
|
||||
embedImage $ project src $ mkProj t
|
||||
, grid $ mkProj t ]
|
||||
|
|
@ -112,9 +112,9 @@ renderLabel label =
|
|||
let ref = scale 1.5 $ latex "\\texttt{Tygv123}"
|
||||
glyphs = scale 1.5 $ latex ("\\texttt{" <> label <> "}")
|
||||
svgTxt = mkGroup
|
||||
[ withStrokeColor "black" $ withFillColor "white" $
|
||||
[ withStrokeColor "black" $ withFillColor "white"
|
||||
glyphs
|
||||
, withFillColor "white" $
|
||||
, withFillColor "white"
|
||||
glyphs ]
|
||||
in
|
||||
translate (screenWidth*0.01) (screenHeight*0.02) $
|
||||
|
|
@ -136,8 +136,8 @@ grid :: Projection -> SVG
|
|||
grid p =
|
||||
lowerTransformations $
|
||||
scaleXY
|
||||
(screenWidth)
|
||||
(screenHeight)
|
||||
screenWidth
|
||||
screenHeight
|
||||
$
|
||||
translate (-1/2) (-1/2) $
|
||||
withStrokeWidth strokeWidth $
|
||||
|
|
@ -203,11 +203,11 @@ longitudeLines p =
|
|||
halfPi :: Double
|
||||
halfPi = pi/2
|
||||
|
||||
landBorders :: [(GeospatialGeometry)]
|
||||
landBorders :: [GeospatialGeometry]
|
||||
landBorders = unsafePerformIO $ do
|
||||
Just geo <- decodeFileStrict "land.geojson"
|
||||
return
|
||||
[ (feature ^. geometry)
|
||||
[ feature ^. geometry
|
||||
| feature <- toList $ geo ^. geofeatures
|
||||
, let p = feature ^. properties :: Map String Value
|
||||
]
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ import System.IO.Unsafe
|
|||
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ sceneAnimation $ do
|
||||
main = reanimate $ scene $ do
|
||||
-- Set the background to 'rtfdBackgroundColor'
|
||||
newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor
|
||||
|
||||
|
|
@ -107,11 +107,11 @@ longitudeLines p =
|
|||
, let lam = fromToS (-pi) pi (n/segments)
|
||||
, let XYCoord x y = projectionForward p $ LonLat lam phi ]
|
||||
|
||||
landBorders :: [(GeospatialGeometry)]
|
||||
landBorders :: [GeospatialGeometry]
|
||||
landBorders = unsafePerformIO $ do
|
||||
Just geo <- decodeFileStrict "countries.json"
|
||||
return
|
||||
[ (feature ^. geometry)
|
||||
[ feature ^. geometry
|
||||
| feature <- toList $ geo ^. geofeatures :: [GeoFeature Value]
|
||||
]
|
||||
|
||||
|
|
|
|||
|
|
@ -42,14 +42,14 @@ earthMax = "earth-max.jpg"
|
|||
|
||||
main :: IO ()
|
||||
main = reanimate $
|
||||
parA (staticFrame 1 $ mkBackground "darkgrey") $
|
||||
addStatic (mkBackground "darkgrey") $
|
||||
overlapT 2 (signalT (curveS 2) flipTransition)
|
||||
mainScene
|
||||
endScene
|
||||
|
||||
mainScene :: Animation
|
||||
mainScene = seq equirectangular $ -- takeA 10 $ dropA 21 $
|
||||
mapA (withStrokeColor "black") $ sceneAnimation $ do
|
||||
mapA (withStrokeColor "black") $ scene $ do
|
||||
bg <- newSpriteSVG $ mkBackground "white"
|
||||
spriteZ bg (-1)
|
||||
|
||||
|
|
@ -72,7 +72,7 @@ mainScene = seq equirectangular $ -- takeA 10 $ dropA 21 $
|
|||
subImg =
|
||||
convertRGBA8 $ rasterSized srcWidth srcHeight $ mkGroup
|
||||
[ mkGroup []
|
||||
, mkClipPath idName $
|
||||
, mkClipPath idName
|
||||
clipSvg
|
||||
, withClipPathRef (Ref idName) $
|
||||
scaleToSize screenWidth screenHeight $
|
||||
|
|
@ -124,12 +124,12 @@ mainScene = seq equirectangular $ -- takeA 10 $ dropA 21 $
|
|||
mkImage screenWidth screenHeight imgFile
|
||||
, withStrokeWidth (fromToS 0 (defaultStrokeWidth*0.3) t) $
|
||||
lowerTransformations $ setPos $ scale orthoScale $
|
||||
(proj (orthoP lonlat))
|
||||
proj (orthoP lonlat)
|
||||
]
|
||||
-- destroySprite region1Shadow
|
||||
fork $ tweenVar move 1 $ \v -> fromToS v 1 . curveS 2
|
||||
fork $ play $ (staticFrame 2 $
|
||||
withStrokeWidth 0 $
|
||||
fork $ play $ staticFrame 2
|
||||
(withStrokeWidth 0 $
|
||||
translate 0 (-screenHeight*0.40) $
|
||||
center $ latex label)
|
||||
# applyE (overBeginning 0.2 fadeInE)
|
||||
|
|
@ -182,22 +182,22 @@ mainScene = seq equirectangular $ -- takeA 10 $ dropA 21 $
|
|||
]
|
||||
spriteMap mapS offset
|
||||
|
||||
play $ (staticFrame (projMorphT+projWaitT) $
|
||||
withStrokeWidth 0 $
|
||||
play $ staticFrame (projMorphT+projWaitT)
|
||||
(withStrokeWidth 0 $
|
||||
translate 0 (-screenHeight*0.43) $
|
||||
center $ latex "Equirectangular")
|
||||
# applyE (overBeginning 0.2 fadeInE)
|
||||
# applyE (overEnding 0.2 fadeOutE)
|
||||
|
||||
let push proj label = do
|
||||
fork $ play $ (staticFrame (projMorphT+projWaitT) $
|
||||
withStrokeWidth 0 $
|
||||
fork $ play $ staticFrame (projMorphT+projWaitT)
|
||||
(withStrokeWidth 0 $
|
||||
translate 0 (-screenHeight*0.43) $
|
||||
center $ latex label)
|
||||
# applyE (overBeginning 0.2 fadeInE)
|
||||
# applyE (overEnding 0.2 fadeOutE)
|
||||
(_, prev) <- readVar projs
|
||||
writeVar projs (const $ prev, proj)
|
||||
writeVar projs (const prev, proj)
|
||||
writeVar morph 0
|
||||
tweenVar morph projMorphT $ \v -> fromToS v 1 . curveS 2
|
||||
wait projWaitT
|
||||
|
|
@ -226,7 +226,7 @@ mainScene = seq equirectangular $ -- takeA 10 $ dropA 21 $
|
|||
projWaitT = 3
|
||||
|
||||
centerWithDelta :: Double -> Tree -> Tree -> Tree
|
||||
centerWithDelta d orig t = translate ((-x-w/2)*d) ((-y-h/2)*d) t
|
||||
centerWithDelta d orig = translate ((-x-w/2)*d) ((-y-h/2)*d)
|
||||
where
|
||||
(x, y, w, h) = boundingBox orig
|
||||
|
||||
|
|
@ -271,8 +271,8 @@ fetchCountry :: Projection -> (Map String Value -> SVG -> Maybe SVG) -> SVG
|
|||
fetchCountry p checker =
|
||||
lowerTransformations $
|
||||
scaleXY
|
||||
(screenWidth)
|
||||
(screenHeight)
|
||||
screenWidth
|
||||
screenHeight
|
||||
$
|
||||
translate (-1/2) (-1/2) $
|
||||
|
||||
|
|
@ -323,7 +323,7 @@ americaE = america equirectangularP
|
|||
uk :: Projection -> SVG
|
||||
uk p = fetchCountry p $ \props svg -> do
|
||||
name <- Map.lookup "NAME" props
|
||||
guard (name `elem` ["United Kingdom"])
|
||||
guard (name == "United Kingdom")
|
||||
return svg
|
||||
|
||||
ukE :: SVG
|
||||
|
|
@ -361,8 +361,8 @@ grid :: Projection -> SVG
|
|||
grid p =
|
||||
lowerTransformations $
|
||||
scaleXY
|
||||
(screenWidth)
|
||||
(screenHeight)
|
||||
screenWidth
|
||||
screenHeight
|
||||
$
|
||||
translate (-1/2) (-1/2) $
|
||||
|
||||
|
|
@ -387,11 +387,11 @@ landGeo = loadFeatureCollection "land.geojson"
|
|||
gridLines :: Int -> Int -> SVG
|
||||
gridLines latLines lonLines = mkGroup $ map mkLinePath $
|
||||
map longitudeLine (stepper (-halfPi) halfPi (lonLines+1)) ++
|
||||
map latitudeLine (stepper (-pi) pi (latLines))
|
||||
map latitudeLine (stepper (-pi) pi latLines)
|
||||
where
|
||||
segments = 100
|
||||
stepper from to nMax =
|
||||
[ fromToS from to (fromIntegral n / fromIntegral (nMax))
|
||||
[ fromToS from to (fromIntegral n / fromIntegral nMax)
|
||||
| n <- [0 .. nMax-1] ]
|
||||
maxLat = halfPi -- atan (sinh pi)
|
||||
latitudeLine lam =
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
#!/usr/bin/env stack
|
||||
-- stack runghc --package reanimate
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE ApplicativeDo #-}
|
||||
module Main where
|
||||
|
||||
|
|
@ -71,7 +70,7 @@ step1 = uncurry delaunayFlip step0
|
|||
step2 = doSmooth step1
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ sceneAnimation $ do
|
||||
main = reanimate $ scene $ do
|
||||
-- newSpriteSVG_ $ mkBackground "black"
|
||||
newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor
|
||||
-- let m = buildMesh $ polygonMesh $ map (fmap realToFrac) $ V.toList $ polygonPoints p2
|
||||
|
|
@ -112,17 +111,15 @@ main = reanimate $ sceneAnimation $ do
|
|||
let pipeline1 = last . take 20 . iterate (
|
||||
uncurry delaunayFlip .
|
||||
-- uncurry splitInternalEdges .
|
||||
doSmooth .
|
||||
id
|
||||
doSmooth
|
||||
)
|
||||
stages = take 30 $ iterate (
|
||||
pipeline1 .
|
||||
stages = take 30 $ iterate
|
||||
pipeline1
|
||||
-- uncurry splitInternalEdges .
|
||||
-- pipeline1 .
|
||||
-- uncurry splitLongestEdge .
|
||||
--pipeline1
|
||||
id
|
||||
) (m1,m2)
|
||||
(m1,m2)
|
||||
let pipeline = do
|
||||
modifyVar mVar (uncurry delaunayFlip)
|
||||
modifyVar mVar (uncurry splitInternalEdges)
|
||||
|
|
@ -154,8 +151,6 @@ main = reanimate $ sceneAnimation $ do
|
|||
-- mkGroup $ map (polygonDots . pScale 6) p2s
|
||||
-- newSpriteSVG_ $ withFillColor "red" $ scale 3 $ polygonNumDots p2
|
||||
-- wait 1
|
||||
return ()
|
||||
where
|
||||
|
||||
|
||||
drawTrigs :: V.Vector (V2 Double) -> V.Vector RelTrig -> SVG
|
||||
|
|
|
|||
|
|
@ -50,10 +50,10 @@ extraPoints = 0
|
|||
-- p1 = centerPolygon shape2
|
||||
-- p2 = pScale 2 $ pAtCenter $ pAddPoints extraPoints (pSetOffset shape14 0 )
|
||||
|
||||
-- p1 = pAddPoints extraPoints $ (pAtCenter $ unsafeSVGToPolygon 0.1 $ scale 6 $ latex "S")
|
||||
-- p2 = pAddPoints extraPoints $ (pAtCenter $ unsafeSVGToPolygon 0.1 $ scale 6 $ latex "C")
|
||||
p1 = pAddPoints extraPoints $ (pAtCenter $ unsafeSVGToPolygon 0.1 $ scale 6 $ latex "X")
|
||||
p2 = pAddPoints extraPoints $ (pAtCenter $ unsafeSVGToPolygon 0.1 $ scale 6 $ latex "I")
|
||||
-- p1 = pAddPoints extraPoints (pAtCenter $ unsafeSVGToPolygon 0.1 $ scale 6 $ latex "S")
|
||||
-- p2 = pAddPoints extraPoints (pAtCenter $ unsafeSVGToPolygon 0.1 $ scale 6 $ latex "C")
|
||||
p1 = pAddPoints extraPoints (pAtCenter $ unsafeSVGToPolygon 0.1 $ scale 6 $ latex "X")
|
||||
p2 = pAddPoints extraPoints (pAtCenter $ unsafeSVGToPolygon 0.1 $ scale 6 $ latex "I")
|
||||
|
||||
p1_ = castPolygon p1
|
||||
p2_ = castPolygon p2
|
||||
|
|
@ -70,7 +70,7 @@ polys'' = compatTriagPairs polys'
|
|||
|
||||
main :: IO ()
|
||||
-- main = reanimate $ playTraces $ seq (last $ triangulate [] p1 p2) ()
|
||||
main = reanimate $ sceneAnimation $ do
|
||||
main = reanimate $ scene $ do
|
||||
bg <- newSpriteSVG $ mkBackground "black"
|
||||
spriteZ bg (-1)
|
||||
|
||||
|
|
@ -86,23 +86,23 @@ main = reanimate $ sceneAnimation $ do
|
|||
-- , polygonNumDots (castPolygon l)
|
||||
]
|
||||
newSpriteSVG_ $
|
||||
translate (2) 0 $ withFillColorPixel c $ mkGroup
|
||||
translate 2 0 $ withFillColorPixel c $ mkGroup
|
||||
[ polygonShape (castPolygon r)
|
||||
-- , polygonNumDots (castPolygon r)
|
||||
]
|
||||
nums <- newSpriteSVG $ mkGroup
|
||||
[ translate (-2) 0 $ polygonNumDots (castPolygon l)
|
||||
, translate (2) 0 $ polygonNumDots (castPolygon r)
|
||||
, translate 2 0 $ polygonNumDots (castPolygon r)
|
||||
]
|
||||
wait (1/60)
|
||||
destroySprite nums
|
||||
|
||||
-- fork $ play $ staticFrame (1/60) $ mkGroup
|
||||
-- [ translate (2) 0 $ mkGroup
|
||||
-- [ translate 2 0 $ mkGroup
|
||||
-- [ withFillColor "grey" $ polygonShape p2_circ
|
||||
-- , polygonNumDots p2_circ
|
||||
-- ]
|
||||
-- , translate (6) 0 $ mkGroup
|
||||
-- , translate 6 0 $ mkGroup
|
||||
-- [ withFillColor "grey" $ polygonShape p2
|
||||
-- , polygonNumDots p2
|
||||
-- ]
|
||||
|
|
@ -118,9 +118,6 @@ main = reanimate $ sceneAnimation $ do
|
|||
-- ]
|
||||
-- ]
|
||||
|
||||
|
||||
return ()
|
||||
|
||||
|
||||
showP p = mkGroup
|
||||
[ withFillColor "grey" $ polygonShape p
|
||||
|
|
|
|||
|
|
@ -106,9 +106,9 @@ main :: IO ()
|
|||
-- evaluate (last $ take 900 $ compatiblyTriangulateP p1 p2)
|
||||
-- return ()
|
||||
-- main = reanimate $ playTraces $ length $ take 29 p1s
|
||||
-- main = reanimate $ playThenReverseA $ pauseAround 0.5 0.5 $ sceneAnimation $ do
|
||||
-- main = reanimate $ playThenReverseA $ pauseAround 0.5 0.5 $ scene $ do
|
||||
|
||||
main = reanimate $ sceneAnimation $ do
|
||||
main = reanimate $ scene $ do
|
||||
newSpriteSVG_ $ mkBackgroundPixel rtfdBackgroundColor
|
||||
-- play
|
||||
-- $ playTraces
|
||||
|
|
@ -119,7 +119,7 @@ main = reanimate $ sceneAnimation $ do
|
|||
-- $ 20
|
||||
-- play $ playTraces $ last $ take 35 $ compatiblyTriangulateP p1 p2
|
||||
-- fork $ newSpriteA $ drawCompatible p1 p2
|
||||
-- newSpriteSVG_ $ translate (5) 0 $ lowerTransformations $ scale 2 $
|
||||
-- newSpriteSVG_ $ translate 5 0 $ lowerTransformations $ scale 2 $
|
||||
-- -- DCEL.renderMesh 0.02 m1final
|
||||
-- DCEL.renderMeshColored m1final
|
||||
-- renderMeshPair optMesh
|
||||
|
|
@ -133,7 +133,7 @@ main = reanimate $ sceneAnimation $ do
|
|||
-- , withFillColor "grey" $ polygonNumDots p1
|
||||
-- ]
|
||||
-- newSpriteSVG_ $
|
||||
-- translate (3) 0 $ scale 1 $ mkGroup
|
||||
-- translate 3 0 $ scale 1 $ mkGroup
|
||||
-- [ mkGroup []
|
||||
-- , withFillColor "grey" $ polygonShape p2
|
||||
-- , withFillColor "grey" $ polygonNumDots p2
|
||||
|
|
@ -150,7 +150,7 @@ main = reanimate $ sceneAnimation $ do
|
|||
-- -- wait 1
|
||||
-- fork $ forM_ p2s $ \p1Piece -> do
|
||||
-- newSpriteSVG_ $
|
||||
-- translate (3) 0 $ scale 1 $ mkGroup
|
||||
-- translate 3 0 $ scale 1 $ mkGroup
|
||||
-- [ mkGroup []
|
||||
-- , withFillColor "white" $ polygonShape p1Piece
|
||||
-- -- , withFillColor "grey" $ polygonNumDots p1Piece
|
||||
|
|
@ -167,7 +167,7 @@ main = reanimate $ sceneAnimation $ do
|
|||
-- ]
|
||||
fork $ play $ mkAnimation 3 $ \t ->
|
||||
let points = interpolate optPrep t
|
||||
in translate (3) 0 $ lowerTransformations $ scale 1 $ mkGroup
|
||||
in translate 3 0 $ lowerTransformations $ scale 1 $ mkGroup
|
||||
[ mkGroup []
|
||||
, drawTrigs points (meshTriangles optMesh)
|
||||
-- , DCEL.renderMeshColored m1final
|
||||
|
|
@ -180,7 +180,7 @@ main = reanimate $ sceneAnimation $ do
|
|||
-- , scale 2 $ polygonNumDots p1
|
||||
-- play $ pauseAtEnd 1 $ mkAnimation 3 $ \t ->
|
||||
-- let points = interpolate bestPrep t
|
||||
-- in translate (3) 0 $ mkGroup [drawTrigs points (meshTriangles bestMesh)
|
||||
-- in translate 3 0 $ mkGroup [drawTrigs points (meshTriangles bestMesh)
|
||||
-- -- , scale 2 $ polygonNumDots p2
|
||||
-- ]
|
||||
-- play $ pauseAtEnd 1 $ mkAnimation 3 $ \t ->
|
||||
|
|
@ -193,9 +193,9 @@ main = reanimate $ sceneAnimation $ do
|
|||
-- let (minAngA, minAngB) = meshMinAngle newMesh
|
||||
-- txt <- newSpriteSVG $ withFillColor "white" $
|
||||
-- mkGroup
|
||||
-- [translate (5) 2 $ center $
|
||||
-- [translate 5 2 $ center $
|
||||
-- latex $ T.pack $ printf "Min: %.1f" (minAngA/pi*180)
|
||||
-- ,translate (5) 1 $ center $
|
||||
-- ,translate 5 1 $ center $
|
||||
-- latex $ T.pack $ printf "Min: %.1f" (minAngB/pi*180) ]
|
||||
-- s <- newSpriteSVG $ renderAMesh newMesh
|
||||
-- wait (recip 60)
|
||||
|
|
@ -235,11 +235,11 @@ mkMesh a b = Mesh
|
|||
V.fromList $ nub $ V.toList $ V.concat [ polygonPoints b | (a, b) <- trigs ]
|
||||
trigs = compatiblyTriangulateP a b
|
||||
mkRel arr p =
|
||||
( (fromJust $ V.elemIndex (pAccess p 0) arr)
|
||||
, (fromJust $ V.elemIndex (pAccess p 1) arr)
|
||||
, (fromJust $ V.elemIndex (pAccess p 2) arr)
|
||||
( fromJust $ V.elemIndex (pAccess p 0) arr
|
||||
, fromJust $ V.elemIndex (pAccess p 1) arr
|
||||
, fromJust $ V.elemIndex (pAccess p 2) arr
|
||||
)
|
||||
relTrigs = V.fromList [ (mkRel pointsA a) | (a, b) <- trigs ]
|
||||
relTrigs = V.fromList [ mkRel pointsA a | (a, b) <- trigs ]
|
||||
-- data Mesh = Mesh (Vector P) (Vector (RelTrig, RelTrig))
|
||||
|
||||
testMesh2 :: Mesh
|
||||
|
|
@ -287,7 +287,7 @@ drawPolygon :: [V2 Double] -> SVG
|
|||
drawPolygon lst = mkLinePathClosed [ (x, y) | V2 x y <- lst ]
|
||||
|
||||
drawCompatible :: Polygon -> Polygon -> Animation
|
||||
drawCompatible a b = sceneAnimation $ do
|
||||
drawCompatible a b = scene $ do
|
||||
let left = -6
|
||||
right = 4
|
||||
newSpriteSVG $ translate left 0 $ mkGroup
|
||||
|
|
|
|||
|
|
@ -54,7 +54,7 @@ pCuts' p =
|
|||
-- lowerTransformations $ pathify $ center $ latex "$1$"
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ sceneAnimation $ do
|
||||
main = reanimate $ scene $ do
|
||||
bg <- newSpriteSVG $ mkBackground "black"
|
||||
spriteZ bg (-1)
|
||||
newSpriteSVG_ $ translate 0 1 $ mkGroup
|
||||
|
|
@ -65,12 +65,11 @@ main = reanimate $ sceneAnimation $ do
|
|||
play $ mkAnimation (1/60) $ \_ -> mkGroup
|
||||
[ translate (-3) 0 $ withFillColor "grey" $ polygonShape l
|
||||
, translate (-3) 0 $ polygonNumDots l
|
||||
, translate (3) 0 $ withFillColor "grey" $ polygonShape r
|
||||
, translate (3) 0 $ polygonNumDots r
|
||||
, translate 3 0 $ withFillColor "grey" $ polygonShape r
|
||||
, translate 3 0 $ polygonNumDots r
|
||||
]
|
||||
-- wait 1
|
||||
-- fork $ play $ drawTriangulation shape1 earCut'
|
||||
-- # mapA (translate (-3) 0)
|
||||
-- play $ drawTriangulation shape1 earClip'
|
||||
-- # mapA (translate (3) 0)
|
||||
return ()
|
||||
-- # mapA (translate 3 0)
|
||||
|
|
|
|||
|
|
@ -61,7 +61,7 @@ immutable.
|
|||
-}
|
||||
|
||||
main :: IO ()
|
||||
main = reanimate $ animate (const $ mkBackground "black") `parA`
|
||||
main = reanimate $ addStatic (mkBackground "black")
|
||||
-- animate $ const $ checker 10 10
|
||||
-- rotateSphere
|
||||
-- rotateWireSphere
|
||||
|
|
@ -109,7 +109,7 @@ sphereIntro = scene $ do
|
|||
partialSvg t $
|
||||
withFillOpacity 0 $
|
||||
rotate 180 $
|
||||
pathify $
|
||||
pathify
|
||||
circ
|
||||
-- playZ 1 $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
||||
-- withFillOpacity t $
|
||||
|
|
@ -120,25 +120,25 @@ sphereIntro = scene $ do
|
|||
let p = curveS 3 t in
|
||||
withFillOpacity p $
|
||||
translate (1*p) (2*p) $
|
||||
scale (1-scaleFactor*p) $
|
||||
scale (1-scaleFactor*p)
|
||||
circ
|
||||
fork $ adjustZ (+1) $ play $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
||||
let p = curveS 3 t in
|
||||
withFillOpacity p $
|
||||
translate (1*p) (-2*p) $
|
||||
scale (1-scaleFactor*p) $
|
||||
scale (1-scaleFactor*p)
|
||||
circ
|
||||
fork $ adjustZ (+1) $ play $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
||||
let p = curveS 3 t in
|
||||
withFillOpacity p $
|
||||
translate (5*p) (2*p) $
|
||||
scale (1-scaleFactor*p) $
|
||||
scale (1-scaleFactor*p)
|
||||
circ
|
||||
fork $ adjustZ (+1) $ play $ pauseAtEnd 2 $ setDuration 1 $ animate $ \t ->
|
||||
let p = curveS 3 t in
|
||||
withFillOpacity p $
|
||||
translate (5*p) (-2*p) $
|
||||
scale (1-scaleFactor*p) $
|
||||
scale (1-scaleFactor*p)
|
||||
circ
|
||||
where
|
||||
circ =
|
||||
|
|
@ -169,7 +169,7 @@ mkFeatSprite xPos yPos ani = do
|
|||
return (spriteAt, spriteTMod, sprite)
|
||||
|
||||
featSVG :: Animation
|
||||
featSVG = animate $ const $ scale 0.4 $ svgLogo
|
||||
featSVG = animate $ const $ scale 0.4 svgLogo
|
||||
|
||||
feat3D :: Animation
|
||||
feat3D = rotateSphere
|
||||
|
|
@ -211,10 +211,10 @@ fadeTransition :: Double -> Animation -> Animation -> Animation
|
|||
fadeTransition overlap a b =
|
||||
(a
|
||||
& pauseAtEnd overlap
|
||||
& applyE (overEnding overlap $ fadeOutE)
|
||||
& applyE (overEnding overlap fadeOutE)
|
||||
) `seqA` (
|
||||
b
|
||||
& applyE (overBeginning overlap $ fadeInE)
|
||||
& applyE (overBeginning overlap fadeInE)
|
||||
)
|
||||
|
||||
fadeTransitions :: Double -> [Animation] -> Animation
|
||||
|
|
@ -263,16 +263,16 @@ introSVG = scene $ do
|
|||
wait 1
|
||||
spriteZ sp 0
|
||||
-- SVG
|
||||
(svgAt, svgT, svgS) <- mkFeatSprite (-5.5) (1.5) featSVG
|
||||
(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
|
||||
(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
|
||||
(rayAt, rayT, rayS) <- mkFeatSprite 5.5 (-2.5) feat3D
|
||||
fork $ tweenFeat rayS rayAt rayT rayHighlight rayHighlightDur
|
||||
-- wait
|
||||
wait $ rayHighlight + rayHighlightDur + 2 + 10
|
||||
|
|
@ -299,7 +299,7 @@ drawAnimation' fillDur step svg = scene $ do
|
|||
_ -> defaultStrokeWidth
|
||||
fork $ do
|
||||
wait (n*step)
|
||||
play $ mapA fn $ (animate (\t -> withFillOpacity 0 $ partialSvg t tree)
|
||||
play $ mapA fn (animate (\t -> withFillOpacity 0 $ partialSvg t tree)
|
||||
& applyE (overEnding fillDur $ fadeLineOutE sWidth))
|
||||
fork $ do
|
||||
wait (n*step+(1-fillDur))
|
||||
|
|
@ -407,8 +407,7 @@ checker w h =
|
|||
withStrokeColor "white" $
|
||||
withStrokeWidth 0.1 $
|
||||
mkGroup
|
||||
[ withStrokeWidth 0 $
|
||||
withFillOpacity 0.8 $ mkBackground "blue"
|
||||
[ withFillOpacity 0.8 $ mkBackground "blue"
|
||||
, mkGroup
|
||||
[ translate (stepX*x-offsetX + stepX/2) 0 $
|
||||
mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,5 @@
|
|||
#!/usr/bin/env stack
|
||||
-- stack --resolver lts-13.14 runghc --package reanimate
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
module Main (main) where
|
||||
|
||||
|
|
@ -41,9 +39,9 @@ digitCount = 10
|
|||
|
||||
main :: IO ()
|
||||
main = reanimate $ fixed bg $ pauseAtEnd 1 $
|
||||
-- sceneAnimation (bubbleSort lst) `seqA` sceneAnimation (simpleSort lst)
|
||||
-- sceneAnimation (simpleSort_ lst)
|
||||
sceneAnimation (quicksort__ lst)
|
||||
-- scene (bubbleSort lst) `seqA` scene (simpleSort lst)
|
||||
-- scene (simpleSort_ lst)
|
||||
scene (quicksort__ lst)
|
||||
-- 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
|
||||
|
|
|
|||
Loading…
Reference in a new issue