diff --git a/src/Physics/Classes/Collidible.hs b/src/Physics/Classes/Collidible.hs index 5faec42..5462e57 100644 --- a/src/Physics/Classes/Collidible.hs +++ b/src/Physics/Classes/Collidible.hs @@ -147,6 +147,8 @@ class (Show c, Mass c) => Collidible c where NoCollision (_, _, True, _, _) -> A.log A.Debug ("CORNER CASE!") NoCollision + (False, False, _, _, _) -> + NoCollision x -> error $ "Unhandled combination of collision check results: " <> (fromString $ show x) diff --git a/src/Scenes/Test/Update.hs b/src/Scenes/Test/Update.hs index 24a3509..2bd3456 100644 --- a/src/Scenes/Test/Update.hs +++ b/src/Scenes/Test/Update.hs @@ -33,47 +33,52 @@ update level dt = liftIO $ do 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 + oldCast <- V.map (\(Cast c) -> Cast $ perform dt c) <$> + readTVar (testCast level) + oldCat <- perform dt <$> fromJust <$> readTVar (testPlayer level) + 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 + cattedCast = V.map + (\(Cast c) -> + Cast $ collide c oldCat $ collisionCheck dt c oldCat + ) + walledCast + 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 -> @@ -113,10 +118,10 @@ update level dt = liftIO $ do (testPlayer level) $ \(Just pituicat) -> let playedCat = perform dt pituicat castCat = - let allPartners = V.zip (V.fromList [0..V.length updatedCast]) + let allPartners = V.zip (V.fromList [0..V.length oldCast]) (V.map (\(Cast c) -> collisionCheck dt playedCat c) - updatedCast + oldCast ) filtered = (V.filter ((/= NoCollision) . snd) allPartners) partner = V.minimumBy @@ -129,7 +134,7 @@ update level dt = liftIO $ do else uncurry (\(Cast c) cr -> collide playedCat c cr) - (updatedCast V.! fst partner, snd partner) + (oldCast V.! fst partner, snd partner) walledCat = performWorldCollision castCat layer dt affectedCat = walledCat { pcEffects = pcEffects walledCat ++ diff --git a/src/Types/PowerUp.hs b/src/Types/PowerUp.hs index 2358f6c..44671b1 100644 --- a/src/Types/PowerUp.hs +++ b/src/Types/PowerUp.hs @@ -76,7 +76,7 @@ instance Actor PowerUp where instance Mass PowerUp where - mass _ = 1 + mass _ = 0.1 acceleration = puAcc