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 (..))
autoAdvance
:: Int
-> Chan.Chan PresentationCommand
-> IO (Chan.Chan PresentationCommand)
autoAdvance delaySeconds existingChan = do
let delay = delaySeconds * 1000
newChan <- Chan.newChan
latestCommandAt <- IORef.newIORef =<< getCurrentTime
_ <- forkIO $ forever $ do
cmd <- Chan.readChan existingChan
getCurrentTime >>= IORef.writeIORef latestCommandAt
Chan.writeChan newChan cmd
_ <- 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