{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE LambdaCase #-}
module Imj.Game.Hamazed.Loop.Run
( run
) where
import Imj.Prelude
import qualified Prelude (putStrLn)
import Control.Monad.IO.Class(MonadIO)
import Control.Monad.Reader.Class(MonadReader)
import Control.Monad.Reader(runReaderT)
import System.Info(os)
import Imj.Game.Hamazed.Env
import Imj.Game.Hamazed.Loop.Create
import Imj.Game.Hamazed.Loop.Event
import Imj.Game.Hamazed.Loop.Render
import Imj.Game.Hamazed.Loop.Update
import Imj.Game.Hamazed.Parameters
import Imj.Game.Hamazed.Types
import Imj.Graphics.Render
import Imj.Graphics.Render.Delta
import Imj.Threading
run :: IO ()
run =
if os == "mingw32"
then
Prelude.putStrLn $ "Windows is not currently supported,"
++ " due to this GHC bug: https://ghc.haskell.org/trac/ghc/ticket/7353."
else
void doRun
doRun :: IO Termination
doRun =
runThenRestoreConsoleSettings
(createEnv >>= runAndWaitForTermination . runReaderT gameWorker)
{-# INLINABLE gameWorker #-}
gameWorker :: (Render e, MonadReader e m, MonadIO m)
=> m ()
gameWorker =
getGameParameters >>= runGameWorker
{-# INLINABLE runGameWorker #-}
runGameWorker :: (Render e, MonadReader e m, MonadIO m)
=> GameParameters
-> m ()
runGameWorker params =
mkInitialState params firstLevel Nothing
>>= \case
Left err -> error err
Right ew -> loop params ew
{-# INLINABLE loop #-}
loop :: (Render e, MonadReader e m, MonadIO m)
=> GameParameters
-> GameState
-> m ()
loop params state = do
liftIO (getEvent state) >>= \evt -> case evt of
(Interrupt _) -> return ()
_ -> do
newState <- liftIO $ update params state evt
when (needsRendering evt) $ render newState
loop params newState