{-# LANGUAGE OverloadedStrings #-} module Scenes.Test.Update where import Affection import Control.Concurrent.STM import qualified Data.Vector as V import Data.String (fromString) import Linear -- 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 = V.map (\(Cast c1) -> let partners = V.foldl (\acc@(Cast _, ires) (Cast c2) -> let res = collisionCheck dt c1 c2 in if res /= NoCollision && collisionTime res < collisionTime ires then (Cast c2, res) else acc ) (Cast c1, Collision dt (V2 0 0)) playedCast in if null partners then Cast c1 else uncurry (\(Cast c2) result -> Cast $ collide c1 c2 result) partners ) playedCast wallCast (Cast c) = Cast $ uncurry (collide c) $ V.foldl (\acc@(_, ires) tile -> let res = collisionCheck dt c tile in if res /= NoCollision && collisionTime res < collisionTime ires then (tile, res) else acc ) (V.head layer, Collision dt (V2 0 0)) 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 = let partner = V.foldl (\acc@(_, ires) (Cast c) -> let res = collisionCheck dt playedCat c in if res /= NoCollision && collisionTime res < collisionTime ires then (Cast c, res) else acc ) (V.head updatedCast, Collision dt (V2 0 0)) updatedCast in if (collisionTime $ snd partner) == dt then playedCat else uncurry (\(Cast cx) res -> collide playedCat cx res) partner walledCat = let partner = V.foldl (\acc@(_, ires) tile -> let res = collisionCheck dt collidedCat tile in if res /= NoCollision && collisionTime res < collisionTime ires then (tile, res) else acc ) (V.head layer, Collision dt (V2 0 0)) layer in if (collisionTime $ snd partner) == dt then collidedCat else uncurry (collide collidedCat) partner in Just $ move dt walledCat