Restore the 'valentine' example.

server/Main.hs

@@ -49,6 +49,7 @@ generateResponse conn msg = do
           ,"import Reanimate.Monad"
           ,"import           Reanimate.Combinators"
           ,"import           Reanimate.LaTeX"
+          ,"import           Codec.Picture.Types"
           ,"import           Reanimate.Svg"
           ,"import           Reanimate.Render"
           ,"import           Data.Monoid"

src/Reanimate/Examples.hs

@@ -605,3 +605,43 @@ latex_basic = autoReverse $ mkAnimation 2 $ do
   where
     text = scale 4 $ center $ latexAlign
       "\\sum_{k=1}^\\infty {1 \\over k^2} = {\\pi^2 \\over 6}"
+
+valentine :: Animation
+valentine =
+    all_red `before`
+    ( background `sim`
+      (backgroundDelay `before`
+       foldr1 sim [ pause p `before` fallingLove x | (p, x) <- falling ]
+      ) `sim`
+      (heart_ani `before` heart_disappear) `sim`
+      (pause 5 `before` message ai)
+    )
+  where
+    falling = [(6.4, 0.09), (4.9, 0.12), (4.5, 0.88), (0.3, 0.43), (5.3, 0.93)
+              ,(0.1, 0.80), (1.1, 0.39), (2.3, 0.21), (2.9, 0.77), (3.4, 0.46)
+              ,(6.2, 0.19), (5.9, 0.53), (3.2, 0.14), (7.7, 0.99) ]
+    ai = center $ xelatex "爱"
+    all_red = mkAnimation 1 $ emit $ mkBackground "red"
+    background = mkAnimation 2 $ do
+      n <- round <$> signal 0 0xFF
+      emit $ mkBackgroundPixel $ PixelRGBA8 0xFF n n 0xFF
+    backgroundDelay = pause (duration background-1)
+    heart_ani = repeatAnimation 10 $ mkAnimation 1 $ do
+      n <- oscillate $ signalSCurve 2 0.9 1.1
+      mapF (scale n) $ drawHeart
+    heart_disappear = mkAnimation 3 $ do
+      n  <- signal 0.9 10
+      mapF (scale n) drawHeart
+    fallingLove xPos = mkAnimation 2 $ do
+      n <- signal (-100) 100
+      o <- oscillate $ signal (-1) 1
+      emit $ scale 2 $ withFillColor "red" $
+        translate ((xPos*2-1)*60) n $ rotate (45*o) ai
+    message txt = mkAnimation 1 $ do
+      o <- oscillate $ signal 0 1
+      n <- oscillate $ signalSCurve 2 0.9 1.1
+      emit $ scale n $ scale 2 $ withFillColor "white" $ withFillOpacity o txt
+
+    drawHeart = emit $ withFillColor "red" $ heartShape
+    hex n = if n < 0x10 then "0" ++ showHex (round n) ""
+            else showHex (round n) ""

src/Reanimate/LaTeX.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-module Reanimate.LaTeX (latex,latexAlign) where
+module Reanimate.LaTeX (latex,xelatex,latexAlign) where
 
 import           Control.Exception     (SomeException, handle)
 import qualified Data.ByteString       as B
@@ -14,11 +14,12 @@ import           Reanimate.Svg
 import           System.FilePath       (replaceExtension, takeFileName, (</>))
 import           System.IO.Unsafe      (unsafePerformIO)
 
-import           Graphics.Svg          (loadSvgFile, parseSvgFile,
+import           Control.Lens          (over, set, (%~), (&), (.~), (^.))
-                                        xmlOfDocument, Tree, elements, defaultSvg, Document(..))
+import           Graphics.Svg          (Document (..), Tree (..), defaultSvg,
-import           Text.XML.Light.Output (ppcElement, ppcContent, prettyConfigPP)
+                                        elements, loadSvgFile, parseSvgFile,
-import           Text.XML.Light (elContent)
+                                        xmlOfDocument)
-import Control.Lens (over, (^.),set, (.~), (&), (%~) )
+import           Text.XML.Light        (elContent)
+import           Text.XML.Light.Output (ppcContent, ppcElement, prettyConfigPP)
 
 -- instance ToHtml Document where
 --   toHtml = toHtmlRaw
@@ -56,7 +57,20 @@ latex tex = unsafePerformIO $ do
     Just svg -> return svg
     Nothing -> do
       svg <- latexToSVG tex
-      atomicModifyIORef cache (\store -> (Map.insert tex svg store, svg))
+      case svg of
+        None -> pure None
+        _ -> atomicModifyIORef cache (\store -> (Map.insert tex svg store, svg))
+
+xelatex :: String -> Tree
+xelatex tex = unsafePerformIO $ do
+  store <- readIORef cache
+  case Map.lookup tex store of
+    Just svg -> return svg
+    Nothing -> do
+      svg <- xelatexToSVG tex
+      case svg of
+        None -> pure None
+        _ -> atomicModifyIORef cache (\store -> (Map.insert tex svg store, svg))
 
 latexAlign :: String -> Tree
 latexAlign tex = latex $ unlines ["\\begin{align*}", tex, "\\end{align*}"]
@@ -68,7 +82,8 @@ latexToSVG tex = handle (\(e::SomeException) -> return (failedSvg tex)) $ do
   dvisvgm <- requireExecutable "dvisvgm"
   withTempDir $ \tmp_dir -> withTempFile "tex" $ \tex_file -> withTempFile "svg" $ \svg_file -> do
     let dvi_file = tmp_dir </> replaceExtension (takeFileName tex_file) "dvi"
-    writeFile tex_file tex_prologue
+    writeFile tex_file tex_document
+    appendFile tex_file tex_prologue
     appendFile tex_file tex
     appendFile tex_file tex_epilogue
     runCmd latex ["-interaction=batchmode", "-halt-on-error", "-output-directory="++tmp_dir, tex_file]
@@ -79,7 +94,29 @@ latexToSVG tex = handle (\(e::SomeException) -> return (failedSvg tex)) $ do
                    ,"--verbosity=0", "-o",svg_file]
     svg_data <- B.readFile svg_file
     case parseSvgFile svg_file svg_data of
-      Nothing -> error "Malformed svg"
+      Nothing  -> error "Malformed svg"
+      Just svg -> return $ unbox $ replaceUses svg
+
+xelatexToSVG :: String -> IO Tree
+xelatexToSVG tex = handle (\(e::SomeException) -> return (failedSvg tex)) $ do
+  latex <- requireExecutable "xelatex"
+  dvisvgm <- requireExecutable "dvisvgm"
+  withTempDir $ \tmp_dir -> withTempFile "tex" $ \tex_file -> withTempFile "svg" $ \svg_file -> do
+    let dvi_file = tmp_dir </> replaceExtension (takeFileName tex_file) "xdv"
+    writeFile tex_file tex_document
+    appendFile tex_file tex_xelatex
+    appendFile tex_file tex_prologue
+    appendFile tex_file tex
+    appendFile tex_file tex_epilogue
+    runCmd latex ["-no-pdf", "-interaction=batchmode", "-halt-on-error", "-output-directory="++tmp_dir, tex_file]
+    runCmd dvisvgm [ dvi_file
+                   , "--exact"    -- better bboxes.
+                   -- , "--bbox=1,1" -- increase bbox size.
+                   , "--no-fonts" -- use glyphs instead of fonts.
+                   ,"--verbosity=0", "-o",svg_file]
+    svg_data <- B.readFile svg_file
+    case parseSvgFile svg_file svg_data of
+      Nothing  -> error "Malformed svg"
       Just svg -> return $ unbox $ replaceUses svg
 
 failedSvg :: String -> Tree
@@ -87,9 +124,11 @@ failedSvg tex = defaultSvg
   -- text_ [ font_size_ "20"
   --       , fill_ "white"] (toHtml $ "bad latex: "++tex)
 
+tex_document = "\\documentclass[preview]{standalone}\n"
+tex_xelatex =
+  "\\usepackage[UTF8]{ctex}\n"
 tex_prologue =
-  "\\documentclass[preview]{standalone}\n\
+  "\\usepackage[english]{babel}\n\
-  \\\usepackage[english]{babel}\n\
   \\\usepackage{amsmath}\n\
   \\\usepackage{amssymb}\n\
   \\\usepackage{dsfont}\n\
@@ -106,8 +145,6 @@ tex_prologue =
   \\\usepackage{textcomp}\n\
   \\\usepackage{xfrac}\n\
   \\\usepackage{microtype}\n\
-  \\\DisableLigatures{encoding = *, family = * }\n\
-  \%\\usepackage[UTF8]{ctex}\n\
   \\\linespread{1}\n\
   \\\begin{document}\n"
 

src/Reanimate/Monad.hs

@@ -55,7 +55,7 @@ emit svg = Frame $ \_ _ -> modify (.(svg:))
 
 before :: Animation -> Animation -> Animation
 before (Animation d1 (Frame f1)) (Animation d2 (Frame f2)) =
-  Animation (d1+d2) (Frame $ \d t -> if t < d1 then f1 d1 t else f2 d2 (t-d1))
+  Animation (d1+d2) (Frame $ \_ t -> if t < d1 then f1 d1 t else f2 d2 (t-d1))
 
 -- Play two animation concurrently. Shortest animation freezes on last frame.
 sim :: Animation -> Animation -> Animation
@@ -88,6 +88,14 @@ signal :: Double -> Double -> Frame Double
 signal from to = Frame $ \d t -> pure $
   from + (to-from)*(t/d)
 
+signalSCurve :: Double -> Double -> Double -> Frame Double
+signalSCurve steepness from to = do
+  s <- signal 0 1
+  let s' = if s < 0.5
+              then 0.5 * (2*s)**steepness
+              else 1-0.5 * (2 - 2*s)**steepness
+  pure $ from + (to-from)*s'
+
 frameAt :: Double -> Animation -> Tree
 frameAt t (Animation d (Frame f)) = mkGroup $ execState (f d (min d t)) id []
 
@@ -131,3 +139,13 @@ reverseAnimation (Animation d fn) = Animation d $ Frame $ \_dur t ->
 
 autoReverse :: Animation -> Animation
 autoReverse a = a `before` reverseAnimation a
+
+oscillate :: Frame a -> Frame a
+oscillate f = Frame $ \d t -> do
+  if t < d/2
+    then unFrame f d (t*2)
+    else unFrame f d (d*2-t*2)
+
+repeatAnimation :: Double -> Animation -> Animation
+repeatAnimation n (Animation d f) = Animation (d*n) $ Frame $ \_ t ->
+  unFrame f d (t `mod'` d)

src/Reanimate/Svg.hs

@@ -11,6 +11,7 @@ import qualified Data.Map                  as Map
 import           Data.Maybe
 import qualified Data.Text                 as T
 import           Graphics.Svg
+import Codec.Picture.Types
 import           Graphics.Svg.PathParser
 import           Linear.Metric
 import           Linear.V2
@@ -410,6 +411,9 @@ withStrokeColor color = drawAttr %~ strokeColor .~ pure (mkColor color)
 withFillColor :: String -> Tree -> Tree
 withFillColor color = drawAttr %~ fillColor .~ pure (mkColor color)
 
+withFillColorPixel :: PixelRGBA8 -> Tree -> Tree
+withFillColorPixel color = drawAttr %~ fillColor .~ pure (ColorRef color)
+
 withFillOpacity :: Double -> Tree -> Tree
 withFillOpacity opacity = drawAttr %~ fillOpacity .~ Just (realToFrac opacity)
 
@@ -460,6 +464,10 @@ mkLinePath ((startX, startY):rest) =
 mkBackground :: String -> Tree
 mkBackground color = withFillColor color $ mkRect (Num $ -320/2, Num $ -180/2) (Percent 1) (Percent 1)
 
+mkBackgroundPixel :: PixelRGBA8 -> Tree
+mkBackgroundPixel pixel =
+    withFillColorPixel pixel $ mkRect (Num $ -320/2, Num $ -180/2) (Percent 1) (Percent 1)
+
 withSubglyphs :: [Int] -> (Tree -> Tree) -> Tree -> Tree
 withSubglyphs target fn t = evalState (worker t) 0
   where

web/src/Presets.jsx

@@ -151,8 +151,48 @@ animation = mkAnimation 1 $ do
       withSubglyphs [4] (withFillColor "darkslategrey") $
       svg
   where
-    svg = scale 10 $ center $ latex "\\\\LaTeX"`
+    svg = scale 10 $ center $ latex "\\\\LaTeX"`;
 
+const valentine =
+`animation :: Animation
+animation =
+    all_red \`before\`
+    ( background \`sim\`
+      (backgroundDelay \`before\`
+       foldr1 sim [ pause p \`before\` fallingLove x | (p, x) <- falling ]
+     ) \`sim\`
+      (heart_ani \`before\` heart_disappear) \`sim\`
+      (pause 5 \`before\` message ai)
+    )
+  where
+    falling = [(6.4, 0.09), (4.9, 0.12), (4.5, 0.88), (0.3, 0.43), (5.3, 0.93)
+              ,(0.1, 0.80), (1.1, 0.39), (2.3, 0.21), (2.9, 0.77), (3.4, 0.46)
+              ,(6.2, 0.19), (5.9, 0.53), (3.2, 0.14), (7.7, 0.99) ]
+    ai = center $ xelatex "爱"
+    all_red = mkAnimation 1 $ emit $ mkBackground "red"
+    background = mkAnimation 2 $ do
+      n <- round <$> signal 0 0xFF
+      emit $ mkBackgroundPixel $ PixelRGBA8 0xFF n n 0xFF
+    backgroundDelay = pause (duration background-1)
+    heart_ani = repeatAnimation 10 $ mkAnimation 1 $ do
+      n <- oscillate $ signalSCurve 2 0.9 1.1
+      mapF (scale n) $ drawHeart
+    heart_disappear = mkAnimation 3 $ do
+      n  <- signal 0.9 10
+      mapF (scale n) drawHeart
+    fallingLove xPos = mkAnimation 2 $ do
+      n <- signal (-100) 100
+      o <- oscillate $ signal (-1) 1
+      emit $ scale 2 $ withFillColor "red" $
+        translate ((xPos*2-1)*60) n $ rotate (45*o) ai
+    message txt = mkAnimation 1 $ do
+      o <- oscillate $ signal 0 1
+      n <- oscillate $ signalSCurve 2 0.9 1.1
+      emit $ scale n $ scale 2 $ withFillColor "white" $ withFillOpacity o txt
+
+    drawHeart = emit $ withFillColor "red" $ heartShape
+    hex n = if n < 0x10 then "0" ++ showHex (round n) ""
+            else showHex (round n) ""`;
 
 export default [
   { name: "Examples"
@@ -165,6 +205,7 @@ export default [
     , {name: "Morphwave", code: morph_wave }
     , {name: "Morphwave Circle", code: morph_wave_circle }
     , {name: "Progress meters", code: progressMeters }
+    , {name: "Valentine", code: valentine }
     // , {name: "Highlight", code: highlight }
     ]
   },