click-clack-1.0.1: src/World.hs

module World where

import qualified Physics.Hipmunk as H
import qualified Graphics.UI.GLFW as G

import Data.StateVar

import Control.Monad
import Data.Maybe
import Types
import Utils   

import qualified IxMap as M

import Pure
import Dirty
import Inits
import Graphics

updateWorld :: World -> IO (World, Time)
updateWorld world = do
    t0 <- get G.time
    (sense, events) <- percept dirty
    let (pure', queries) = updatePure sense events pure
    dirty' <- react queries dirty    
    t1 <- get G.time
    return (World pure' dirty', t1 - t0)
    where dirty = worldDirty world
          pure  = worldPure  world  

percept :: Dirty -> IO (Sense, [Event])
percept a = do
    hero    <- obj2hero $ dirtyHero a
    balls   <- mapM (uncurry obj2ball) $ M.toList $ dirtyObjs a
    evts1   <- fmap maybeToList $ getTouch (dirtyTouchVar a) $ dirtyObjs a
    evts2   <- fmap maybeToList $ getClick $ dirtyMouse a
    return $ (Sense hero balls, evts1 ++ evts2)


updatePure :: Sense -> [Event] -> Pure -> (Pure, [Query])
updatePure s evts = updateEvents evts . updateSenses s 


react :: [Query] -> Dirty -> IO Dirty
react = foldr (<=<) return   
    . fmap (foldQuery removeBall heroVelocity 
            makeBall gameOver (stepDirty dt))


drawWorld :: World -> IO ()
drawWorld = draw . picture . worldPure


initWorld :: IO World
initWorld = do
    dirty   <- initDirty
    (sense, events) <- percept dirty
    return $ World (initPure sense events) dirty