Eternal10Seconds-0.1: GameState.hs

module GameState where

import Input
import Title
import Stage
import Gameover
import Score
import qualified Graphics.UI.SDL as SDL
import Resource

-- ゲームの状態
data GameState =
	TitleState Title |
    StageState Stage |
    GameoverState Gameover |
	ScoreState Score |
    GamequitState Gamequit

data Gamequit = Gamequit

-- 状態の更新
updateTitle :: Title -> Input -> IO GameState
updateTitle (Title i) input
    | hasKey input SDL.SDLK_DOWN = return $ TitleState $ Title (nextMenu i)
    | hasKey input SDL.SDLK_UP = return $ TitleState $ Title (prevMenu i)
updateTitle (Title 0) input | hasKey input SDL.SDLK_z = return $ StageState initStage
updateTitle (Title 1) input | hasKey input SDL.SDLK_z = return $ ScoreState Score
updateTitle (Title 2) input | hasKey input SDL.SDLK_z = return $ GamequitState Gamequit
updateTitle t _ = return $ TitleState t

updateGameover :: Gameover -> Input -> IO GameState
updateGameover g input | hasKey input SDL.SDLK_z = return $ TitleState initTitle
updateGameover g _ = return $ GameoverState g

updateStage :: Stage -> Input -> IO GameState
updateStage stage input = let
    moved = moveObjects (chargeAmmo stage) input in
	case filterAlive moved of
    (Just s@Stage { stagePlayer = p, stageEnemy = ems, stageBullet = bls, stageTime = t }) -> let
        (newBls, nextPly) = if hasKey input SDL.SDLK_z then createPlayerBullet p else ([], p) in do
        newEnemies <- createEnemies t
        return $ StageState s {
            stagePlayer = nextPly,
            stageEnemy = (newEnemies ++ ems),
            stageBullet = (newBls ++ bls),
            stageTime = (t+1)
        }
    els -> do
        writeScore $ milisec $ stageTime moved
        return $ GameoverState $ Gameover moved

updateScore :: Score -> Input -> IO GameState
updateScore s input | hasKey input SDL.SDLK_z = return $ TitleState $ Title 1
updateScore s _ = return $ ScoreState s

updateGameState :: GameState -> Input -> IO (GameState, Input)
updateGameState stat input | hasKey input SDL.SDLK_ESCAPE =
    return (GamequitState Gamequit, emptyInput)
updateGameState (TitleState t) input = do
    stat <- updateTitle t input
    return (stat, emptyInput)
updateGameState (StageState s) input = do
    stat <- updateStage s input
    return (stat, eraseKey input SDL.SDLK_z)
updateGameState (GameoverState g) input = do
    stat <- updateGameover g input
    return (stat, emptyInput)
updateGameState (ScoreState s) input = do
    stat <- updateScore s input
    return (stat, emptyInput)
updateGameState stat input = return (stat, input)

-- リソースの更新
updateResource :: Resource -> GameState -> IO Resource
updateResource res (TitleState t) = addTitleResource res
updateResource res (StageState s) = addStageResource res
updateResource res (GameoverState g) = addGameoverResource res
updateResource res (ScoreState r) = addScoreResource res
updateResource res _ = return res

-- 描画
updateScreen :: GameState -> Resource -> IO ()
updateScreen game res = do
    screen <- SDL.getVideoSurface
    renderGameState game screen res
    SDL.flip screen
    return ()

renderGameState :: GameState -> SDL.Surface -> Resource -> IO ()
renderGameState (TitleState t) surf res = renderTitle t surf res
renderGameState (StageState s) surf res = renderStage s surf res
renderGameState (GameoverState g) surf res = renderGameover g surf res
renderGameState (ScoreState s) surf res = renderScore s surf res
renderGameState _ _ _ = return ()