Rasenschach-0.1.2: Animate.hs

module Animate where

import Graphics.UI.SDL
import Graphics.UI.SDL.TTF
import Graphics.UI.SDL.Mixer as Mix
import Control.Monad.Loops
import Control.Monad

import Data.Array 
import Data.IORef
import Data.Convertible
import Data.Time.Clock

import FRP.Yampa
import qualified Graphics.UI.SDL as SDL

import qualified Render as Render

import BasicTypes
import Object
import AL
import States
import Global
import GameLoop

animate :: (Num i, Ix i) => Param -> 
             IORef (Maybe (Surface, Surface, Array i Font, Array Int (Surface, Int), Chunk, Chunk, Chunk)) -> Double -> IORef Double -> IORef Int -> [(ObjId, Object, ObjOutput)] -> IO ()
animate param sdlState tInit timeState frameCounter objs = do
    reactimate (initialize tInit)
               (input tInit timeState frameCounter)
               (output param sdlState)
               (gameLoop param
                         (AL $ map (\(id', _, oo) -> (id', oo)) objs)
                         (AL $ map (\(id', o, _) -> (id', o)) objs)
               )

-- reactimation IO ----------

initialize :: Double -> IO (Double, [SDL.Event])
initialize tInit = do
    events <- unfoldWhileM (/= SDL.NoEvent) SDL.pollEvent
    t <- getCurrentTime
    return ((convert t :: Double) - tInit, events)

input :: Time -> IORef Double -> IORef Int -> Bool -> IO (DTime, Maybe GameInput)
input tInit stateTime counter _ = do
    count <- readIORef counter
    writeIORef counter (count + 1)
    events <- unfoldWhileM (/= SDL.NoEvent) SDL.pollEvent
    t1 <- getCurrentTime
    let t1' = convert t1 :: Double
    t0 <- readIORef stateTime
    writeIORef stateTime t1'
    return (t1'-t0, Just (t1'-tInit, events))


output :: (Eq k, Num k, Num i, Ix i) => 
            Param -> IORef (Maybe (Surface, Surface, Array i Font, Array Int (Surface, Int), Chunk, Chunk, Chunk)) -> 
            t -> AL k ObjOutput -> 
             IO Bool
output param sdlState _ oal@(AL oos) = do
    Just sdl <- readIORef sdlState
    Render.render param (map (ooObsObjState . snd) oos) sdl
    let ol = (AL.!) oal 1

    when (((fst . oosGameState . ooObsObjState) ol) == GSQuit) $ putStrLn "Hallo"
    return  (((fst . oosGameState . ooObsObjState) ol) == GSQuit)