From 3079ee74e192a8de01a0e8c1f156ff50fb180284 Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 28 Apr 2021 16:35:51 +0200 Subject: [PATCH] some tinkering with cast and collision --- src/Classes/Physics/Collidible.hs | 4 ++++ src/Scenes/Test.hs | 5 ++--- src/Scenes/Test/Load.hs | 6 ++++-- src/Scenes/Test/Update.hs | 23 ++++++++++++++++++++--- src/Scenes/Test/Util.hs | 4 ++-- src/Types/Player.hs | 5 +++-- 6 files changed, 35 insertions(+), 12 deletions(-) diff --git a/src/Classes/Physics/Collidible.hs b/src/Classes/Physics/Collidible.hs index f38bf46..180a722 100644 --- a/src/Classes/Physics/Collidible.hs +++ b/src/Classes/Physics/Collidible.hs @@ -139,6 +139,10 @@ class (Show c, Mass c) => Collidible c where Collision tx (V2 (floor $ signum d1x) 0) (_, True, True, False, True) -> Collision ty (V2 0 (floor $ signum d1y)) + (True, _, True, False, _) -> + NoCollision + (_, True, False, _, False) -> + NoCollision (_, _, _, False, False) -> NoCollision in diff --git a/src/Scenes/Test.hs b/src/Scenes/Test.hs index c60851f..32035c2 100644 --- a/src/Scenes/Test.hs +++ b/src/Scenes/Test.hs @@ -59,9 +59,8 @@ instance Scene Test where powerups <- (V.map Cast) <$> (readTVarIO (testPowerups level)) A.logIO A.Debug (fromString $ V.foldl (\acc (Cast p) -> acc ++ show p ++ " ") "" powerups) pituicat <- readTVarIO (testPlayer level) - let cast = Cast (fromJust pituicat) `V.cons` powerups - -- nonPlayerCast V.++ - -- powerups + let cast = Cast (fromJust pituicat) `V.cons` powerups V.++ + nonPlayerCast playerPos@(V2 px py) = realToFrac <$> (pcPos $ fromJust pituicat) atomically $ modifyTVar (testMatrices level) $ \pvm -> diff --git a/src/Scenes/Test/Load.hs b/src/Scenes/Test/Load.hs index 8575e81..bd0c1e0 100644 --- a/src/Scenes/Test/Load.hs +++ b/src/Scenes/Test/Load.hs @@ -39,7 +39,7 @@ load level progress = do bind vertexArray - vertexBuffer <- newVertexBuffer 4096 + vertexBuffer <- newVertexBuffer 1024 bind vertexBuffer @@ -82,7 +82,7 @@ load level progress = do False Nothing oil = PowerUp - (realToFrac <$> (startpos + V2 200 (0))) + (realToFrac <$> (startpos + V2 200 0)) (V2 0 0) (V2 0 0) 5000 @@ -112,6 +112,8 @@ load level progress = do putTMVar (testGraphics level) (GLAssets vertexArray vertexBuffer indexBuffer shader [tex]) writeTVar (testPlayer level) (Just pituicat) + writeTVar (testCast level) + (V.fromList [Cast (oil {puPos = puPos oil + V2 200 0})]) writeTVar (testPowerups level) (V.fromList [oil]) writeTVar (testLoaded level) True writeTVar (testMatrices level) (PVM projection view model) diff --git a/src/Scenes/Test/Update.hs b/src/Scenes/Test/Update.hs index 057477f..7a15182 100644 --- a/src/Scenes/Test/Update.hs +++ b/src/Scenes/Test/Update.hs @@ -80,9 +80,26 @@ update level dt = liftIO $ do modifyTVar (testPlayer level) $ \(Just pituicat) -> let playedCat = perform dt pituicat - walledCat = - performWorldCollision playedCat layer dt - in Just $ move dt (A.log A.Debug (fromString $ show $ velocity walledCat) walledCat) + 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 + in Just $ move dt walledCat performWorldCollision :: (Collidible c) diff --git a/src/Scenes/Test/Util.hs b/src/Scenes/Test/Util.hs index 04efa37..d976e62 100644 --- a/src/Scenes/Test/Util.hs +++ b/src/Scenes/Test/Util.hs @@ -106,8 +106,8 @@ populate layers props actors = in A.log A.Debug ("layer: " <> (fromString $ show num) <> - ", actors: " <> (fromString $ V.foldl (\acc (Cast c) -> acc ++ show c ++ " ") "" actorsHere) <> - ", props: " <> (fromString $ V.foldl (\acc (StageSet s) -> acc ++ show s ++ " ") "" propsHere) + ",\nactors: " <> (fromString $ V.foldl (\acc (Cast c) -> acc ++ show c ++ " ") "" actorsHere) <> + ",\nprops: " <> (fromString $ V.foldl (\acc (StageSet s) -> acc ++ show s ++ " ") "" propsHere) ) ( ( is V.++ lis V.++ pis V.++ cis diff --git a/src/Types/Player.hs b/src/Types/Player.hs index 53da69b..d4d0912 100644 --- a/src/Types/Player.hs +++ b/src/Types/Player.hs @@ -157,8 +157,9 @@ instance Collidible Pituicat where ) ((\(V2 _ y) -> y) (if diry /= 0 then pcVel ncat else pcVel cat)) grounded = - (vy * ddt) >= 0 && - (vy * ddt) < 5 && diry == -1 + vy >= 0 && + vy < 200 && + diry == -1 in ncat { pcGrounded = grounded