diff --git a/examples/fourier_draw.hs b/examples/fourier_draw.hs index b7d73f8..5b4eac5 100755 --- a/examples/fourier_draw.hs +++ b/examples/fourier_draw.hs @@ -14,38 +14,47 @@ import Reanimate.Driver (reanimate) import Reanimate.LaTeX import Reanimate.Monad import Reanimate.Svg +import Reanimate.Combinators waveMultiplier :: Int -- waveMultiplier = 1 -- Sawtooth wave waveMultiplier = 2 -- Square wave main :: IO () -main = reanimate $ - fourierAnimation 0 `before` - fourierAnimation 1 `before` - fourierAnimation 2 `before` - fourierAnimation 3 `before` - fourierAnimation 4 `before` - fourierAnimation 5 `before` - fourierAnimation 6 `before` - fourierAnimation 7 `before` - fourierAnimation 8 `before` - fourierAnimation 9 `before` - fourierAnimation 10 `before` - fourierAnimation 15 `before` - fourierAnimation 25 `before` - fourierAnimation 40 +main = reanimate $ pauseAtEnd 2 $ + -- fourierAnimation 1 2 + fourierAnimation 1 2 `before` + fourierAnimation 2 3 `before` + fourierAnimation 3 4 `before` + fourierAnimation 4 5 `before` + fourierAnimation 5 6 `before` + fourierAnimation 6 7 `before` + fourierAnimation 7 8 `before` + fourierAnimation 8 9 `before` + fourierAnimation 9 10 `before` + fourierAnimation 10 15 `before` + fourierAnimation 15 25 `before` + fourierAnimation 25 40 `before` + fourierAnimation 40 40 sWidth = 0.5 -fourierAnimation :: Int -> Animation -fourierAnimation nCircles = repeatAnimation 1 $ mkAnimation 10 $ do +applyMorph :: Int -> [Complex Double] -> Complex Double -> [Complex Double] +applyMorph n coeffs mult = + map (*mult) (take n coeffs) ++ + take (length coeffs - n * 2) (drop n coeffs) ++ + map (*mult) (reverse $ take n $ reverse coeffs) + +fourierAnimation :: Int -> Int -> Animation +fourierAnimation nCircles nextCircles = repeatAnimation 1 $ mkAnimation 10 $ do emit $ mkBackground "black" phi <- signal 0 1 - let circles = findCoefficients nCircles + let circles = applyMorph (nextCircles - nCircles) (findCoefficients nextCircles) circleAlpha + circleAlpha = realToFrac (max 0 (phi-0.80) / 0.20) + emit $ withStrokeWidth (Num 1) $ withStrokeColor "green" $ - mkCirclePath circles + mkLinePath $ mkCirclePath circles drawNCircles $ rearrangeCircles $ rotateCircles phi circles emit $ withStrokeWidth (Num sWidth) $ @@ -92,6 +101,7 @@ drawNCircles circles = do worker circles emit $ withStrokeWidth (Num sWidth) $ withStrokeColor "white" $ + withStrokeLineJoin JoinRound $ withFillOpacity 0 $ mkLinePath [ (x, y) | x :+ y <- scanl (+) 0 circles ] where @@ -106,7 +116,7 @@ drawNCircles circles = do & circleRadius .~ Num radius mapF (translate x y) $ worker rest -mkCirclePath circles = mkLinePath +mkCirclePath circles = [ (x, y) | idx <- [0 .. granularity] , let t = idx/granularity diff --git a/src/Reanimate/Svg.hs b/src/Reanimate/Svg.hs index f620396..46eb286 100644 --- a/src/Reanimate/Svg.hs +++ b/src/Reanimate/Svg.hs @@ -95,6 +95,16 @@ lineToPath = map worker worker (LineBezier [a]) = LineTo OriginAbsolute [a] worker LineEnd = EndPath +lineToPoints :: Int -> [LineCommand] -> [RPoint] +lineToPoints nPoints cmds = + map lineEnd lineSegments + where + lineSegments = [ partialLine (fromIntegral n/ fromIntegral nPoints) cmds | n <- [0 .. nPoints-1] ] + totalLen = evalState (sum <$> mapM lineLength cmds) zero + lineEnd [LineBezier bezier] = last bezier + lineEnd (_:xs) = lineEnd xs + lineEnd _ = error "invalid line" + partialLine :: Double -> [LineCommand] -> [LineCommand] partialLine alpha cmds = evalState (worker 0 cmds) zero where @@ -474,6 +484,9 @@ mkColor name = withStrokeColor :: String -> Tree -> Tree withStrokeColor color = strokeColor .~ pure (mkColor color) +withStrokeLineJoin :: LineJoin -> Tree -> Tree +withStrokeLineJoin join = strokeLineJoin .~ pure join + withFillColor :: String -> Tree -> Tree withFillColor color = fillColor .~ pure (mkColor color)