diff --git a/README.md b/README.md index 8adf4eb..58d8398 100644 --- a/README.md +++ b/README.md @@ -35,6 +35,7 @@ Table of Contents - [Running](#running) - [Input format](#input-format) - [Configuration](#configuration) + - [Auto advancing](#auto-advancing) - [Fragmented slides](#fragmented-slides) - [Theming](#theming) - [Syntax Highlighting](#syntax-highlighting) @@ -172,6 +173,24 @@ Or we can use a normal presentation and have the following `$HOME/.patat.yaml`: wrap: true +### Auto advancing + +By setting `autoAdvanceDelay` to a number of seconds, `patat` will automatically +advance to the next slide. + + --- + title: Auto-advance, yes please + author: John Doe + patat: + autoAdvanceDelay: 2 + ... + + Hello World! + + --- + + This slide will be shown two seconds after the presentation starts. + ### Fragmented slides By default, slides are always displayed "all at once". If you want to display diff --git a/patat.cabal b/patat.cabal index 6d87783..5926232 100644 --- a/patat.cabal +++ b/patat.cabal @@ -45,6 +45,7 @@ Executable patat Data.Aeson.Extended Data.Aeson.TH.Extended Data.Data.Extended + Patat.AutoAdvance Patat.Presentation Patat.Presentation.Display Patat.Presentation.Display.CodeBlock diff --git a/src/Main.hs b/src/Main.hs index fa434da..bfeca9c 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -10,19 +10,21 @@ import Control.Applicative ((<$>), (<*>)) import Control.Concurrent (forkIO, threadDelay) import qualified Control.Concurrent.Chan as Chan import Control.Monad (forever, unless, when) +import qualified Data.Aeson.Extended as A import Data.Monoid (mempty, (<>)) import Data.Time (UTCTime) import Data.Version (showVersion) import qualified Options.Applicative as OA +import Patat.AutoAdvance import Patat.Presentation import qualified Paths_patat +import Prelude import qualified System.Console.ANSI as Ansi import System.Directory (doesFileExist, getModificationTime) import System.Exit (exitFailure, exitSuccess) import qualified System.IO as IO import qualified Text.PrettyPrint.ANSI.Leijen as PP -import Prelude -------------------------------------------------------------------------------- @@ -131,11 +133,17 @@ main = do interactiveLoop :: Options -> Presentation -> IO () interactiveLoop options pres0 = do IO.hSetBuffering IO.stdin IO.NoBuffering - commandChan <- Chan.newChan + -- Spawn the initial channel that gives us commands based on user input. + commandChan0 <- Chan.newChan + _ <- forkIO $ forever $ + readPresentationCommand >>= Chan.writeChan commandChan0 - _ <- forkIO $ forever $ - readPresentationCommand >>= Chan.writeChan commandChan + -- If an auto delay is set, use 'autoAdvance' to create a new one. + commandChan <- case psAutoAdvanceDelay (pSettings pres0) of + Nothing -> return commandChan0 + Just (A.FlexibleNum delay) -> autoAdvance delay commandChan0 + -- Spawn a thread that adds 'Reload' commands based on the file time. mtime0 <- getModificationTime (pFilePath pres0) when (oWatch options) $ do _ <- forkIO $ watcher commandChan (pFilePath pres0) mtime0 diff --git a/src/Patat/AutoAdvance.hs b/src/Patat/AutoAdvance.hs new file mode 100644 index 0000000..236e0cb --- /dev/null +++ b/src/Patat/AutoAdvance.hs @@ -0,0 +1,52 @@ +-------------------------------------------------------------------------------- +module Patat.AutoAdvance + ( autoAdvance + ) where + + +-------------------------------------------------------------------------------- +import Control.Concurrent (forkIO, threadDelay) +import qualified Control.Concurrent.Chan as Chan +import Control.Monad (forever) +import qualified Data.IORef as IORef +import Data.Time (diffUTCTime, getCurrentTime) +import Patat.Presentation (PresentationCommand (..)) + + +-------------------------------------------------------------------------------- +-- | This function takes an existing channel for presentation commands +-- (presumably coming from human input) and creates a new one that /also/ sends +-- a 'Forward' command if nothing happens for N seconds. +autoAdvance + :: Int + -> Chan.Chan PresentationCommand + -> IO (Chan.Chan PresentationCommand) +autoAdvance delaySeconds existingChan = do + let delay = delaySeconds * 1000 -- We are working with ms in this function + + newChan <- Chan.newChan + latestCommandAt <- IORef.newIORef =<< getCurrentTime + + -- This is a thread that copies 'existingChan' to 'newChan', and writes + -- whenever the latest command was to 'latestCommandAt'. + _ <- forkIO $ forever $ do + cmd <- Chan.readChan existingChan + getCurrentTime >>= IORef.writeIORef latestCommandAt + Chan.writeChan newChan cmd + + -- This is a thread that waits around 'delay' seconds and then checks if + -- there's been a more recent command. If not, we write a 'Forward'. + _ <- forkIO $ forever $ do + current <- getCurrentTime + latest <- IORef.readIORef latestCommandAt + let elapsed = floor $ 1000 * (current `diffUTCTime` latest) :: Int + if elapsed >= delay + then do + Chan.writeChan newChan Forward + IORef.writeIORef latestCommandAt current + threadDelay (delay * 1000) + else do + let wait = delay - elapsed + threadDelay (wait * 1000) + + return newChan diff --git a/src/Patat/Presentation.hs b/src/Patat/Presentation.hs index f261280..8da5a30 100644 --- a/src/Patat/Presentation.hs +++ b/src/Patat/Presentation.hs @@ -15,7 +15,6 @@ module Patat.Presentation ) where import Patat.Presentation.Display -import Patat.Presentation.Fragment import Patat.Presentation.Interactive import Patat.Presentation.Internal import Patat.Presentation.Read diff --git a/src/Patat/Presentation/Internal.hs b/src/Patat/Presentation/Internal.hs index 0ea1c0d..3554923 100644 --- a/src/Patat/Presentation/Internal.hs +++ b/src/Patat/Presentation/Internal.hs @@ -45,18 +45,21 @@ data PresentationSettings = PresentationSettings , psWrap :: !(Maybe Bool) , psTheme :: !(Maybe Theme.Theme) , psIncrementalLists :: !(Maybe Bool) + , psAutoAdvanceDelay :: !(Maybe (A.FlexibleNum Int)) } deriving (Show) -------------------------------------------------------------------------------- instance Monoid PresentationSettings where - mempty = PresentationSettings Nothing Nothing Nothing Nothing Nothing + mempty = PresentationSettings + Nothing Nothing Nothing Nothing Nothing Nothing mappend l r = PresentationSettings - { psRows = psRows l `mplus` psRows r - , psColumns = psColumns l `mplus` psColumns r - , psWrap = psWrap l `mplus` psWrap r - , psTheme = psTheme l <> psTheme r + { psRows = psRows l `mplus` psRows r + , psColumns = psColumns l `mplus` psColumns r + , psWrap = psWrap l `mplus` psWrap r + , psTheme = psTheme l <> psTheme r , psIncrementalLists = psIncrementalLists l `mplus` psIncrementalLists r + , psAutoAdvanceDelay = psAutoAdvanceDelay l `mplus` psAutoAdvanceDelay r } @@ -68,6 +71,7 @@ defaultPresentationSettings = PresentationSettings , psWrap = Nothing , psTheme = Just Theme.defaultTheme , psIncrementalLists = Nothing + , psAutoAdvanceDelay = Nothing }