{-# LANGUAGE DeriveGeneric #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Control.Timer.Tick
-- Copyright   :  (C) 2018 Francesco Ariis
-- License     :  BSD3 (see LICENSE file)
--
-- Maintainer  :  Francesco Ariis <fa-ml@ariis.it>
-- Stability   :  provisional
-- Portability :  portable
--
-- Timers and timed resources (animations, etc.) utilities for tick-based
-- programs.
--
--------------------------------------------------------------------------------


module Control.Timer.Tick ( -- * Simple timers
                            creaTimer,
                            creaBoolTimer,
                            creaTimerLoop,
                            creaBoolTimerLoop,
                            -- * Timed resources
                            Timed,
                            creaTimedRes,
                            Loop(..),
                            ExpBehaviour(..),
                            -- * Use
                            tick,
                            ticks,
                            reset,
                            lapse,
                            -- * Query
                            isLive,
                            isExpired,
                            fetchFrame,
                            getFrames
                          )


       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:
--
-- @
-- timer = creaTimedRes (Times 1 Elapse) [(2, "a "), (1, "b "), (2, "c ")]
-- test t | isExpired t = putStrLn "Fine."
--        | otherwise   = do putStr (fetchFrame t)
--                           test (tick t)
--
--    -- λ> test timer
--    -- a a b c c Fine.
-- @
--
data Timed a = TimedRes { -- init
                          forall a. Timed a -> [TimerStep a]
tSteps    :: [TimerStep a],
                          forall a. Timed a -> Loop
tLoop     :: Loop,
                          forall a. Timed a -> Loop
tOrigLoop :: Loop,

                          -- convenience
                          forall a. Timed a -> Integer
tLoopTicks   :: Integer,
                          forall a. Timed a -> Maybe Integer
tExpireTicks :: Maybe Integer,

                          --  curr
                          forall a. Timed a -> Integer
tCurrTick :: Integer,
                          forall a. Timed a -> Bool
tExpired  :: Bool
                        }
        deriving (Int -> Timed a -> ShowS
forall a. Show a => Int -> Timed a -> ShowS
forall a. Show a => [Timed a] -> ShowS
forall a. Show a => Timed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timed a] -> ShowS
$cshowList :: forall a. Show a => [Timed a] -> ShowS
show :: Timed a -> String
$cshow :: forall a. Show a => Timed a -> String
showsPrec :: Int -> Timed a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Timed a -> ShowS
Show, Timed a -> Timed a -> Bool
forall a. Eq a => Timed a -> Timed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timed a -> Timed a -> Bool
$c/= :: forall a. Eq a => Timed a -> Timed a -> Bool
== :: Timed a -> Timed a -> Bool
$c== :: forall a. Eq a => Timed a -> Timed a -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Timed a) x -> Timed a
forall a x. Timed a -> Rep (Timed a) x
$cto :: forall a x. Rep (Timed a) x -> Timed a
$cfrom :: forall a x. Timed a -> Rep (Timed a) x
Generic)

type TimerStep a = (Integer, a)

-- | Number of times to repeat the animation.
data Loop = -- | Loops forever, never expires.
            AlwaysLoop
            -- | Repeats the cycle for a fixed number of times.
          | Times Integer ExpBehaviour
     deriving (Int -> Loop -> ShowS
[Loop] -> ShowS
Loop -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Loop] -> ShowS
$cshowList :: [Loop] -> ShowS
show :: Loop -> String
$cshow :: Loop -> String
showsPrec :: Int -> Loop -> ShowS
$cshowsPrec :: Int -> Loop -> ShowS
Show, Loop -> Loop -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Loop -> Loop -> Bool
$c/= :: Loop -> Loop -> Bool
== :: Loop -> Loop -> Bool
$c== :: Loop -> Loop -> Bool
Eq, forall x. Rep Loop x -> Loop
forall x. Loop -> Rep Loop x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Loop x -> Loop
$cfrom :: forall x. Loop -> Rep Loop x
Generic)

-- | Expire behaviour.
data ExpBehaviour =
        -- | Expires upon __reaching__ last frame.
          Reach
        -- | Expires when last frame is __over__.
        | Elapse
    deriving (Int -> ExpBehaviour -> ShowS
[ExpBehaviour] -> ShowS
ExpBehaviour -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpBehaviour] -> ShowS
$cshowList :: [ExpBehaviour] -> ShowS
show :: ExpBehaviour -> String
$cshow :: ExpBehaviour -> String
showsPrec :: Int -> ExpBehaviour -> ShowS
$cshowsPrec :: Int -> ExpBehaviour -> ShowS
Show, ExpBehaviour -> ExpBehaviour -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExpBehaviour -> ExpBehaviour -> Bool
$c/= :: ExpBehaviour -> ExpBehaviour -> Bool
== :: ExpBehaviour -> ExpBehaviour -> Bool
$c== :: ExpBehaviour -> ExpBehaviour -> Bool
Eq, forall x. Rep ExpBehaviour x -> ExpBehaviour
forall x. ExpBehaviour -> Rep ExpBehaviour x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExpBehaviour x -> ExpBehaviour
$cfrom :: forall x. ExpBehaviour -> Rep ExpBehaviour x
Generic)

-- todo Monoid (or semigroup) <> for timers [2.0]

-- | Mapping on frames.
instance Functor Timed where
    fmap :: forall a b. (a -> b) -> Timed a -> Timed b
fmap a -> b
f Timed a
t = Timed a
t { tSteps :: [TimerStep b]
tSteps = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Integer
i, a
a) -> (Integer
i, a -> b
f a
a))
                                 (forall a. Timed a -> [TimerStep a]
tSteps Timed a
t) }

------------
-- CREATE --
------------

-- | A simple off/on timer expiring in fixed number of ticks.
--
-- Example:
--
-- @
-- timer = creaTimer Nothing (Just "Over!") 4
-- test t | isExpired t = print (fetchFrame t)
--        | otherwise   = do print (fetchFrame t)
--                           test (tick t)
--
--    -- λ> test timer
--    -- Nothing
--    -- Nothing
--    -- Nothing
--    -- Nothing
--    -- Just \"Over\"!
-- @
creaTimer :: a -> a -> Integer -> Timed a
creaTimer :: forall a. a -> a -> Integer -> Timed a
creaTimer a
off a
on Integer
i = forall a. Loop -> [(Integer, a)] -> Timed a
creaTimedRes (Integer -> ExpBehaviour -> Loop
Times Integer
1 ExpBehaviour
Reach) [(Integer
i, a
off), (Integer
1, a
on)]

-- | A looped version of 'creaTimer'.
creaTimerLoop :: a -> a -> Integer -> Timed a
creaTimerLoop :: forall a. a -> a -> Integer -> Timed a
creaTimerLoop a
off a
on Integer
i = forall a. Loop -> [(Integer, a)] -> Timed a
creaTimedRes Loop
AlwaysLoop [(Integer
i, a
off), (Integer
1, a
on)]

-- | Shorthand for: @'creaTimer' False True i@.
creaBoolTimer :: Integer -> Timed Bool
creaBoolTimer :: Integer -> Timed Bool
creaBoolTimer Integer
i = forall a. a -> a -> Integer -> Timed a
creaTimer Bool
False Bool
True Integer
i

-- | Shorthand for: @'creaTimerLoop' False True i@.
creaBoolTimerLoop :: Integer -> Timed Bool
creaBoolTimerLoop :: Integer -> Timed Bool
creaBoolTimerLoop Integer
i = forall a. a -> a -> Integer -> Timed a
creaTimerLoop Bool
False Bool
True Integer
i

-- | Most general way to create a time-based resource (like an animation).
-- 'Loop' controls the expiring behaviour, @[(Integer, a)]@ is a list of
-- frames and their duration.
creaTimedRes :: Loop -> [(Integer, a)] -> Timed a
creaTimedRes :: forall a. Loop -> [(Integer, a)] -> Timed a
creaTimedRes Loop
_ [] = forall a. HasCallStack => String -> a
error String
"creaTimedRes: cannot create an empty TimedRes."
creaTimedRes Loop
_ [(Integer, a)]
ss | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Ord a => a -> a -> Bool
<Integer
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Integer, a)]
ss =
                    forall a. HasCallStack => String -> a
error String
"creaTimedRes: cannot have <1 durations."
creaTimedRes (Times Integer
t ExpBehaviour
_) [(Integer, a)]
_ | Integer
t forall a. Ord a => a -> a -> Bool
< Integer
1 =
                    forall a. HasCallStack => String -> a
error String
"creaTimedRes: cannot have non-positive number \
                          \of cycles."
creaTimedRes Loop
l [(Integer, a)]
ss = forall a.
[TimerStep a]
-> Loop
-> Loop
-> Integer
-> Maybe Integer
-> Integer
-> Bool
-> Timed a
TimedRes [(Integer, a)]
ss Loop
l Loop
l
                             Integer
loopTicks Maybe Integer
expTicks
                             Integer
0 Bool
isExp
    where
          loopTicks :: Integer
loopTicks = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ [(Integer, a)]
ss

          expTicks :: Maybe Integer
expTicks = case Loop
l of
                       Loop
AlwaysLoop     -> forall a. Maybe a
Nothing
                       Times Integer
_ ExpBehaviour
Reach  -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init [(Integer, a)]
ss
                       Times Integer
_ ExpBehaviour
Elapse -> forall a. a -> Maybe a
Just Integer
loopTicks

          isExp :: Bool
isExp | forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Integer, a)]
ss forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&&
                  Loop -> Bool
isReach Loop
l         = Bool
True
                | Bool
otherwise         = Bool
False

          isReach :: Loop -> Bool
isReach (Times Integer
_ ExpBehaviour
Reach) = Bool
True
          isReach Loop
_               = Bool
False

-------------
-- OPERATE --
-------------

-- | Ticks the timer (one step).
tick :: Timed a -> Timed a
tick :: forall a. Timed a -> Timed a
tick Timed a
t | forall a. Timed a -> Bool
isExpired Timed a
t = Timed a
t
       | Bool
willExpire  = forall a. Timed a -> Timed a
expire Timed a
t'
       | Bool
willLoop    = forall a. Timed a -> Timed a
loop Timed a
t'
       | Bool
otherwise   = Timed a
t'
    where
          newTicks :: Integer
newTicks = forall a. Timed a -> Integer
tCurrTick Timed a
t forall a. Num a => a -> a -> a
+ Integer
1
          t' :: Timed a
t'       = Timed a
t { tCurrTick :: Integer
tCurrTick = Integer
newTicks }

          willExpire :: Bool
willExpire = case forall a. Timed a -> Loop
tLoop Timed a
t of
                         Times Integer
1 ExpBehaviour
_ -> forall a. a -> Maybe a
Just Integer
newTicks forall a. Eq a => a -> a -> Bool
== forall a. Timed a -> Maybe Integer
tExpireTicks Timed a
t
                         Loop
_         -> Bool
False
          willLoop :: Bool
willLoop   = Bool -> Bool
not Bool
willExpire Bool -> Bool -> Bool
&&
                       Integer
newTicks forall a. Eq a => a -> a -> Bool
== forall a. Timed a -> Integer
tLoopTicks Timed a
t

loop :: Timed a -> Timed a
loop :: forall a. Timed a -> Timed a
loop Timed a
tm = case forall a. Timed a -> Loop
tLoop Timed a
tm of
            Loop
AlwaysLoop -> Timed a
tm { tCurrTick :: Integer
tCurrTick = Integer
0 }
            -- il check è già dentro a tick
            Times Integer
n ExpBehaviour
eb -> Timed a
tm { tLoop :: Loop
tLoop = Integer -> ExpBehaviour -> Loop
Times (Integer
nforall a. Num a => a -> a -> a
-Integer
1) ExpBehaviour
eb,
                               tCurrTick :: Integer
tCurrTick = Integer
0 }

expire :: Timed a -> Timed a
expire :: forall a. Timed a -> Timed a
expire Timed a
tm = -- need this as last tick on Elapse is OOB
            if Loop -> Bool
isElB (forall a. Timed a -> Loop
tLoop Timed a
tm)
              then Timed a
expx { tCurrTick :: Integer
tCurrTick = forall a. Timed a -> Integer
tCurrTick Timed a
tm forall a. Num a => a -> a -> a
- Integer
1 }
              else Timed a
expx
    where
          expx :: Timed a
expx = case forall a. Timed a -> Loop
tLoop Timed a
tm of
                   Times Integer
1 ExpBehaviour
eb  -> Timed a
tm { tLoop :: Loop
tLoop = Integer -> ExpBehaviour -> Loop
Times Integer
0 ExpBehaviour
eb,
                                       tExpired :: Bool
tExpired = Bool
True }
                   Loop
_           -> forall a. HasCallStack => String -> a
error String
"non 1 Times in `expire`."

          isElB :: Loop -> Bool
isElB (Times Integer
_ ExpBehaviour
Elapse) = Bool
True
          isElB Loop
_                = Bool
False

-- | Ticks the timer (multiple steps).
ticks :: Integer -> Timed a -> Timed a
ticks :: forall a. Integer -> Timed a -> Timed a
ticks Integer
1 Timed a
t = forall a. Timed a -> Timed a
tick Timed a
t
ticks Integer
n Timed a
t | Integer
n forall a. Ord a => a -> a -> Bool
< Integer
1     = forall a. HasCallStack => String -> a
error String
"non-positive number passed to `ticks`."
          | Bool
otherwise = forall a. Integer -> Timed a -> Timed a
ticks (Integer
nforall a. Num a => a -> a -> a
-Integer
1) (forall a. Timed a -> Timed a
tick Timed a
t)

-- | Ticks the timer until 'isExpired' is @True@.
lapse :: Timed a -> Timed a
lapse :: forall a. Timed a -> Timed a
lapse Timed a
t | forall a. Timed a -> Bool
isExpired Timed a
t = Timed a
t
        | Bool
otherwise   = forall a. Timed a -> Timed a
lapse (forall a. Timed a -> Timed a
tick Timed a
t)

-- | Antonym of 'isExpired'.
--
-- > isLive = not isExpired
isLive :: Timed a -> Bool
isLive :: forall a. Timed a -> Bool
isLive Timed a
t = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Timed a -> Bool
tExpired Timed a
t

-- | Checks wheter the timer is expired (an expired timer will not
-- respond to 'tick').
isExpired :: Timed a -> Bool
isExpired :: forall a. Timed a -> Bool
isExpired Timed a
t = forall a. Timed a -> Bool
tExpired Timed a
t

-- | Fetches the current resource of the timer.
fetchFrame :: Timed a -> a
fetchFrame :: forall a. Timed a -> a
fetchFrame Timed a
t = [a]
bl forall a. [a] -> Int -> a
!! forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Timed a -> Integer
tCurrTick Timed a
t)
    where
          bl :: [a]
bl = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Integer
c, a
a) -> forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c) a
a) forall a b. (a -> b) -> a -> b
$ forall a. Timed a -> [TimerStep a]
tSteps Timed a
t

-- | Return a list of all frames plus their duration.
getFrames :: Timed a -> [(Integer, a)]
getFrames :: forall a. Timed a -> [TimerStep a]
getFrames Timed a
t = forall a. Timed a -> [TimerStep a]
tSteps Timed a
t

-- | Resets the timer to its original state.
reset :: Timed a -> Timed a
reset :: forall a. Timed a -> Timed a
reset Timed a
t = Timed a
t { tCurrTick :: Integer
tCurrTick = Integer
0,
              tExpired :: Bool
tExpired = Bool
False,
              tLoop :: Loop
tLoop = forall a. Timed a -> Loop
tOrigLoop Timed a
t }