-------------------------------------------------------------------------------
-- Input/compute/output loop
-- 2017 Francesco Ariis GPLv3
-------------------------------------------------------------------------------

{-# OPTIONS_GHC -fno-warn-type-defaults #-}

module Terminal.Game.GameLoop where

import Terminal.Game.Plane
import Terminal.Game.Input
import Terminal.Game.ANSI
import Terminal.Game.Utils
import Control.Concurrent

import qualified System.IO as SI
import qualified Control.Monad as CM
import qualified System.Console.ANSI as CA
import qualified System.Console.Terminal.Size as TS
import qualified System.Clock as SC
import qualified Control.Exception as E

-- todo [release] [study] no full IO for s, but a
--      jailed IO (provided by a datatype), both for I
--      and for O

-- todo elimina fps ora che li puoi fare on IO

-- | Entry point for the game, should be called in @main@. The two
-- most important functions are the one dealing with logic and the
-- blitting one. Check @alone-in-a-room@ (you can compiler it with
-- @cabal new-build -f examples@) to see a simple game in action.
gameLoop :: String                       -- ^Terminal title.
            -> s                         -- ^Initial state of the game.
            -> (s -> Maybe Char -> IO s) -- ^Logic function.
            -> (s -> Plane)              -- ^Draw function.
            -> (s -> Bool)               -- ^\"Should I quit?" function.
            -> Integer                   -- ^Framerate (in fps).
            -> IO ()
gameLoop t s lf df qf fps =

            E.finally (initPart >> game)
                      cleanAndExit -- this will be run regardless
                                   -- of exception
    where
          initPart :: IO ()
          initPart = -- init
                     SI.hSetBuffering SI.stdout SI.NoBuffering >>
                     SI.hSetBuffering SI.stdin  SI.NoBuffering >>
                     SI.hSetEcho SI.stdin False                >>

                     -- title and initial setup/checks
                     CA.setTitle t >>
                     CA.hideCursor >>
                     blackScreen

          game :: IO ()
          game = -- mvars & fork
                 newMVar 1                          >>= \frameCounter ->
                 newMVar Nothing                    >>= \inputChar ->
                 forkIO (inputAction inputChar)     >>
                 forkIO (incTimer frameCounter fps) >>

                 logicDraw inputChar frameCounter
                           s lf df qf Nothing
                           (initFPSCounter 20) (0,0)


----------------
-- CONCURRENT --
----------------

-- get action char
inputAction :: MVar (Maybe Char) -> IO ()
inputAction mc = -- vedi platform-dep/
                 inputCharTerminal    >>= \c ->
                 swapMVar mc (Just c) >>
                 inputAction mc

-- modifica il timer
incTimer :: MVar Integer -> Integer -> IO ()
incTimer mi fps = modifyMVar_ mi (return . succ) >>
                  threadDelay delayAmount        >>
                  incTimer mi fps
    where
          delayAmount :: Int
          delayAmount = fromIntegral $ div (10^6) fps


-- from http://www.loomsoft.net/resources/alltut/alltut_lesson5.htm
logicDraw :: MVar (Maybe Char) -> MVar Integer -> s -> -- input, ticks, state
             (s -> Maybe Char -> IO s)              -> -- logic function
             (s -> Plane)                           -> -- draw function
             (s -> Bool)                            -> -- quit? function
             Maybe Plane                            -> -- last blitted screen
             FPSCounter                             -> -- FPS counter
             (Width, Height)                        -> -- Term Dimensions
             IO ()
logicDraw mc mi s lf df qf opln fc td =

        -- not to hog CPU cycles
        -- todo come mai 300 così alto? come influenza i timer?
        threadDelay 300 >>

        -- quit?
        if qf s
          then return ()
        else

        -- no tick from timer yet?
        readMVar mi >>= \k ->
        if k <= 0
          then logicDraw mc mi s lf df qf opln fc td
        else

        -- do logic
        readMVarNothing mc                       >>= \c  ->
        modifyMVar mi (\a -> return (a-1, a-1))  >>= \k' ->
        lf s c                                   >>= \s' ->

        -- not enough logic done? Skip blitting
        if  k' > 0
          then logicDraw mc mi s' lf df qf opln fc td
        else

        -- clear screen if resolution change
        screenSize           >>= \td'@(tw, th) ->
        let resc = td /= td' in
        CM.when resc blackScreen    >>

        let opln' | resc = Nothing   -- res changed? restart double buffering
                  | otherwise = opln
            npln  = df s'
            cFps  = getCurrFPS fc     in
        blitPlane tw th opln' npln cFps  >>
        tickCounter fc                   >>= \fc' ->
        logicDraw mc mi s' lf df qf (Just npln) fc' td'


-----------------
-- FPS COUNTER --
-----------------

-- poll fps every x frames, current fps, stored time, current fps
data FPSCounter = FPSCounter Integer Integer SC.TimeSpec Integer

-- poll utctime every x ticks
initFPSCounter :: Integer -> FPSCounter
initFPSCounter x = FPSCounter x 0 0 0

tickCounter :: FPSCounter -> IO FPSCounter
tickCounter (FPSCounter g e t1 cf)
        | g > e  = return (FPSCounter g (e+1) t1 cf)
        | g == e = SC.getTime SC.Monotonic             >>= \t2 ->
                   let dtn = SC.toNanoSecs $ SC.diffTimeSpec t2 t1
                       fr  = fi dtn / fi (g+1)
                       fps = round $ fi (10^9) / fr in
                       --- xxx no div
                   return (FPSCounter g 0 t2 fps)
        | otherwise = error "tickCounter: g < e"
    where
          fi = fromIntegral

getCurrFPS :: FPSCounter -> Integer
getCurrFPS (FPSCounter _ _ _ cFps) = cFps

-----------------
-- ANCILLARIES --
-----------------

-- todo [release] catch any exception in IO and execute this
cleanAndExit :: IO ()
cleanAndExit = CA.setSGR [CA.Reset]     >>
               CA.clearScreen           >>
               CA.setCursorPosition 0 0 >>
               CA.showCursor

readMVarNothing :: MVar (Maybe a) -> IO (Maybe a)
readMVarNothing mvar = readMVar mvar                           >>= \ma ->
                       CM.unless (null ma)
                                 (() <$ swapMVar mvar Nothing) >>
                       return ma

-- turn screen into black
blackScreen :: IO ()
blackScreen = CA.setCursorPosition 0 0 >>
              -- CA.setSGR [CA.Reset,
              --           CA.SetColor CA.Foreground CA.Dull CA.White,
              --           CA.SetColor CA.Background CA.Dull CA.Black] >>
                         -- è dull black che voglio?
              screenSize >>= \(w, h) ->
              CM.replicateM_ (fromIntegral $ w*h) (putChar ' ')