summaryrefslogtreecommitdiff
path: root/lib/Patat/AutoAdvance.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Patat/AutoAdvance.hs')
-rw-r--r--lib/Patat/AutoAdvance.hs52
1 files changed, 52 insertions, 0 deletions
diff --git a/lib/Patat/AutoAdvance.hs b/lib/Patat/AutoAdvance.hs
new file mode 100644
index 0000000..236e0cb
--- /dev/null
+++ b/lib/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