module Graphics.UI.Threepenny.Timer (
Timer, timer,
interval, running, tick, start, stop,
) where
import Control.Monad (when, forever, void)
import Control.Event
import Control.Concurrent
import Control.Concurrent.STM
import Graphics.UI.Threepenny.Core
data Timer = Timer
{ tRunning :: TVar Bool
, tInterval :: TVar Int
, tTick :: Event ()
}
timer :: IO Timer
timer = do
tRunning <- newTVarIO False
tInterval <- newTVarIO 1000
(tTick, fire) <- newEvent
forkIO $ forever $ do
wait <- atomically $ do
b <- readTVar tRunning
when (not b) retry
readTVar tInterval
threadDelay (wait * 1000)
fire ()
return $ Timer {..}
tick = tTick
interval :: Attr Timer Int
interval = fromTVar tInterval
running :: Attr Timer Bool
running = fromTVar tRunning
start :: Timer -> IO ()
start = set' running True
stop :: Timer -> IO ()
stop = set' running False
fromTVar :: (x -> TVar a) -> Attr x a
fromTVar f = mkReadWriteAttr
(atomically . readTVar . f)
(\i x -> atomically $ writeTVar (f x) i)
testTimer = do
t <- timer
void $ register (tick t) $ const $ putStr "Hello"
return t
# set interval 1000
# set running True