Update of /cvsroot/htoolkit/gio/src/Graphics/UI/GIO
In directory sc8-pr-cvs1:/tmp/cvs-serv5945/gio/src/Graphics/UI/GIO
Modified Files:
Timer.hs
Log Message:
Efficient implementation for timers
Index: Timer.hs
===================================================================
RCS file: /cvsroot/htoolkit/gio/src/Graphics/UI/GIO/Timer.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Timer.hs 25 Mar 2003 23:37:03 -0000 1.2
--- Timer.hs 26 Mar 2003 02:19:56 -0000 1.3
***************
*** 26,111 ****
--------------------------------------------------------------------}
-- | A timer generates a 'command' event on a specified milli-second 'interval'.
! data Timer = Timer{ vtimer :: Var (Maybe TimerHandle)
! , vinterval :: Var Int
! , vcommand :: Var (Maybe (IO ()))
! , venabled :: Var Bool
! }
-- | Create a new timer with a 1 second interval.
timer :: [Prop Timer] -> IO Timer
timer props
! = do t <- do vtimer <- newVar Nothing
! vinterval <- newVar 1000
! vcommand <- newVar Nothing
! venabled <- newVar True
! return (Timer vtimer vinterval vcommand venabled)
set t props
return t
! -- update the timer state
! updateTimer :: Timer -> IO ()
! updateTimer t
! = do enable <- getVar (venabled t)
! mbcmd <- getVar (vcommand t)
! mbtimer <- getVar (vtimer t)
! case (enable,mbcmd,mbtimer) of
! (True,Just cmd,_)
! -> do case mbtimer of
! Nothing -> return ()
! Just h -> Lib.destroyTimer h
! interv <- getVar (vinterval t)
! htimer <- Lib.createTimer interv cmd
! setVar (vtimer t) (Just htimer)
! (_,_,Just htimer)
! -> do Lib.destroyTimer htimer
! setVar (vtimer t) (Nothing)
! other
! -> return ()
!
! -- | The milli-second interval of the timer.
interval :: Attr Timer Int
! interval
! = newAttr (\t -> getVar (vinterval t))
! (\t i -> do oldi <- getVar (vinterval t)
! when (i /= oldi) (
! do setVar (vinterval t) i
! updateTimer t))
instance Able Timer where
! enabled
! = newAttr getter setter
! where
! getter t
! = do getVar (venabled t)
!
! setter t enable
! = do able <- getVar (venabled t)
! when (able /= enable) (
! do setVar (venabled t) enable
! updateTimer t)
!
instance Commanding Timer where
! command
! = newEvent getter setter setdef
! where
! getter t
! = do mbcmd <- getVar (vcommand t)
! case mbcmd of
! Nothing -> return (return ())
! Just cmd -> return cmd
!
! setter t cmd
! = do setVar (vcommand t) (Just cmd)
! updateTimer t
!
! setdef t
! = do mbtimer <- takeVar (vtimer t)
! case mbtimer of
! Nothing -> return ()
! Just h -> Lib.destroyTimer h
! putVar (vtimer t) Nothing
!
! {--------------------------------------------------------------------
! --------------------------------------------------------------------}
--- 26,51 ----
--------------------------------------------------------------------}
-- | A timer generates a 'command' event on a specified milli-second 'interval'.
! newtype Timer = Timer TimerHandle
!
! getTimerHandle (Timer thandle) = thandle
-- | Create a new timer with a 1 second interval.
timer :: [Prop Timer] -> IO Timer
timer props
! = do vtimer <- Lib.createTimer 1000
! let t = Timer vtimer
set t props
return t
! -- | The milli-second interval of the timer. The interval should be greather than zero.
interval :: Attr Timer Int
! interval = newAttr (Lib.getTimerInterval . getTimerHandle) (Lib.setTimerInterval . getTimerHandle)
instance Able Timer where
! enabled = newAttr (Lib.isTimerEnabled . getTimerHandle) (Lib.enableTimer . getTimerHandle)
instance Commanding Timer where
! command = newEvent (Lib.getTimerHandler . getTimerHandle) (Lib.setTimerHandler . getTimerHandle) (Lib.setTimerDefHandler . getTimerHandle)
! destroyTimer :: Timer -> IO ()
! destroyTimer = Lib.destroyTimer . getTimerHandle
\ No newline at end of file
|
