Eternal10Seconds-0.1: Eternal.hs

{-# LANGUAGE ForeignFunctionInterface #-}
module Eternal where

import Foreign.C
import Data.Word
import Graphics.UI.SDL as SDL
import Graphics.UI.SDL.Mixer as SDLMixer
import Game
import GameState
import Resource
import Input
import Title
import Stage

foreign export ccall "hs_main" hs_main :: IO ()

hs_main :: IO ()
hs_main = do
    -- SDL初期化
    SDL.init [InitEverything]
    SDL.setCaption "Eternal10Seconds" ""
    SDL.setVideoMode screenWidth screenHeight 32 [SDL.SWSurface]
    
    -- SDLMixer初期化
    SDLMixer.openAudio 44100 AudioS16Sys 2 1024
    
    game <- initGame
    timerLoop game
    SDL.quit

-- メインループ
timerLoop :: Game -> IO ()
timerLoop game = do
    time <- adjustFps $ gameTime game
    getInput <- eventLoop $ gameInput game
    (stat, restInput) <- updateGameState (gameState game) getInput
    res <- updateResource (gameResource game) stat
    case stat of
        GamequitState Gamequit -> return ()
        otherwise -> do
        updateScreen stat res
        timerLoop $ Game stat res restInput time

-- ウェイトの挿入
adjustFps :: Word32 -> IO Word32
adjustFps prev = do
    now <- SDL.getTicks
    let elapsed = now - prev
    let rest = (floor $ 1000.0 / 60.0) - (toInteger elapsed)
    if rest > 0 then SDL.delay (fromInteger rest) else return ()
    next <- SDL.getTicks
    return next

-- イベントのポーリング
eventLoop :: Input -> IO Input
eventLoop input = do
    event <- SDL.pollEvent
    if event == SDL.NoEvent then return input else do
	let nextInput = updateInput input event
	eventLoop nextInput