module Graphics.UI.Threepenny.Timer (
Timer, timer,
interval, running, tick, start, stop,
) where
import Data.Typeable
import Control.Monad (when, forever, void)
import Control.Concurrent
import Control.Concurrent.STM
import Reactive.Threepenny
import Graphics.UI.Threepenny.Core
data Timer = Timer
{ tRunning :: GetSet Bool Bool
, tInterval :: GetSet Int Int
, tTick :: Event ()
} deriving (Typeable)
timer :: UI Timer
timer = liftIO $ do
tvRunning <- newTVarIO False
tvInterval <- newTVarIO 1000
(tTick, fire) <- newEvent
forkIO $ forever $ do
atomically $ do
b <- readTVar tvRunning
when (not b) retry
wait <- atomically $ readTVar tvInterval
fire ()
threadDelay (wait * 1000)
let tRunning = fromTVar tvRunning
tInterval = fromTVar tvInterval
return $ Timer {..}
tick :: Timer -> Event ()
tick = tTick
interval :: Attr Timer Int
interval = fromGetSet tInterval
running :: Attr Timer Bool
running = fromGetSet tRunning
start :: Timer -> UI ()
start = set' running True
stop :: Timer -> UI ()
stop = set' running False
fromTVar :: TVar a -> GetSet a a
fromTVar var = (atomically $ readTVar var, atomically . writeTVar var)
type GetSet i o = (IO o, i -> IO ())
fromGetSet :: (x -> GetSet i o) -> ReadWriteAttr x i o
fromGetSet f = mkReadWriteAttr (liftIO . fst . f) (\i x -> liftIO $ snd (f x) i)