{-# 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 ----------- -- Scene -- ----------- -- | Scene describes a generic interface for a game Scene -- * state: for the scene data -- * update: how to update the scene -- * render: how to render the scene data SceneF a = SceneF { scState :: a , scUpdate :: Input -> a -- it might fail with a reason -> Result ([MySDL.Request], (StackCommand, a)) , scRender :: SDL.Renderer -> a -> IO () } -- | Existentially Quantified Scene data Scene = forall s. Scene (SceneF s) -- | Create a Scene from the interface 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) {- -- a sample definition of a state. Does nothing. sample :: Scene sample = mkScene () (\_ () -> pure (None, ())) (const pure) -} ----------------- -- State stack -- ----------------- -- | A command for the scene stack, to be returned by `update` data StackCommand = Done -- ^ You can remove me from the stack | None -- ^ Keep me at the top of the stack | Push Scene -- ^ Push a new scene | Replace Scene -- ^ Replace me with a new scene -- | Update the top state on the stack 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) -- | Update an existentially quantified Scene 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 })) -- | Render the top scene on the stack renderTopScene :: SDL.Renderer -> Stack Scene -> IO () renderTopScene sdlRenderer states = case head states of Scene s -> (scRender s) sdlRenderer (scState s)