{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
module SDL.Framerate
( Framerate
, Manager(..)
, with
, manager
, set
, delay
, delay_
, minimum
, maximum
, get
, count
, destroyManager
) where
import Control.Exception.Lifted (bracket)
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Control (MonadBaseControl)
import Foreign.Marshal.Alloc (malloc, free)
import Foreign.Ptr (Ptr)
import Prelude hiding (minimum, maximum)
import qualified SDL.Raw.Framerate
newtype Manager = Manager (Ptr SDL.Raw.Framerate.Manager)
deriving (Eq, Show)
type Framerate = Int
with
:: (MonadBaseControl IO m, MonadIO m) => Framerate -> (Manager -> m a) -> m a
with fps act =
bracket manager destroyManager $ \m ->
set m fps >> act m
manager :: MonadIO m => m Manager
manager =
fmap Manager . liftIO $ do
ptr <- malloc
SDL.Raw.Framerate.init ptr
return ptr
minimum :: Framerate
minimum = SDL.Raw.Framerate.FPS_LOWER_LIMIT
maximum :: Framerate
maximum = SDL.Raw.Framerate.FPS_UPPER_LIMIT
set :: MonadIO m => Manager -> Framerate -> m ()
set (Manager ptr) = void . set' . min maximum . max minimum
where
set' = SDL.Raw.Framerate.setFramerate ptr . fromIntegral
get :: MonadIO m => Manager -> m Framerate
get (Manager ptr) = fromIntegral <$> SDL.Raw.Framerate.getFramerate ptr
count :: MonadIO m => Manager -> m Int
count (Manager ptr) = fromIntegral <$> SDL.Raw.Framerate.getFramecount ptr
delay :: MonadIO m => Manager -> m Int
delay (Manager ptr) = fromIntegral <$> SDL.Raw.Framerate.framerateDelay ptr
delay_ :: MonadIO m => Manager -> m ()
delay_ = void . delay
destroyManager :: MonadIO m => Manager -> m ()
destroyManager (Manager ptr) = liftIO $ free ptr