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

try making objects move

Browse source
This commit is contained in:
nek0 2021-05-14 09:22:01 +02:00
parent 25b6eb659d
commit 40e82e26f6
3 changed files with 48 additions and 41 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/Physics/Classes/Collidible.hs
View file

@ -147,6 +147,8 @@ class (Show c, Mass c) => Collidible c where
NoCollision
(_, _, True, _, _) ->
A.log A.Debug ("CORNER CASE!") NoCollision
(False, False, _, _, _) ->
NoCollision
x -> error $
"Unhandled combination of collision check results: "
<> (fromString $ show x)

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

@ -33,47 +33,52 @@ update level dt = liftIO $ do
atomically $ do
lmap <- readTMVar (testMap level)
let layer = mapLayers lmap V.! fromIntegral (mapWalkLayer lmap)
modifyTVar
(testCast level) $ \cast ->
let playedCast =
V.map
(\(Cast c) -> Cast (perform dt c))
cast
collidedCast =
V.map
(\(Cast c1) ->
let partners = V.foldl
(\acc@(Cast _, ires) (Cast c2) ->
let res = collisionCheck dt c1 c2
in
if res /= NoCollision &&
collisionTime res < collisionTime ires
then (Cast c2, res)
else acc
)
(Cast c1, NoCollision)
playedCast
in
if null partners
then Cast c1
else
uncurry
(\(Cast c2) result -> Cast $ collide c1 c2 result)
partners
)
playedCast
wallCast (Cast c) =
Cast $ performWorldCollision c layer dt
walledCast =
V.map wallCast collidedCast
in
V.map
oldCast <- V.map (\(Cast c) -> Cast $ perform dt c) <$>
readTVar (testCast level)
oldCat <- perform dt <$> fromJust <$> readTVar (testPlayer level)
modifyTVar (testCast level) $ \cast ->
let playedCast =
V.map
(\(Cast c) -> Cast (perform dt c))
cast
collidedCast =
V.map
(\(Cast c1) ->
let partners = V.foldl
(\acc@(Cast _, ires) (Cast c2) ->
let res = collisionCheck dt c1 c2
in
if res /= NoCollision &&
collisionTime res < collisionTime ires
then (Cast c2, res)
else acc
)
(Cast c1, NoCollision)
playedCast
in
if null partners
then Cast c1
else
uncurry
(\(Cast c2) result -> Cast $ collide c1 c2 result)
partners
)
playedCast
wallCast (Cast c) =
Cast $ performWorldCollision c layer dt
walledCast =
V.map wallCast collidedCast
cattedCast = V.map
(\(Cast c) ->
Cast $ collide c oldCat $ collisionCheck dt c oldCat
)
walledCast
in
V.map
(\(Cast c) -> Cast $
move dt c
)
walledCast
updatedCast <- readTVar (testCast level)
oldCat <- fromJust <$> readTVar (testPlayer level)
releasedEffects <- stateTVar (testPowerups level) $ \pus ->
let living = V.foldl
(\acc pu ->
@ -113,10 +118,10 @@ update level dt = liftIO $ do
(testPlayer level) $ \(Just pituicat) ->
let playedCat = perform dt pituicat
castCat =
let allPartners = V.zip (V.fromList [0..V.length updatedCast])
let allPartners = V.zip (V.fromList [0..V.length oldCast])
(V.map
(\(Cast c) -> collisionCheck dt playedCat c)
updatedCast
oldCast
)
filtered = (V.filter ((/= NoCollision) . snd) allPartners)
partner = V.minimumBy
@ -129,7 +134,7 @@ update level dt = liftIO $ do
else
uncurry
(\(Cast c) cr -> collide playedCat c cr)
(updatedCast V.! fst partner, snd partner)
(oldCast V.! fst partner, snd partner)
walledCat = performWorldCollision castCat layer dt
affectedCat = walledCat
{ pcEffects = pcEffects walledCat ++

2
src/Types/PowerUp.hs
View file

@ -76,7 +76,7 @@ instance Actor PowerUp where
instance Mass PowerUp where
mass _ = 1
mass _ = 0.1
acceleration = puAcc