some tinkering with cast and collision

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

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
+    let cast = Cast (fromJust pituicat) `V.cons` powerups V.++
-         --  nonPlayerCast V.++
+         nonPlayerCast
-         --  powerups
         playerPos@(V2 px py) = realToFrac <$> (pcPos $ fromJust pituicat)
 
     atomically $ modifyTVar (testMatrices level) $ \pvm ->

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)

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 =
+            castCat =
-              performWorldCollision playedCat layer dt
+              let allPartners = V.zip (V.fromList [0..V.length updatedCast])
-        in Just $ move dt (A.log A.Debug (fromString $ show $ velocity walledCat) walledCat)
+                    (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)

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) <>
+          ",\nactors: " <> (fromString $ V.foldl (\acc (Cast c) -> acc ++ show c ++  " ") "" actorsHere) <>
-          ", props: " <> (fromString $ V.foldl (\acc (StageSet s) -> acc ++ show s ++ " ") "" propsHere)
+          ",\nprops: " <> (fromString $ V.foldl (\acc (StageSet s) -> acc ++ show s ++ " ") "" propsHere)
           )
           (
             ( is V.++ lis V.++ pis V.++ cis

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 >= 0 &&
-          (vy * ddt) < 5 && diry == -1
+          vy < 200 &&
+          diry == -1
     in
       ncat
         { pcGrounded = grounded