Add two more (in-progress) videos.

Former-commit-id: 77c27c81c6eaaa4410a21d053dc4d32185860719

videos/bakers-algorithm/bakers-algorithm.hs

@@ -0,0 +1,102 @@
+#!/usr/bin/env stack
+-- stack --resolver lts-13.14 runghc --package reanimate
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Main (main) where
+
+import           Control.Lens
+
+import           Graphics.SvgTree
+import           Reanimate.Driver (reanimate)
+import           Reanimate.LaTeX
+import           Reanimate.Monad
+import           Reanimate.Svg
+import           Reanimate.Signal
+
+{- Script
+
+Computer memory is a finite resource: If it is not reused, it'll eventually
+run out.
+
+
+
+-}
+
+-- screen width 320
+-- screen height 180
+{-
+[flat (1/3) 0, linear (1/3) 0 1, linear (1/3) 1 0]
+-}
+main :: IO ()
+main = reanimate $ pauseAtEnd 2
+  (mkAnimation 0 $ emit $ mkBackground "black") `sim`
+  drawBox
+
+drawBox :: Animation
+drawBox = mkAnimation 5 $ do
+  emit $ withFillColor "white" $
+    translate 0 (-70) $
+    scale 2 $ center $ latex "Baker's Algorithm"
+  s <- getSignal $ signalFromList    [(0.7, signalFlat 0), (1, signalLinear)]
+  d <- getSignal $ signalFromList    [(0.7, signalFlat 0), (1, signalLinear)]
+  draw <- getSignal $ signalFromList [(0.5, signalLinear), (1, signalFlat 1)]
+  let mlc = MemoryLineChart
+        { mlcWidth = 230
+        , mlcHeight = 50 + s*50
+        , mlcDivider = d
+        , mlcOuterBox = draw }
+  emit $ translate 0 20 $ renderMemoryLineChart mlc
+
+highlightBox :: Animation
+highlightBox = mkAnimation 2 $ do
+  emit $ withFillColor "white" $
+    translate 0 (-70) $
+    scale 2 $ center $ latex "Highlightbox"
+  let boxX = negate mlcWidth / 2
+      boxY = negate mlcHeight / 2
+      mlcWidth = 230
+      mlcHeight = 50
+  s <- getSignal $ signalFromList    [(0.0, signalFlat 0), (1, signalBell 2)]
+  emit $
+    withStrokeColor "white" $
+    withStrokeWidth (Num $ 0.5 + s) $
+    withFillOpacity 0 $
+    translate (boxX + mlcWidth/2) (boxY + mlcHeight/2) $
+    mkRect (Num mlcWidth) (Num mlcHeight)
+
+data MemoryLineChart = MemoryLineChart
+  { mlcWidth  :: Double
+  , mlcHeight :: Double
+  , mlcDivider :: Double -- 0 -> 1
+  , mlcOuterBox :: Double -- 0 -> 1
+  }
+
+mlcBox :: MemoryLineChart -> (Double, Double, Double, Double)
+mlcBox MemoryLineChart{..} = (boxX, boxY, mlcWidth, mlcHeight)
+  where
+    boxX = negate mlcWidth / 2
+    boxY = negate mlcHeight / 2
+
+renderMemoryLineChart :: MemoryLineChart -> Tree
+renderMemoryLineChart MemoryLineChart{..} = mkGroup
+    [ withStrokeColor "white" $
+      withStrokeWidth (Num 0.5) $
+      withFillOpacity 0 $
+      partialSvg mlcOuterBox $ pathify $
+      translate (boxX + mlcWidth/2) (boxY + mlcHeight/2) $
+      mkRect (Num mlcWidth) (Num mlcHeight)
+    , withStrokeColor "white" $
+      withStrokeWidth (Num 0.5) $
+      mkLine (Num (negate $ mlcWidth/2), Num 0)
+             (Num (negate (mlcWidth/2) + lineWidth), Num 0)
+    , withFillColor "white" $
+      translate (negate (mlcWidth/2) - 10) 0 $ rotate (-90) $
+      center $ latex "Memory"
+    , withFillColor "white" $
+      translate 0 (mlcHeight/2 + 10) $
+      center $ latex "Time $\\rightarrow$"
+    ]
+  where
+    boxX = negate mlcWidth / 2
+    boxY = negate mlcHeight / 2
+    lineWidth = mlcDivider * mlcWidth