Browse Source

some tinkering with cast and collision

collectable
nek0 3 months ago
parent
commit
3079ee74e1
  1. 4
      src/Classes/Physics/Collidible.hs
  2. 5
      src/Scenes/Test.hs
  3. 6
      src/Scenes/Test/Load.hs
  4. 23
      src/Scenes/Test/Update.hs
  5. 4
      src/Scenes/Test/Util.hs
  6. 5
      src/Types/Player.hs

4
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

5
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 ->

6
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)

23
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)

4
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

5
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

Loading…
Cancel
Save