{-# LANGUAGE ExistentialQuantification #-}
module Play.Engine.Scene where
import Prelude hiding (head)
import qualified Play.Engine.MySDL.MySDL as MySDL
import SDL
import Play.Engine.Utils
import Play.Engine.Input
import Play.Engine.Settings
import Control.Monad.Except
data SceneF a
= SceneF
{ scState :: a
, scUpdate
:: Input
-> a
-> Result ([MySDL.Request], (StackCommand, a))
, scRender :: SDL.Renderer -> a -> IO ()
}
data Scene
= forall s. Scene (SceneF s)
mkScene
:: a
-> (Input -> a -> Result (StackCommand, a))
-> (SDL.Renderer -> a -> IO ())
-> Scene
mkScene s u r = Scene (SceneF s (\i a -> fmap pure $ u i a) r)
data StackCommand
= Done
| None
| Push Scene
| Replace Scene
updateScenes :: Input -> Stack Scene -> Result ([MySDL.Request], Stack Scene)
updateScenes input scenes = do
(reqs, (cmd, newState)) <- updateScene input (head scenes)
(reqs,) <$> case cmd of
Done -> case pop scenes of
(_, Nothing) -> throwError ["Unexpected empty stack of states"]
(_, Just rest) -> pure rest
None -> pure $ replace newState scenes
Replace otherState -> pure $ replace otherState scenes
Push otherState -> pure $ push otherState (replace newState scenes)
updateScene :: Input -> Scene -> Result ([MySDL.Request], (StackCommand, Scene))
updateScene input = \case
Scene s ->
flip fmap ((scUpdate s) input (scState s)) $ \case
(reqs, (cmd, newState)) -> (reqs, (cmd, Scene $ s { scState = newState }))
renderTopScene :: SDL.Renderer -> Stack Scene -> IO ()
renderTopScene sdlRenderer states = case head states of
Scene s ->
(scRender s) sdlRenderer (scState s)