continue rewrite

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
           )

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

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)

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
+  --       }

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