continue rewrite

This commit is contained in:
nek0 2021-09-30 06:09:39 +02:00
parent 9f47b192a5
commit 9aef49da94
5 changed files with 71 additions and 37 deletions

View file

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

View file

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

View file

@ -5,6 +5,8 @@ module Scenes.Test.Update where
import Affection as A
import Linear
import Control.Concurrent.STM
import Data.List (sortOn)

View file

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

View file

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