nek0/pituicat
2
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

linted

Browse source
This commit is contained in:
nek0 2021-07-24 03:33:00 +02:00
parent 95f5b2c3a8
commit d71437774f
4 changed files with 69 additions and 60 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/Physics/Classes/Mass.hs
View file

@ -38,7 +38,7 @@ class Mass m where
gravitate g m =
let acc = acceleration m + g
in
(accelerationUpdater m) acc
accelerationUpdater m acc
-- | Apply acceleration to mass object und thus change its velocity
accelerate
@ -48,7 +48,7 @@ class Mass m where
accelerate dt m =
let vel = velocity m + ((dt *) <$> acceleration m)
in
(velocityUpdater m) vel
velocityUpdater m vel
-- | Apply velocity to mass object and thus change its position
-- Changes in position smaller than around half a pixel per second are ignored.
@ -57,6 +57,6 @@ class Mass m where
-> m -- ^ Original mass object
-> m -- ^ Updated mass object
move dt m =
let dpos@(V2 dx dy) = (dt *) <$> velocity m
let dpos = (dt *) <$> velocity m
in
(positionUpdater m) (position m + dpos)
positionUpdater m (position m + dpos)

40
src/Scenes/Test/Update.hs
View file

@ -15,8 +15,6 @@ import Data.Maybe
import Data.String (fromString)
import Linear
-- internal imports
import Scenes.Test.Types
@ -35,40 +33,40 @@ update level dt = liftIO $ do
lmap <- readTMVar (testMap level)
cast <-
V.map (\(Cast c) -> Cast $ perform dt c) <$> readTVar (testCast level)
powerups <- V.filter ((0 <) . puTTL) <$>
powerups <- V.filter ((0 <) . puTTL) .
V.map (perform dt) <$>
readTVar (testPowerups level)
cat <- perform dt <$> fromJust <$> readTVar (testPlayer level)
cat <- perform dt . fromJust <$> readTVar (testPlayer level)
let layer = mapLayers lmap V.! fromIntegral (mapWalkLayer lmap)
tangibles =
(V.map TTile layer) V.++
(V.map TCast cast) V.++
(V.map TPowerUp powerups) `V.snoc`
V.map TTile layer V.++
V.map TCast cast V.++
V.map TPowerUp powerups `V.snoc`
TPlayer cat
indexedTangibles = V.zip
(V.fromList [0 .. ((V.length tangibles) - 1)])
(V.fromList [0 .. (V.length tangibles - 1)])
tangibles
collidedTangibles =
let collisionPartners =
V.foldl
(\acc (index, tangible1) ->
(\iacc (index, tangible1) ->
let partners =
V.foldl
(\acc (qInd, tangible2) ->
(\jacc (qInd, tangible2) ->
let res = collisionCheck dt tangible1 tangible2
in
if res /= NoCollision && qInd /= index
then acc `V.snoc` (qInd, res)
else acc
then jacc `V.snoc` (qInd, res)
else jacc
)
V.empty
indexedTangibles
in
if V.null partners
then acc
else acc `V.snoc`
then iacc
else iacc `V.snoc`
( index
, head
(sortOn (collisionTime . snd) (V.toList partners))
@ -93,17 +91,17 @@ update level dt = liftIO $ do
(aindex, res)
in
tangibles `V.update`
(V.map updater collisionPartners)
V.map updater collisionPartners
(newCast, newPowerups, mnewCat@(Just _)) = V.foldl
(\acc@(castAcc, puAcc, mcat) input ->
(\acc@(castAcc, pAcc, _) input ->
case input of
TCast c ->
(castAcc `V.snoc` move dt c, puAcc, mnewCat)
(castAcc `V.snoc` move dt c, pAcc, mnewCat)
TPowerUp p ->
(castAcc, puAcc `V.snoc` move dt p, mnewCat)
TPlayer cat ->
(castAcc, puAcc, Just (move dt cat))
TTile t ->
(castAcc, pAcc `V.snoc` move dt p, mnewCat)
TPlayer ncat ->
(castAcc, pAcc, Just (move dt ncat))
TTile _ ->
acc
)
(V.empty, V.empty, Nothing)

78
src/Types/Player.hs
View file

@ -99,7 +99,7 @@ instance Actor Pituicat where
let (V2 _ dy) = velocity physCat
moveFact =
if
null (filter ((SpeedUp ==) . effectReleased) (pcEffects p))
not (any ((SpeedUp ==) . effectReleased) (pcEffects p))
then 1
else 2
physCat = (accelerate dt . gravitate constG)
@ -115,9 +115,7 @@ instance Actor Pituicat where
finalCat = physCat
{ pcMoveVel =
lerp (min 0.95 (60 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat)
, pcGrounded = if pcGrounded physCat
then not (abs dy * dt > 2)
else False
, pcGrounded = pcGrounded physCat && abs dy * dt <= 2
, pcEffects =
foldl
(\acc eff ->
@ -133,7 +131,7 @@ instance Actor Pituicat where
(pcEffects p)
}
in
A.log A.Debug ("*meow* am at: " <> (fromString $ show $ pcPos finalCat))
A.log A.Debug ("*meow* am at: " <> fromString (show $ position finalCat))
(finalCat
{ pcViewDirection = if pcGrounded finalCat
then
@ -153,43 +151,40 @@ instance Mass Pituicat where
acceleration = pcAcc
accelerationUpdater cat =
(\accel -> cat
\accel -> cat
{ pcAcc = accel
}
)
velocity cat =
let mvel@(V2 mx my) = pcMoveVel cat
let mvel@(V2 mx _) = pcMoveVel cat
nvel@(V2 x y) = pcVel cat + mvel
in
if abs x > abs mx then V2 (signum x * abs mx) y else nvel
velocityUpdater cat =
(\vel@(V2 vx vy) ->
\(V2 vx vy) ->
let
(V2 mx my) = pcMoveVel cat
nvel = V2
(if abs mx > abs vx
then 0
else (signum vx) * (abs vx - abs mx)
else signum vx * (abs vx - abs mx)
)
(if abs my > abs vy
then 0
else (signum vy) * (abs vy - abs my)
else signum vy * (abs vy - abs my)
)
in
cat
{ pcVel = vel
{ pcVel = nvel
}
)
position = pcPos
positionUpdater cat =
(\pos -> cat
\pos -> cat
{ pcPos = pos
}
)
instance Collidible Pituicat where
@ -206,26 +201,39 @@ instance Collidible Pituicat where
collide cat _ NoCollision = cat
collide cat other collr@(Collision ddt (V2 dirx diry)) =
let ncat = (elasticCollision 0.3 cat other collr)
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
let ncat = elasticCollision 0.3 cat other collr
nvel@(V2 _ vy) = pcVel ncat
grounded = diry == -1 && abs (vy * ddt) < 2
fact = fromIntegral <$> V2
(1 - abs dirx)
(if diry /= -1 && quadrance nvel > bounceThreshold then 1 else 0)
in
ncat
{ pcGrounded = grounded
, pcMoveVel = pcMoveVel ncat *
if dirx /= 0
then V2 0 1
else V2 1 1
, pcVel = nvel *
if dirx /= 0
then V2 0 1
else V2 1 1
{ pcVel = nvel * fact
, pcMoveVel = pcMoveVel ncat * fact
, pcTMoveVel = pcTMoveVel ncat * fact
, pcGrounded = grounded
}
-- let ncat = (elasticCollision 0.3 cat other collr)
-- 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
-- , pcMoveVel = pcMoveVel ncat *
-- if dirx /= 0
-- then V2 0 1
-- else V2 1 1
-- , pcVel = nvel *
-- if dirx /= 0
-- then V2 0 1
-- else V2 1 1
-- }

3
src/Util.hs
View file

@ -29,3 +29,6 @@ globalKeyHandle gd mesg@(MsgKeyboardEvent time win motion repeat keysym) =
constG :: V2 Double
constG = V2 0 (-500)
bounceThreshold :: Double
bounceThreshold = 200