{-# 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) 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, NoCollision) -- updatedCast -- in -- if (collisionTime $ snd partner) == dt -- then playedCat -- else uncurry -- (\(Cast cx) res -> collide playedCat cx res) -- partner walledCat = performWorldCollision playedCat layer dt in Just $ move dt (A.log A.Debug (fromString $ show $ velocity walledCat) walledCat) 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