{-# Language ScopedTypeVariables #-}
module Terminal.Game.Layer.Imperative where
import Terminal.Game.Layer.Object
import qualified Control.Monad.Reader as R
import qualified Control.Concurrent as CC
import qualified Control.Monad as CM
import Terminal.Game.Plane
type Game m a = R.ReaderT Config m a
data Config = Config { cMEvents :: CC.MVar [Event],
cFPS :: FPS }
runGame :: forall s m. MonadGameIO m =>
s
-> (s -> Event -> s)
-> (s -> Plane)
-> (s -> Bool)
-> FPS
-> m s
runGame s lf df qf fps =
startEvents fps >>= \ve ->
R.runReaderT game (Config ve fps)
where
game :: MonadGameIO m => Game m s
game = R.ask >>= \c ->
R.lift (setupDisplay
(gameLoop c s lf df qf Nothing (0,0)
(initFPSCounter 10)))
gameLoop :: MonadGameIO m =>
Config ->
s ->
(s -> Event -> s) ->
(s -> Plane) ->
(s -> Bool) ->
Maybe Plane ->
(Width, Height) ->
FPSCounter ->
m s
gameLoop c s lf df qf opln td fc =
pollEvents (cMEvents c) >>= \es ->
if qf s
then return s
else
if null es
then sleepABit (cFPS c) >>
gameLoop c s lf df qf opln td fc
else
let s' = stepsLogic s lf es in
displaySize >>= \td'@(tw, th) ->
let resc = td /= td' in
CM.when resc clearDisplay >>
let opln' | resc = Nothing
| otherwise = opln
npln = df s'
cFps = getCurrFPS fc in
blitPlane tw th opln' npln cFps >>
tickCounter fc >>= \fc' ->
gameLoop c s' lf df qf (Just npln) td' fc'
stepsLogic :: s -> (s -> Event -> s) -> [Event] -> s
stepsLogic s lf es = foldl lf s es
data FPSCounter = FPSCounter Integer Integer Integer Integer
initFPSCounter :: Integer -> FPSCounter
initFPSCounter x = FPSCounter x 0 0 0
tickCounter :: MonadGameIO m => FPSCounter -> m FPSCounter
tickCounter (FPSCounter g e t1 cf)
| g > e = return (FPSCounter g (e+1) t1 cf)
| g == e = getTime >>= \t2 ->
let dtn = t2 - t1
fr = fi dtn / fi (g+1)
fps = round $ fi (10^(9::Integer)) / fr in
return (FPSCounter g 0 t2 fps)
| otherwise = error "tickCounter: g < e"
where
fi :: Integer -> Double
fi = fromIntegral
getCurrFPS :: FPSCounter -> Integer
getCurrFPS (FPSCounter _ _ _ cFps) = cFps