packages feed

Rasenschach-0.1.3: Animate.hs

module Animate where
 
import Graphics.UI.GLUT (GLuint)

import Control.Monad.Loops
import Control.Monad

import Data.Array
import Data.IORef
import Control.Concurrent.MVar
import Data.Convertible
import Data.Time.Clock

import FRP.Yampa

import qualified Render as Render

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


animate' parm graphData rh timeState frameCounter newInput = do
        t <- getCurrentTime
        let t' = convert t :: Double
        t0 <- readIORef timeState
        writeIORef timeState t'
        inp <- input' parm graphData (t'-t0) frameCounter newInput True
        react rh inp

animateInit param graphData dt timeState frameCounter objs = do
    (dt, Just gi0) <- input dt timeState frameCounter True
    reactInit (return gi0)
              (output' param graphData)
              (gameLoop param
                        (AL $ map (\(id, o, oo) -> (id, oo)) objs)
                        (AL $ map (\(id, o, oo) -> (id, o)) objs))


input' :: Param ->
          GraphicsData -> 
          Time -> 
          IORef Int -> 
          MVar [RSEvent] -> 
          Bool -> 
          IO (DTime, Maybe GameInput)
input' parm graphData dt counter newInput b = do
    maybeEvents <- tryTakeMVar newInput
    putMVar newInput []
    count <- readIORef counter
    let events = case maybeEvents of
                   Nothing -> []
                   Just es -> es
    writeIORef counter (count + 1)
--    putStrLn . show $ events
    return (dt, Just (dt * (fromIntegral count), events))


output' :: (Eq a, Num a) => --(Eq a, Num i, Num a, Ix i) =>
             Param 
             -> GraphicsData
             -> t
             -> t1
             -> AL a ObjOutput
             -> IO Bool
output' param graphData rh _ oal@(AL oos) = do
    Render.render param (map (ooObsObjState . snd) oos) graphData
    let ol = (AL.!) oal 1

    when (((fst . oosGameState . ooObsObjState) ol) == GSQuit) $ putStrLn "Quit"
    return (((fst . oosGameState . ooObsObjState) ol) == GSQuit)
-- neuer Kram endet hier


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

input :: Time -> IORef Double -> IORef Int -> Bool -> IO (DTime, Maybe GameInput)
input tInit stateTime counter _ = do
    count <- readIORef counter
    writeIORef counter (count + 1)
    let events = [] -- 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))