{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module SDL.Time
  ( -- * Time Measurement
    ticks
  , time

    -- * Timer
  , delay
  , TimerCallback
  , Timer
  , RetriggerTimer(..)
  , addTimer
  , removeTimer
  ) where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Data (Data)
import Data.Typeable
import Data.Word
import Foreign
import GHC.Generics (Generic)

import SDL.Internal.Exception

import qualified SDL.Raw.Timer as Raw
import qualified SDL.Raw.Types as Raw

-- | Number of milliseconds since library initialization.
--
-- See @<https://wiki.libsdl.org/SDL_GetTicks SDL_GetTicks>@ for C documentation.
ticks :: MonadIO m => m Word32
ticks :: forall (m :: Type -> Type). MonadIO m => m Word32
ticks = forall (m :: Type -> Type). MonadIO m => m Word32
Raw.getTicks

-- | The current time in seconds since some arbitrary starting point (consist over the life of the application).
--
-- This time is derived from the system's performance counter - see @<https://wiki.libsdl.org/SDL_GetPerformanceFrequency SDL_GetPerformanceFrequency>@ and @<https://wiki.libsdl.org/SDL_GetPerformanceCounter SDL_GetPerformanceCounter>@ for C documentation about the implementation.
time :: (Fractional a, MonadIO m) => m a
time :: forall a (m :: Type -> Type). (Fractional a, MonadIO m) => m a
time = do
  Word64
freq <- forall (m :: Type -> Type). MonadIO m => m Word64
Raw.getPerformanceFrequency
  Word64
cnt <- forall (m :: Type -> Type). MonadIO m => m Word64
Raw.getPerformanceCounter
  forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
cnt forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
freq

-- | Wait a specified number of milliseconds before returning.
--
-- Users are generally recommended to use 'threadDelay' instead, to take advantage of the abilities of the Haskell runtime.
--
-- See @<https://wiki.libsdl.org/SDL_Delay SDL_Delay>@ for C documentation.
delay :: MonadIO m => Word32 -> m ()
delay :: forall (m :: Type -> Type). MonadIO m => Word32 -> m ()
delay = forall (m :: Type -> Type). MonadIO m => Word32 -> m ()
Raw.delay

-- | 'RetriggerTimer' allows a callback to inform SDL if the timer should be retriggered or cancelled
data RetriggerTimer
  = Reschedule Word32
    -- ^ Retrigger the timer again in a given number of milliseconds.
  | Cancel
    -- ^ Cancel future invocations of this timer.
  deriving (Typeable RetriggerTimer
RetriggerTimer -> DataType
RetriggerTimer -> Constr
(forall b. Data b => b -> b) -> RetriggerTimer -> RetriggerTimer
forall a.
Typeable a
-> (forall (c :: Type -> Type).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RetriggerTimer -> u
forall u. (forall d. Data d => d -> u) -> RetriggerTimer -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RetriggerTimer -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RetriggerTimer -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RetriggerTimer -> m RetriggerTimer
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RetriggerTimer -> m RetriggerTimer
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RetriggerTimer
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RetriggerTimer -> c RetriggerTimer
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RetriggerTimer)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RetriggerTimer)
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RetriggerTimer -> m RetriggerTimer
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RetriggerTimer -> m RetriggerTimer
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RetriggerTimer -> m RetriggerTimer
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RetriggerTimer -> m RetriggerTimer
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RetriggerTimer -> m RetriggerTimer
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> RetriggerTimer -> m RetriggerTimer
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RetriggerTimer -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RetriggerTimer -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RetriggerTimer -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RetriggerTimer -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RetriggerTimer -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RetriggerTimer -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RetriggerTimer -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RetriggerTimer -> r
gmapT :: (forall b. Data b => b -> b) -> RetriggerTimer -> RetriggerTimer
$cgmapT :: (forall b. Data b => b -> b) -> RetriggerTimer -> RetriggerTimer
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RetriggerTimer)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RetriggerTimer)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RetriggerTimer)
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RetriggerTimer)
dataTypeOf :: RetriggerTimer -> DataType
$cdataTypeOf :: RetriggerTimer -> DataType
toConstr :: RetriggerTimer -> Constr
$ctoConstr :: RetriggerTimer -> Constr
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RetriggerTimer
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RetriggerTimer
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RetriggerTimer -> c RetriggerTimer
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RetriggerTimer -> c RetriggerTimer
Data, RetriggerTimer -> RetriggerTimer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RetriggerTimer -> RetriggerTimer -> Bool
$c/= :: RetriggerTimer -> RetriggerTimer -> Bool
== :: RetriggerTimer -> RetriggerTimer -> Bool
$c== :: RetriggerTimer -> RetriggerTimer -> Bool
Eq, forall x. Rep RetriggerTimer x -> RetriggerTimer
forall x. RetriggerTimer -> Rep RetriggerTimer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RetriggerTimer x -> RetriggerTimer
$cfrom :: forall x. RetriggerTimer -> Rep RetriggerTimer x
Generic, Eq RetriggerTimer
RetriggerTimer -> RetriggerTimer -> Bool
RetriggerTimer -> RetriggerTimer -> Ordering
RetriggerTimer -> RetriggerTimer -> RetriggerTimer
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RetriggerTimer -> RetriggerTimer -> RetriggerTimer
$cmin :: RetriggerTimer -> RetriggerTimer -> RetriggerTimer
max :: RetriggerTimer -> RetriggerTimer -> RetriggerTimer
$cmax :: RetriggerTimer -> RetriggerTimer -> RetriggerTimer
>= :: RetriggerTimer -> RetriggerTimer -> Bool
$c>= :: RetriggerTimer -> RetriggerTimer -> Bool
> :: RetriggerTimer -> RetriggerTimer -> Bool
$c> :: RetriggerTimer -> RetriggerTimer -> Bool
<= :: RetriggerTimer -> RetriggerTimer -> Bool
$c<= :: RetriggerTimer -> RetriggerTimer -> Bool
< :: RetriggerTimer -> RetriggerTimer -> Bool
$c< :: RetriggerTimer -> RetriggerTimer -> Bool
compare :: RetriggerTimer -> RetriggerTimer -> Ordering
$ccompare :: RetriggerTimer -> RetriggerTimer -> Ordering
Ord, ReadPrec [RetriggerTimer]
ReadPrec RetriggerTimer
Int -> ReadS RetriggerTimer
ReadS [RetriggerTimer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RetriggerTimer]
$creadListPrec :: ReadPrec [RetriggerTimer]
readPrec :: ReadPrec RetriggerTimer
$creadPrec :: ReadPrec RetriggerTimer
readList :: ReadS [RetriggerTimer]
$creadList :: ReadS [RetriggerTimer]
readsPrec :: Int -> ReadS RetriggerTimer
$creadsPrec :: Int -> ReadS RetriggerTimer
Read, Int -> RetriggerTimer -> ShowS
[RetriggerTimer] -> ShowS
RetriggerTimer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RetriggerTimer] -> ShowS
$cshowList :: [RetriggerTimer] -> ShowS
show :: RetriggerTimer -> String
$cshow :: RetriggerTimer -> String
showsPrec :: Int -> RetriggerTimer -> ShowS
$cshowsPrec :: Int -> RetriggerTimer -> ShowS
Show, Typeable)

-- | A 'TimerCallback' is called with the interval size of the callback. It can return information as to whether or not the timer should continue to exist.
type TimerCallback = Word32 -> IO RetriggerTimer

-- | A timer created by 'addTimer'. This 'Timer' can be removed with 'removeTimer'.
newtype Timer =
  Timer {Timer -> IO Bool
runTimerRemoval :: IO Bool}

-- | Set up a callback function to be run on a separate thread after the specified number of milliseconds has elapsed.
--
-- See @<https://wiki.libsdl.org/SDL_AddTimer SDL_AddTimer>@ for C documentation.
addTimer :: MonadIO m => Word32 -> TimerCallback -> m Timer
addTimer :: forall (m :: Type -> Type).
MonadIO m =>
Word32 -> TimerCallback -> m Timer
addTimer Word32
timeout TimerCallback
callback = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    TimerCallback
cb <- (Word32 -> Ptr () -> IO Word32) -> IO TimerCallback
Raw.mkTimerCallback Word32 -> Ptr () -> IO Word32
wrappedCb
    TimerID
tid <- forall a (m :: Type -> Type).
(Eq a, MonadIO m, Num a) =>
Text -> Text -> m a -> m a
throwIf0 Text
"addTimer" Text
"SDL_AddTimer" forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type).
MonadIO m =>
Word32 -> TimerCallback -> Ptr () -> m TimerID
Raw.addTimer Word32
timeout TimerCallback
cb forall a. Ptr a
nullPtr
    forall (m :: Type -> Type) a. Monad m => a -> m a
return (IO Bool -> Timer
Timer forall a b. (a -> b) -> a -> b
$ TimerCallback -> TimerID -> IO Bool
auxRemove TimerCallback
cb TimerID
tid)
  where
    wrappedCb :: Word32 -> Ptr () -> IO Word32
    wrappedCb :: Word32 -> Ptr () -> IO Word32
wrappedCb Word32
w Ptr ()
_ = do
      RetriggerTimer
next <- TimerCallback
callback Word32
w
      forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case RetriggerTimer
next of
        RetriggerTimer
Cancel       -> Word32
0
        Reschedule Word32
n -> Word32
n

    auxRemove :: Raw.TimerCallback -> Raw.TimerID -> IO Bool
    auxRemove :: TimerCallback -> TimerID -> IO Bool
auxRemove TimerCallback
cb TimerID
tid = do
      Bool
isSuccess <- forall (m :: Type -> Type). MonadIO m => TimerID -> m Bool
Raw.removeTimer TimerID
tid
      if (Bool
isSuccess)
        then forall a. FunPtr a -> IO ()
freeHaskellFunPtr TimerCallback
cb forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
True
        else forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False

-- | Remove a 'Timer'.
--
-- See @<https://wiki.libsdl.org/SDL_RemoveTimer SDL_RemoveTimer>@ for C documentation.
removeTimer :: MonadIO m => Timer -> m Bool
removeTimer :: forall (m :: Type -> Type). MonadIO m => Timer -> m Bool
removeTimer Timer
f = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Timer -> IO Bool
runTimerRemoval Timer
f