{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Scenes.Test.Update where import Affection as A import Control.Concurrent.STM import qualified Data.Vector as V import Data.Maybe 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, NoCollision) playedCast in if null partners then Cast c1 else uncurry (\(Cast c2) result -> Cast $ collide c1 c2 result) partners ) playedCast wallCast (Cast c) = Cast $ performWorldCollision c layer dt walledCast = V.map wallCast collidedCast in V.map (\(Cast c) -> Cast $ move dt c ) walledCast updatedCast <- readTVar (testCast level) oldCat <- fromJust <$> readTVar (testPlayer level) releasedEffects <- stateTVar (testPowerups level) $ \pus -> let living = V.foldl (\acc pu -> let npu = perform dt pu in if puTTL npu > 0 then npu `V.cons` acc else acc ) V.empty pus indexCollected = V.filter ((/= NoCollision) . snd) $ V.zip (V.fromList [0..length living]) (V.map (collisionCheck dt oldCat) living ) collected = V.foldl (\acc (ind, _) -> (living V.! ind) `V.cons` acc ) V.empty indexCollected differ = V.foldl (\acc life -> if life `V.elem` collected then acc else life `V.cons` acc ) V.empty living fin = V.map (\pu -> move dt $ performWorldCollision pu layer dt) differ in (collected, fin) modifyTVar (testPlayer level) $ \(Just pituicat) -> let playedCat = perform dt pituicat castCat = let allPartners = V.zip (V.fromList [0..V.length updatedCast]) (V.map (\(Cast c) -> collisionCheck dt playedCat c) updatedCast ) filtered = (V.filter ((/= NoCollision) . snd) allPartners) partner = V.minimumBy (\(_, e) (_, f) -> collisionTime e `compare` collisionTime f) filtered in if V.null filtered then playedCat else uncurry (\(Cast c) cr -> collide playedCat c cr) (updatedCast V.! fst partner, snd partner) walledCat = performWorldCollision castCat layer dt affectedCat = walledCat { pcEffects = pcEffects walledCat ++ map puEffect (V.toList releasedEffects) } in Just $ move dt affectedCat performWorldCollision :: (Collidible c) => c -- ^ Cast member to check -> Layer -- ^ The walk layer of the level -> Double -- ^ Tick length -> c -- ^ Updated cast member performWorldCollision c layer dt = let partner = V.foldl (\acc@(part, cr) tile -> let res = collisionCheck dt c tile ret = if cr == NoCollision && res == NoCollision then acc else if cr == NoCollision && res /= NoCollision then (tile, res) else if cr /= NoCollision && res == NoCollision then acc else if collisionTime cr < collisionTime res then acc else (tile, res) in ret ) (V.head layer, collisionCheck dt c $ V.head layer) layer in uncurry (collide c) partner