Add a type: matrix transition effect (#168)

Loosely inspired by the 1999 science fiction movie.

CHANGELOG.md

@@ -21,6 +21,9 @@
      -   `wrap: raw` becomes `container: none`
      -   `wrap: rawInline` becomes `container: inline`
 
+ *  Add a `type: matrix` transition effect, loosely inspired by the 1999 science
+    fiction movie.
+
 ## 0.11.0.0 (2024-02-14)
 
  *  Support wrapping at a specific column (#164)

README.md

@@ -865,6 +865,7 @@ Supported transitions `type`s:
 
  -  `slideLeft`: slides the new slide in from right to left.
  -  `dissolve`: changes characters over time.
+ -  `matrix`: loosely inspired by the 1999 science fiction movie.
 
 All transitions currently take these arguments:
 

lib/Patat/Transition.hs

@@ -29,6 +29,7 @@ import           Data.Traversable            (for)
 import           Patat.Presentation.Settings (TransitionSettings (..))
 import qualified Patat.Transition.Dissolve   as Dissolve
 import           Patat.Transition.Internal
+import qualified Patat.Transition.Matrix     as Matrix
 import qualified Patat.Transition.SlideLeft  as SlideLeft
 import           System.Random               (uniformR)
 
@@ -54,6 +55,7 @@ random items size matrix0 matrix1 rg0 =
 transitions :: NonEmpty (Text, Transition)
 transitions =
     ("dissolve",  Transition Dissolve.transition) :|
+    ("matrix",    Transition Matrix.transition) :
     ("slideLeft", Transition SlideLeft.transition) : []
 
 

lib/Patat/Transition/Matrix.hs

@@ -0,0 +1,128 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE TemplateHaskell #-}
+module Patat.Transition.Matrix
+    ( transition
+    ) where
+
+
+--------------------------------------------------------------------------------
+import           Control.Monad             (forM_, guard, when)
+import qualified Data.Aeson.Extended       as A
+import qualified Data.Aeson.TH.Extended    as A
+import           Data.Bifunctor            (first)
+import qualified Data.Vector               as V
+import qualified Data.Vector.Mutable       as VM
+import           Patat.PrettyPrint.Matrix
+import           Patat.Size                (Size (..))
+import           Patat.Transition.Internal
+import           System.Random.Stateful
+
+
+--------------------------------------------------------------------------------
+data Config = Config
+    { cDuration  :: Maybe (A.FlexibleNum Double)
+    , cFrameRate :: Maybe (A.FlexibleNum Int)
+    }
+
+
+--------------------------------------------------------------------------------
+data Particle = Particle
+    { pX        :: Double
+    , pInitialY :: Double
+    , pFinalY   :: Double
+    , pSpeed    :: Double
+    , pCell     :: Cell
+    }
+
+
+--------------------------------------------------------------------------------
+particleY :: Particle -> Double -> Double
+particleY p t = pInitialY p * (1 - t') + pFinalY p * t'
+  where
+    t' = min 1 (pSpeed p * t)
+
+
+--------------------------------------------------------------------------------
+-- | Maximum speed of a particle, expressed as a factor of the minimum speed of
+-- a particle.
+particleMaxSpeed :: Double
+particleMaxSpeed = 2
+
+
+--------------------------------------------------------------------------------
+-- | Number of ghosts a particle leaves behind.  Currently hardcoded but could
+-- be moved to config.
+particleGhosts :: Int
+particleGhosts = 3
+
+
+--------------------------------------------------------------------------------
+transition :: Config -> TransitionGen
+transition config (Size rows cols) initial final rgen =
+    first frame <$>
+    evenlySpacedFrames
+        (A.unFlexibleNum <$> cDuration  config)
+        (A.unFlexibleNum <$> cFrameRate config)
+  where
+    speeds :: V.Vector Double
+    speeds = runStateGen_ rgen $ \g ->
+        V.replicateM (rows * cols) (uniformRM (1, particleMaxSpeed) g)
+
+    up :: V.Vector Bool
+    up = runStateGen_ rgen $ \g ->
+        V.replicateM (rows * cols) (uniformM g)
+
+    ghosts :: Double -> [Double]
+    ghosts baseSpeed =
+        [ baseSpeed * (1 + fromIntegral i / fromIntegral particleGhosts)
+        | i <- [0 .. particleGhosts]
+        ]
+
+    initialParticles :: [Particle]
+    initialParticles = do
+        (x, y, cell) <- posCells initial
+        let idx = y * cols + x
+        speed <- ghosts $ speeds V.! idx
+        pure Particle
+            { pX        = fromIntegral x
+            , pInitialY = fromIntegral y
+            , pFinalY   = if up V.! idx then 0 else fromIntegral rows
+            , pSpeed    = speed
+            , pCell     = cell
+            }
+
+    finalParticles :: [Particle]
+    finalParticles = do
+        (x, y, cell) <- posCells final
+        let idx = y * cols + x
+        speed <- ghosts $ speeds V.! idx
+        pure Particle
+            { pX        = fromIntegral x
+            , pInitialY = if up V.! idx then -1 else fromIntegral rows
+            , pFinalY   = fromIntegral y
+            , pSpeed    = speed
+            , pCell     = cell
+            }
+
+    posCells :: Matrix -> [(Int, Int, Cell)]
+    posCells mat = do
+        y <- [0 .. rows - 1]
+        x <- [0 .. cols - 1]
+        let cell = mat V.! (y * cols + x)
+        guard . not $ cell == emptyCell
+        pure (x, y, cell)
+
+    frame :: Double -> Matrix
+    frame t = V.create $ do
+        mat <- VM.replicate (rows * cols) emptyCell
+        forM_ (initialParticles ++ finalParticles) $ \particle ->
+            let y = round $ particleY particle t
+                x = round $ pX particle
+                idx = y * cols + x in
+            when (x >= 0 && x < cols && y >= 0 && y < rows) $
+                VM.write mat idx $ pCell particle
+        pure mat
+
+
+--------------------------------------------------------------------------------
+$(A.deriveFromJSON A.dropPrefixOptions ''Config)

patat.cabal

@@ -97,6 +97,7 @@ Library
     Patat.Transition
     Patat.Transition.Internal
     Patat.Transition.Dissolve
+    Patat.Transition.Matrix
     Patat.Transition.SlideLeft
 
   Other-modules: