{-# LANGUAGE OverloadedStrings #-} module Scenes.Test.Update where import Affection import Control.Concurrent.STM import qualified Data.Vector as V import Data.String (fromString) -- internal imports import Scenes.Test.Types import Classes import Types update :: Test -> Double -> Affection () update level dt = liftIO $ do logIO Debug ("FPS: " <> fromString (show $ 1 / dt)) -- Let all Actors update themselves and check for collisions -- (Typeclasses rock!) atomically $ do lmap <- readTMVar (testMap level) let layer = mapLayers lmap V.! fromIntegral (mapWalkLayer lmap) modifyTVar (testCast level) $ \cast -> let playedCast = V.map (\(Cast c) -> Cast (perform dt c)) cast collidedCast = (\(Cast c1) (Cast c2) -> Cast $ collide c1 c2 (collisionCheck dt c1 c2) ) <$> playedCast <*> playedCast wallCast (Cast c) = Cast $ V.foldl (\member tile -> collide member tile (collisionCheck dt member tile) ) c layer walledCast = V.map wallCast collidedCast in V.map (\(Cast c) -> Cast $ move dt c ) walledCast updatedCast <- readTVar (testCast level) modifyTVar (testPlayer level) $ \(Just pituicat) -> let playedCat = perform dt pituicat collidedCat = V.foldl (\cat (Cast c) -> collide cat c (collisionCheck dt cat c) ) playedCat updatedCast walledCat = V.foldl (\cat tile -> collide cat tile (collisionCheck dt cat tile) ) collidedCat layer in Just $ move dt walledCat