diff --git a/src/Map.hs b/src/Map.hs index 5a5da0e..4a1c028 100644 --- a/src/Map.hs +++ b/src/Map.hs @@ -46,25 +46,24 @@ readLayer (_, path) (V2 tx ty) = do let width = imageWidth img height = imageHeight img layer = V.foldl - (\acc (py, px) -> case (pixelAt img px py) of + (\acc (py, px) -> case pixelAt img px py of (PixelRGBA8 r g b _) -> if r >= 253 then acc `V.snoc` Tile (V2 (fromIntegral px) (fromIntegral py)) - ( (V2 + ( V2 ((255 - fromIntegral g) * (32 / tx)) (1 - (255 - fromIntegral b + 1) * (32 / ty)) - ) - , (V2 + , V2 ((255 - fromIntegral g + 1) * (32 / tx)) (1 - (255 - fromIntegral b) * (32 / ty)) - ) ) (case r of 255 -> Solid 254 -> Platform _ -> Decoration ) + False else acc ) diff --git a/src/Scenes/Test/Load.hs b/src/Scenes/Test/Load.hs index a8e6523..2fd3a77 100644 --- a/src/Scenes/Test/Load.hs +++ b/src/Scenes/Test/Load.hs @@ -78,6 +78,9 @@ load level progress = do (V2 0 0) (V2 0 0) (V2 0 0) + (V2 0 0) + (V2 0 0) + (V2 0 0) 100 tex False @@ -85,13 +88,18 @@ load level progress = do ViewRight [] False + False oil = PowerUp (realToFrac <$> (startpos + V2 200 0)) (V2 0 0) (V2 0 0) + (V2 0 0) 5000 tex (EffectHolder 5 SpeedUp) + (V2 0 0) + (V2 0 0) + False bind shader diff --git a/src/Scenes/Test/Update.hs b/src/Scenes/Test/Update.hs index 140861d..63965e5 100644 --- a/src/Scenes/Test/Update.hs +++ b/src/Scenes/Test/Update.hs @@ -5,6 +5,8 @@ module Scenes.Test.Update where import Affection as A +import Linear + import Control.Concurrent.STM import Data.List (sortOn) diff --git a/src/Types/Player.hs b/src/Types/Player.hs index 6624eaf..98ad02c 100644 --- a/src/Types/Player.hs +++ b/src/Types/Player.hs @@ -211,20 +211,20 @@ instance Collidible Pituicat where } collide cat collrs@(collr@(_, OverlapCollision direction):_) dt = elasticCollision 0.3 cat collr dt - collide cat collrs@(collr@(other, OverlapCollision (V2 dirx diry)):_) dt = - let ncat = elasticCollision 0.3 cat collr dt - vel@(V2 vx vy) = velocity ncat - moveVel@(V2 mx my) = pcMoveVel cat - nvel = V2 - (if abs mx > abs vx - then 0 - else signum vx * (abs vx - abs mx) - ) - ((\(V2 _ y) -> y) (if diry /= 0 then pcVel ncat else pcVel cat)) - grounded = - diry == -1 && abs (vy * ddt) < 2 - in - ncat - { pcGrounded = grounded - , pcXColl = not grounded && diry /= 0 - } + -- collide cat collrs@(collr@(other, OverlapCollision (V2 dirx diry)):_) dt = + -- let ncat = elasticCollision 0.3 cat collr dt + -- vel@(V2 vx vy) = velocity ncat + -- moveVel@(V2 mx my) = pcMoveVel cat + -- nvel = V2 + -- (if abs mx > abs vx + -- then 0 + -- else signum vx * (abs vx - abs mx) + -- ) + -- ((\(V2 _ y) -> y) (if diry /= 0 then pcVel ncat else pcVel cat)) + -- grounded = + -- diry == -1 && abs (vy * ddt) < 2 + -- in + -- ncat + -- { pcGrounded = grounded + -- , pcXColl = not grounded && diry /= 0 + -- } diff --git a/src/Types/Tangible.hs b/src/Types/Tangible.hs index 2689869..db60b4b 100644 --- a/src/Types/Tangible.hs +++ b/src/Types/Tangible.hs @@ -28,15 +28,15 @@ instance Mass Tangible where mass (TPowerUp a) = mass a mass (TTile a) = mass a - acceleration (TPlayer a) = acceleration a - acceleration (TCast a) = acceleration a - acceleration (TPowerUp a) = acceleration a - acceleration (TTile a) = acceleration a + forces (TPlayer a) = forces a + forces (TCast a) = forces a + forces (TPowerUp a) = forces a + forces (TTile a) = forces a - accelerationUpdater (TPlayer a) = TPlayer . accelerationUpdater a - accelerationUpdater (TCast a) = TCast . accelerationUpdater a - accelerationUpdater (TPowerUp a) = TPowerUp . accelerationUpdater a - accelerationUpdater (TTile a) = TTile . accelerationUpdater a + forcesUpdater (TPlayer a) = TPlayer . forcesUpdater a + forcesUpdater (TCast a) = TCast . forcesUpdater a + forcesUpdater (TPowerUp a) = TPowerUp . forcesUpdater a + forcesUpdater (TTile a) = TTile . forcesUpdater a velocity (TPlayer a) = velocity a velocity (TCast a) = velocity a @@ -60,15 +60,40 @@ instance Mass Tangible where instance Collidible Tangible where - boundary (TPlayer c) = boundary c - boundary (TCast c) = boundary c + boundary (TPlayer c) = boundary c + boundary (TCast c) = boundary c boundary (TPowerUp c) = boundary c - boundary (TTile c) = boundary c + boundary (TTile c) = boundary c - collisionCheck dt (TPlayer c1) c2 = collisionCheck dt c1 c2 - collisionCheck dt (TCast c1) c2 = collisionCheck dt c1 c2 - collisionCheck dt (TPowerUp c1) c2 = collisionCheck dt c1 c2 - collisionCheck dt (TTile c1) c2 = collisionCheck dt c1 c2 + prevPosition (TPlayer c) = prevPosition c + prevPosition (TCast c) = prevPosition c + prevPosition (TPowerUp c) = prevPosition c + prevPosition (TTile c) = prevPosition c + + impactForces (TPlayer c) = impactForces c + impactForces (TCast c) = impactForces c + impactForces (TPowerUp c) = impactForces c + impactForces (TTile c) = impactForces c + + collisionOccured (TPlayer c) = collisionOccured c + collisionOccured (TCast c) = collisionOccured c + collisionOccured (TPowerUp c) = collisionOccured c + collisionOccured (TTile c) = collisionOccured c + + impactForcesUpdater (TPlayer c) = TPlayer . impactForcesUpdater c + impactForcesUpdater (TCast c) = TCast . impactForcesUpdater c + impactForcesUpdater (TPowerUp c) = TPowerUp . impactForcesUpdater c + impactForcesUpdater (TTile c) = TTile . impactForcesUpdater c + + updateCollisionOccurence (TPlayer c) = TPlayer . updateCollisionOccurence c + updateCollisionOccurence (TCast c) = TCast . updateCollisionOccurence c + updateCollisionOccurence (TPowerUp c) = TPowerUp . updateCollisionOccurence c + updateCollisionOccurence (TTile c) = TTile . updateCollisionOccurence c + + collisionCheck (TPlayer c1) c2 = collisionCheck c1 c2 + collisionCheck (TCast c1) c2 = collisionCheck c1 c2 + collisionCheck (TPowerUp c1) c2 = collisionCheck c1 c2 + collisionCheck (TTile c1) c2 = collisionCheck c1 c2 collide (TPlayer c1) res dt = TPlayer $ collide c1 res dt collide (TCast c1) res dt = TCast $ collide c1 res dt