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 NoCollision
(_, _, True, _, _) -> (_, _, True, _, _) ->
A.log A.Debug ("CORNER CASE!") NoCollision A.log A.Debug ("CORNER CASE!") NoCollision
(False, False, _, _, _) ->
NoCollision
x -> error $ x -> error $
"Unhandled combination of collision check results: " "Unhandled combination of collision check results: "
<> (fromString $ show x) <> (fromString $ show x)

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

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

2
src/Types/PowerUp.hs
View file

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