Add auto advancing

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

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

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

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

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

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
     }