diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # Changelog +## 0.10.1.0 (2023-10-15) + + * Add dissolve transition effect (#150) + + * Add random transitions (#151) + + Set transition `type` to `random` to randomly sample transition effects + ## 0.10.0.0 (2023-10-12) * Add transition effects (#149) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -803,11 +803,31 @@ Supported transitions `type`s: - `slideLeft`: slides the new slide in from right to left. + - `dissolve`: changes characters over time. - Arguments: +All transitions currently take these arguments: - - `frameRate`: number of frames per second. Defaults to 24. - - `duration`: duration of the animation in seconds. Defaults to 1. + - `frameRate`: number of frames per second. Defaults to 24. + - `duration`: duration of the animation in seconds. Defaults to 1. + +#### Random transitions + +You can set `type` to `random` to randomly pick a transition effect. + +```yaml +patat: + transition: + type: random + items: + - type: dissolve + duration: 3 + - type: slideLeft + frameRate: 10 +``` + +You can optionally set `items` to a non-empty list of transition effects to +randomly sample from. If `items` is not set, `patat` will simply sample from +all transition effects using their respective default settings. Trivia ------ diff --git a/lib/Data/Aeson/Extended.hs b/lib/Data/Aeson/Extended.hs --- a/lib/Data/Aeson/Extended.hs +++ b/lib/Data/Aeson/Extended.hs @@ -3,12 +3,14 @@ ( module Data.Aeson , FlexibleNum (..) + + , resultToEither ) where import Data.Aeson -import qualified Data.Text as T +import qualified Data.Text as T import Prelude -import Text.Read (readMaybe) +import Text.Read (readMaybe) -- | This can be parsed from a JSON string in addition to a JSON number. newtype FlexibleNum a = FlexibleNum {unFlexibleNum :: a} @@ -19,3 +21,7 @@ Nothing -> fail $ "Could not parse " ++ T.unpack str ++ " as a number" Just x -> return (FlexibleNum x) parseJSON val = FlexibleNum <$> parseJSON val + +resultToEither :: Result a -> Either String a +resultToEither (Success x) = Right x +resultToEither (Error err) = Left err diff --git a/lib/Patat/Main.hs b/lib/Patat/Main.hs --- a/lib/Patat/Main.hs +++ b/lib/Patat/Main.hs @@ -13,8 +13,7 @@ import Control.Concurrent.Chan.Extended (Chan) import qualified Control.Concurrent.Chan.Extended as Chan import Control.Exception (bracket) -import Control.Monad (forever, join, unless, void, - when) +import Control.Monad (forever, unless, void, when) import qualified Data.Aeson.Extended as A import Data.Foldable (for_) import Data.Functor (($>)) diff --git a/lib/Patat/Presentation/Read.hs b/lib/Patat/Presentation/Read.hs --- a/lib/Patat/Presentation/Read.hs +++ b/lib/Patat/Presentation/Read.hs @@ -16,7 +16,7 @@ import Control.Monad.Except (ExceptT (..), runExceptT, throwError) import Control.Monad.Trans (liftIO) -import qualified Data.Aeson as A +import qualified Data.Aeson.Extended as A import qualified Data.Aeson.KeyMap as AKM import Data.Bifunctor (first) import Data.Maybe (fromMaybe) @@ -166,13 +166,9 @@ Nothing -> Right mempty Just (Left err) -> Left err Just (Right (A.Object obj)) | Just val <- AKM.lookup "patat" obj -> - resultToEither $! A.fromJSON val + first (\err -> "Error parsing patat settings from metadata: " ++ err) $! + A.resultToEither $! A.fromJSON val Just (Right _) -> Right mempty - where - resultToEither :: A.Result a -> Either String a - resultToEither (A.Success x) = Right x - resultToEither (A.Error e) = Left $! - "Error parsing patat settings from metadata: " ++ e -------------------------------------------------------------------------------- diff --git a/lib/Patat/Transition.hs b/lib/Patat/Transition.hs --- a/lib/Patat/Transition.hs +++ b/lib/Patat/Transition.hs @@ -1,5 +1,9 @@ -------------------------------------------------------------------------------- +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Patat.Transition ( Duration (..) , threadDelayDuration @@ -13,30 +17,70 @@ -------------------------------------------------------------------------------- -import qualified Data.Aeson as A +import qualified Data.Aeson.Extended as A +import qualified Data.Aeson.TH.Extended as A +import Data.Bifunctor (first) import qualified Data.HashMap.Strict as HMS +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NonEmpty import Data.Text (Text) import qualified Data.Text as T +import Data.Traversable (for) import Patat.Presentation.Settings (TransitionSettings (..)) +import qualified Patat.Transition.Dissolve as Dissolve import Patat.Transition.Internal import qualified Patat.Transition.SlideLeft as SlideLeft +import System.Random (uniformR) -------------------------------------------------------------------------------- -transitions :: HMS.HashMap Text Transition -transitions = HMS.fromList - [ ("slideLeft", Transition SlideLeft.slideLeft) - ] +data RandomTransitionSettings = RandomTransitionSettings + { rtsItems :: Maybe (NonEmpty TransitionSettings) + } -------------------------------------------------------------------------------- +$(A.deriveFromJSON A.dropPrefixOptions ''RandomTransitionSettings) + + +-------------------------------------------------------------------------------- +random :: NonEmpty TransitionGen -> TransitionGen +random items size matrix0 matrix1 rg0 = + let (idx, rg1) = uniformR (0, length items - 1) rg0 in + (items NonEmpty.!! idx) size matrix0 matrix1 rg1 + + +-------------------------------------------------------------------------------- +transitions :: NonEmpty (Text, Transition) +transitions = + ("dissolve", Transition Dissolve.transition) :| + ("slideLeft", Transition SlideLeft.transition) : [] + + +-------------------------------------------------------------------------------- +transitionTable :: HMS.HashMap Text Transition +transitionTable = foldMap (uncurry HMS.singleton) transitions + + +-------------------------------------------------------------------------------- parseTransitionSettings :: TransitionSettings -> Either String TransitionGen -parseTransitionSettings ts = case HMS.lookup ty transitions of - Nothing -> Left $ "unknown transition type: " ++ show ty - Just (Transition f) -> case A.fromJSON (A.Object $ tsParams ts) of - A.Success conf -> Right $ f conf - A.Error err -> Left $ - "could not parse " ++ T.unpack ty ++ " transition: " ++ err +parseTransitionSettings ts + -- Random is treated specially here. + | ty == "random" = fmap random $ do + settings <- A.resultToEither . A.fromJSON . A.Object $ tsParams ts + case rtsItems settings of + -- Items specified: parse those + Just items -> traverse parseTransitionSettings items + -- No items specified: parse default transition settings. + Nothing -> for transitions $ \(typ, _) -> parseTransitionSettings + TransitionSettings {tsType = typ, tsParams = mempty} + -- Found the transition type. + | Just (Transition f) <- HMS.lookup ty transitionTable = + fmap (f $) . first (\err -> + "could not parse " ++ T.unpack ty ++ " transition: " ++ err) . + A.resultToEither . A.fromJSON . A.Object $ tsParams ts + -- Not found, error. + | otherwise = Left $ "unknown transition type: " ++ show ty where - ty = tsType ts + ty = tsType ts diff --git a/lib/Patat/Transition/Dissolve.hs b/lib/Patat/Transition/Dissolve.hs new file mode 100644 --- /dev/null +++ b/lib/Patat/Transition/Dissolve.hs @@ -0,0 +1,49 @@ +-------------------------------------------------------------------------------- +{-# LANGUAGE TemplateHaskell #-} +module Patat.Transition.Dissolve + ( transition + ) where + + +-------------------------------------------------------------------------------- +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 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) + } + + +-------------------------------------------------------------------------------- +transition :: Config -> TransitionGen +transition config (Size rows cols) initial final rgen = + first frame <$> + evenlySpacedFrames + (A.unFlexibleNum <$> cDuration config) + (A.unFlexibleNum <$> cFrameRate config) + where + -- Generate a random number between 0 and 1 for each position. + noise :: V.Vector Double + noise = runStateGen_ rgen $ \g -> + V.replicateM (rows * cols) (uniformRM (0, 1) g) + + -- Select the initial or final value depending on the noise. + frame :: Double -> Matrix + frame t = V.zipWith3 + (\treshold l r -> if t < treshold then l else r) + noise + initial + final + + +-------------------------------------------------------------------------------- +$(A.deriveFromJSON A.dropPrefixOptions ''Config) diff --git a/lib/Patat/Transition/Internal.hs b/lib/Patat/Transition/Internal.hs --- a/lib/Patat/Transition/Internal.hs +++ b/lib/Patat/Transition/Internal.hs @@ -10,6 +10,8 @@ , TransitionInstance (..) , newTransition , stepTransition + + , evenlySpacedFrames ) where @@ -17,6 +19,7 @@ import Control.Concurrent (threadDelay) import qualified Data.Aeson as A import Data.List.NonEmpty (NonEmpty ((:|))) +import Data.Maybe (fromMaybe) import Data.Unique (Unique, newUnique) import qualified Patat.PrettyPrint as PP import Patat.PrettyPrint.Matrix @@ -79,3 +82,20 @@ stepTransition _ trans = case tiFrames trans of _ :| [] -> Nothing _ :| f : fs -> Just trans {tiFrames = f :| fs} + + +-------------------------------------------------------------------------------- +-- | Given an optional duration and frame rate, generate a sequence of evenly +-- spaced frames, represented by a number ranging from [0 .. 1]. +evenlySpacedFrames + :: Maybe Double -> Maybe Int -> NonEmpty (Double, Duration) +evenlySpacedFrames mbDuration mbFrameRate = + frame 0 :| map frame [1 .. frames - 1] + where + duration = fromMaybe 1 mbDuration + frameRate = fromMaybe 24 mbFrameRate + + frames = round $ duration * fromIntegral frameRate :: Int + delay = duration / fromIntegral (frames + 1) + + frame idx = (fromIntegral (idx + 1) / fromIntegral frames, Duration delay) diff --git a/lib/Patat/Transition/SlideLeft.hs b/lib/Patat/Transition/SlideLeft.hs --- a/lib/Patat/Transition/SlideLeft.hs +++ b/lib/Patat/Transition/SlideLeft.hs @@ -1,16 +1,15 @@ -------------------------------------------------------------------------------- {-# LANGUAGE TemplateHaskell #-} module Patat.Transition.SlideLeft - ( slideLeft + ( transition ) where -------------------------------------------------------------------------------- import qualified Data.Aeson.Extended as A import qualified Data.Aeson.TH.Extended as A +import Data.Bifunctor (first) import Data.Foldable (for_) -import Data.List.NonEmpty (NonEmpty ((:|))) -import Data.Maybe (fromMaybe) import qualified Data.Vector as V import qualified Data.Vector.Mutable as VM import Patat.PrettyPrint.Matrix @@ -26,19 +25,15 @@ -------------------------------------------------------------------------------- -slideLeft :: Config -> TransitionGen -slideLeft config (Size rows cols) initial final _rgen = - fmap (\f -> (f, Duration delay)) $ - frame 0 :| map frame [1 .. frames - 1] +transition :: Config -> TransitionGen +transition config (Size rows cols) initial final _rgen = + first frame <$> + evenlySpacedFrames + (A.unFlexibleNum <$> cDuration config) + (A.unFlexibleNum <$> cFrameRate config) where - duration = fromMaybe 1 $ A.unFlexibleNum <$> cDuration config - frameRate = fromMaybe 24 $ A.unFlexibleNum <$> cFrameRate config - - frames = round $ duration * fromIntegral frameRate :: Int - delay = duration / fromIntegral (frames + 1) - - frame :: Int -> Matrix - frame idx = V.create $ do + frame :: Double -> Matrix + frame t = V.create $ do ini <- V.unsafeThaw initial fin <- V.unsafeThaw final mat <- VM.replicate (rows * cols) emptyCell @@ -52,7 +47,7 @@ pure mat where offset = max 0 . min cols . (round :: Double -> Int) $ - fromIntegral (idx + 1) / fromIntegral frames * fromIntegral cols + t * fromIntegral cols -------------------------------------------------------------------------------- diff --git a/patat.cabal b/patat.cabal --- a/patat.cabal +++ b/patat.cabal @@ -1,5 +1,5 @@ Name: patat -Version: 0.10.0.0 +Version: 0.10.1.0 Synopsis: Terminal-based presentations using Pandoc Description: Terminal-based presentations using Pandoc. License: GPL-2 @@ -47,7 +47,7 @@ pandoc >= 3.1 && < 3.2, pandoc-types >= 1.23 && < 1.24, process >= 1.6 && < 1.7, - random >= 1.1 && < 1.3, + random >= 1.2 && < 1.3, skylighting >= 0.10 && < 0.15, terminal-size >= 0.3 && < 0.4, text >= 1.2 && < 2.1, @@ -95,6 +95,7 @@ Patat.Theme Patat.Transition Patat.Transition.Internal + Patat.Transition.Dissolve Patat.Transition.SlideLeft Other-modules: