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 let width = imageWidth img
height = imageHeight img height = imageHeight img
layer = V.foldl 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 (PixelRGBA8 r g b _) -> if r >= 253
then then
acc `V.snoc` Tile acc `V.snoc` Tile
(V2 (fromIntegral px) (fromIntegral py)) (V2 (fromIntegral px) (fromIntegral py))
( (V2 ( V2
((255 - fromIntegral g) * (32 / tx)) ((255 - fromIntegral g) * (32 / tx))
(1 - (255 - fromIntegral b + 1) * (32 / ty)) (1 - (255 - fromIntegral b + 1) * (32 / ty))
) , V2
, (V2
((255 - fromIntegral g + 1) * (32 / tx)) ((255 - fromIntegral g + 1) * (32 / tx))
(1 - (255 - fromIntegral b) * (32 / ty)) (1 - (255 - fromIntegral b) * (32 / ty))
)
) )
(case r of (case r of
255 -> Solid 255 -> Solid
254 -> Platform 254 -> Platform
_ -> Decoration _ -> Decoration
) )
False
else else
acc 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)
(V2 0 0)
(V2 0 0)
(V2 0 0)
100 100
tex tex
False False
@ -85,13 +88,18 @@ load level progress = do
ViewRight ViewRight
[] []
False False
False
oil = PowerUp oil = PowerUp
(realToFrac <$> (startpos + V2 200 0)) (realToFrac <$> (startpos + V2 200 0))
(V2 0 0) (V2 0 0)
(V2 0 0) (V2 0 0)
(V2 0 0)
5000 5000
tex tex
(EffectHolder 5 SpeedUp) (EffectHolder 5 SpeedUp)
(V2 0 0)
(V2 0 0)
False
bind shader bind shader

View file

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

View file

@ -211,20 +211,20 @@ instance Collidible Pituicat where
} }
collide cat collrs@(collr@(_, OverlapCollision direction):_) dt = collide cat collrs@(collr@(_, OverlapCollision direction):_) dt =
elasticCollision 0.3 cat collr dt elasticCollision 0.3 cat collr dt
collide cat collrs@(collr@(other, OverlapCollision (V2 dirx diry)):_) dt = -- collide cat collrs@(collr@(other, OverlapCollision (V2 dirx diry)):_) dt =
let ncat = elasticCollision 0.3 cat collr dt -- let ncat = elasticCollision 0.3 cat collr dt
vel@(V2 vx vy) = velocity ncat -- vel@(V2 vx vy) = velocity ncat
moveVel@(V2 mx my) = pcMoveVel cat -- moveVel@(V2 mx my) = pcMoveVel cat
nvel = V2 -- nvel = V2
(if abs mx > abs vx -- (if abs mx > abs vx
then 0 -- then 0
else signum vx * (abs vx - abs mx) -- else signum vx * (abs vx - abs mx)
) -- )
((\(V2 _ y) -> y) (if diry /= 0 then pcVel ncat else pcVel cat)) -- ((\(V2 _ y) -> y) (if diry /= 0 then pcVel ncat else pcVel cat))
grounded = -- grounded =
diry == -1 && abs (vy * ddt) < 2 -- diry == -1 && abs (vy * ddt) < 2
in -- in
ncat -- ncat
{ pcGrounded = grounded -- { pcGrounded = grounded
, pcXColl = not grounded && diry /= 0 -- , pcXColl = not grounded && diry /= 0
} -- }

View file

@ -28,15 +28,15 @@ instance Mass Tangible where
mass (TPowerUp a) = mass a mass (TPowerUp a) = mass a
mass (TTile a) = mass a mass (TTile a) = mass a
acceleration (TPlayer a) = acceleration a forces (TPlayer a) = forces a
acceleration (TCast a) = acceleration a forces (TCast a) = forces a
acceleration (TPowerUp a) = acceleration a forces (TPowerUp a) = forces a
acceleration (TTile a) = acceleration a forces (TTile a) = forces a
accelerationUpdater (TPlayer a) = TPlayer . accelerationUpdater a forcesUpdater (TPlayer a) = TPlayer . forcesUpdater a
accelerationUpdater (TCast a) = TCast . accelerationUpdater a forcesUpdater (TCast a) = TCast . forcesUpdater a
accelerationUpdater (TPowerUp a) = TPowerUp . accelerationUpdater a forcesUpdater (TPowerUp a) = TPowerUp . forcesUpdater a
accelerationUpdater (TTile a) = TTile . accelerationUpdater a forcesUpdater (TTile a) = TTile . forcesUpdater a
velocity (TPlayer a) = velocity a velocity (TPlayer a) = velocity a
velocity (TCast a) = velocity a velocity (TCast a) = velocity a
@ -60,15 +60,40 @@ instance Mass Tangible where
instance Collidible Tangible where instance Collidible Tangible where
boundary (TPlayer c) = boundary c boundary (TPlayer c) = boundary c
boundary (TCast c) = boundary c boundary (TCast c) = boundary c
boundary (TPowerUp 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 prevPosition (TPlayer c) = prevPosition c
collisionCheck dt (TCast c1) c2 = collisionCheck dt c1 c2 prevPosition (TCast c) = prevPosition c
collisionCheck dt (TPowerUp c1) c2 = collisionCheck dt c1 c2 prevPosition (TPowerUp c) = prevPosition c
collisionCheck dt (TTile c1) c2 = collisionCheck dt c1 c2 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 (TPlayer c1) res dt = TPlayer $ collide c1 res dt
collide (TCast c1) res dt = TCast $ collide c1 res dt collide (TCast c1) res dt = TCast $ collide c1 res dt