{-# 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)