{-# LANGUAGE DeriveGeneric #-} -------------------------------------------------------------------------------- -- | -- Module : Control.Timer.Tick -- Copyright : (C) 2018 Francesco Ariis -- License : BSD3 (see LICENSE file) -- -- Maintainer : Francesco Ariis -- Stability : provisional -- Portability : portable -- -- Timers and timed resources (animations, etc.) utilities for tick-based -- programs. -- -------------------------------------------------------------------------------- module Control.Timer.Tick ( -- * Simple timers creaTimer, Timer, -- * Timed Resources TimedRes, creaTimedRes, Loop(..), -- * Use tick, ticks, reset, -- * Query isLive, isExpired, fetch ) where import GHC.Generics (Generic) ----------- -- TYPES -- ----------- -- | A timed resource is a timer which, at any given moment, points to -- a specific item (like an animation). -- -- Example: -- -- @ -- run = creaTimedRes (Times 1) [(2, "a "), (1, "b "), (2, "c ")] -- main = count run -- where -- count t | isExpired t = putStrLn "\nOver!" -- | otherwise = do putStr (fetch t) -- count (tick t) -- -- λ> main -- -- a a b c c -- -- Over! -- @ data TimedRes a = TimedRes { -- init tSteps :: [TimerStep a], tLoop :: Loop, tOrigLoop :: Loop, -- convenience tMaxTicks :: Integer, -- curr tCurrTick :: Integer, tExpired :: Bool } deriving (Show, Eq, Generic) type TimerStep a = (Integer, a) -- | Number of times to repeat the animation. data Loop = Times Integer -- currentLoop and maxLoop | AlwaysLoop deriving (Show, Eq) -- todo Monoid (or semigroup) <> for timers [2.0] ------------ -- CREATE -- ------------ type Timer = TimedRes () -- | Creates a 'Timer' expiring in @x@ ticks. -- -- Example: -- -- @ -- main = count (creaTimer 4) -- where -- count t | isExpired t = putStrLn "Over!" -- | otherwise = do putStrLn "Ticking." -- count (tick t) -- -- -- λ> main -- -- Ticking. -- -- Ticking. -- -- Ticking. -- -- Ticking. -- -- Over! -- @ creaTimer :: Integer -> Timer creaTimer c = creaTimedRes (Times 1) [(c, ())] -- | Creates a time-based resource, like an animation. creaTimedRes :: Loop -> [(Integer, a)] -> TimedRes a creaTimedRes _ [] = error "Cannot create an empty TimedRes" creaTimedRes l ss = TimedRes ss l l (sum . map fst $ ss) 0 False ------------- -- OPERATE -- ------------- -- | Ticks the timer (one step). tick :: TimedRes a -> TimedRes a tick t | isExpired t = t | otherwise = let t' = t { tCurrTick = succ (tCurrTick t) } in if tCurrTick t' == tMaxTicks t' then maxed t' else t' where maxed :: TimedRes a -> TimedRes a maxed tm = case tLoop tm of Times 1 -> tm { tLoop = Times 0, tExpired = True } AlwaysLoop -> tm { tCurrTick = 0 } Times n -> tm { tLoop = Times (n-1), tCurrTick = 0 } -- | Ticks the timer (multiple steps). ticks :: Integer -> TimedRes a -> TimedRes a ticks 1 t = tick t ticks n t | n < 1 = error "negative number passed to `ticks`" | otherwise = ticks (n-1) (tick t) -- | Equal to @not isExpired@. isLive :: TimedRes a -> Bool isLive t = not $ tExpired t -- | Checks wheter the timer is expired (an expired timer will not -- respond to 'tick'). isExpired :: TimedRes a -> Bool isExpired t = tExpired t -- | Fetches the current resource of the timer. fetch :: TimedRes a -> a fetch t = bl !! (fromIntegral $ tCurrTick t) where bl = concatMap (\(c, a) -> replicate (fromIntegral c) a) $ tSteps t -- todo having another input apart from []? maybe a function? -- | Resets the timer to its original state. reset :: TimedRes a -> TimedRes a reset t = t { tCurrTick = 0, tExpired = False, tLoop = tOrigLoop t } -- todo elapsed time? ticking time?