reanimate-1.1.0.0: examples/fe_distortion.hs

#!/usr/bin/env stack
-- stack runghc --package reanimate

{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

module Main (main) where

{- FE articles/demos
scatter: https://codepen.io/mullany/pen/JmgbRB
distortion: https://codepen.io/mullany/pen/BWKePz
variable stroke width: https://codepen.io/mullany/pen/qaONQm
variable stroke gradient: https://codepen.io/mullany/pen/XXBMJd
heart: https://codepen.io/yoksel/pen/MLVjoB
elastic stroke: https://codepen.io/yoksel/pen/XJbzrO
-}

import Codec.Picture.Types
import Control.Lens hiding (magma)
import qualified Data.Text as T
import Graphics.SvgTree
import Reanimate
import Text.Printf
import NeatInterpolation
import Control.Monad

main :: IO ()
main = reanimate $
  scene $ do
    newSpriteSVG_ $ mkBackground "white"
    hue <- newVar 0
    dScale <- newVar 0.2
    newSprite $
      mkDistortFilter <$> unVar hue <*> unVar dScale
    newSpriteSVG_ $ parseSvg "<circle r=\"3\" fill=\"red\" filter=\"url(#distort)\" />"
    fork $ replicateM_ 5 $ tweenVar hue 1 $ \v -> fromToS 0 360
    tweenVar dScale 1 $ \v -> fromToS v 1.0
    tweenVar dScale 1 $ \v -> fromToS v 0.2
    tweenVar dScale 1 $ \v -> fromToS v 0.5
    tweenVar dScale 1 $ \v -> fromToS v 1.0
    tweenVar dScale 1 $ \v -> fromToS v 0.2

-- wait 1

-- hue: 0 -> 360 over 1s
-- dScale: 0;20;50;0 over 5s
mkDistortFilter :: Double -> Double -> SVG
mkDistortFilter hue dScale = parseSvg [text|
  <filter id="distort">
    <feTurbulence baseFrequency="0.7" type="fractalNoise"/>
    <feColorMatrix type="hueRotate" values="${hue'}">
    </feColorMatrix>
    <feDisplacementMap in="SourceGraphic" xChannelSelector="R" yChannelSelector="B"
      scale="${dScale'}">
      </feDisplacementMap>
    <feGaussianBlur stdDeviation="0.02"/>
    <feComponentTransfer result="main">
      <feFuncA type="gamma" amplitude="1" exponent="10"/>
    </feComponentTransfer>
    <feColorMatrix type="matrix" values="0 0 0 0 0 
                                         0 0 0 0 0
                                         0 0 0 0 0
                                         0 0 0 1 0"/>
    <feGaussianBlur stdDeviation="0.2"/>
    <feComposite operator="over" in="main"/>
  </filter>
  |]
  where
    hue' = T.pack (show hue)
    dScale' = T.pack (show dScale)