Rasenschach-0.1: Animate.hs

module Animate where

import Control.Monad.Loops
import Control.Monad

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

import FRP.Yampa
import FRP.Yampa.Geometry
import qualified Graphics.UI.SDL as SDL
import qualified Graphics.UI.SDL.Image as SDLi
import qualified Graphics.UI.SDL.TTF as TTF

import qualified Render as Render
import RenderUtil

import Object
import ObjectBehaviour
import Parser
import GameLoop
import AL
import States


animate param sdlState tInit timeState frameCounter objs = do
    reactimate (initialize tInit)
               (input tInit timeState frameCounter)
               (output param sdlState)
               (gameLoop param
                         (AL $ map (\(id, o, oo) -> (id, oo)) objs)
                         (AL $ map (\(id, o, oo) -> (id, o)) objs)
               )

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

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 b = 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 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)