justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Steps towards making clouds list based

Browse Source
This commit is contained in:
jgk
2021-07-21 00:05:13 +02:00
parent af44a380fc
commit 7b45a4a295
7 changed files with 65 additions and 67 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update.hs
+36 -39
View File
@@ -80,11 +80,10 @@ update' w = case _menuLayers w of
where
(x,y) = crZoneOfPoint $ _crPos cr
cid = _crID cr
zoneClouds = set cloudsZone (IM.foldr cloudInZone IM.empty (_clouds w))
cloudInZone cr = insertIMInZone x y cid cr
zoneClouds = set cloudsZone (foldr cloudInZone IM.empty (_clouds w))
cloudInZone cl = insertInZoneWith x y (++) [cl]
where
(x,y) = cloudZoneOfPoint $ _clPos cr
cid = _clID cr
(x,y) = cloudZoneOfPoint $ _clPos cl
updateCreatureGroups :: World -> World
updateCreatureGroups w = w & creatureGroups %~
@@ -161,43 +160,41 @@ checkEndGame w
| _crHP (you w) < 1 = haltSound $ w {_menuLayers = [GameOverMenu]}
| otherwise = w
--updateClouds :: World -> World
--updateClouds = (clouds .~ IM.empty) . (cloudsZone .~ IM.empty)
updateClouds :: World -> World
updateClouds w = IM.foldl' updateCloud w $ _clouds w
updateClouds w = w
--updateClouds w = IM.foldl' updateCloud w $ _clouds w
updateCloud :: World -> Cloud -> World
updateCloud w c
| _clTimer c < 1 = w & clouds %~ IM.delete (_clID c)
| otherwise = moveCloud c w
moveCloud :: Cloud -> World -> World
moveCloud c w = _clEffect c c . theUpdate $ w
where
newVel = 0.95 *.* springVels
springVels = IM.foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w)
oldPos = _clPos c
newPos = oldPos +.+ newVel
hitWl = collideCircWalls' oldPos newPos 5 $ wallsNearPoint newPos w
finalPos = maybe newPos fst hitWl
finalVel = maybe newVel snd hitWl
theUpdate w' = w'
& clouds . ix (_clID c) . clTimer %~ (\t -> t - 1)
& clouds . ix (_clID c) . clVel .~ finalVel
& clouds . ix (_clID c) . clPos .~ finalPos
clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2
clClSpringVel a v b
| ida == idb = v
| dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)
| otherwise = v
where
ida = _clID a
idb = _clID b
pa = _clPos a
pb = _clPos b
radDist = (_clRad a + _clRad b) / 2
--updateCloud :: World -> Cloud -> World
--updateCloud w c
-- | _clTimer c < 1 = w & clouds %~ IM.delete (_clID c)
-- | otherwise = moveCloud c w
--
--moveCloud :: Cloud -> World -> World
--moveCloud c w = _clEffect c c . theUpdate $ w
-- where
-- newVel = 0.95 *.* springVels
-- springVels = IM.foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w)
-- oldPos = _clPos c
-- newPos = oldPos +.+ newVel
-- hitWl = collideCircWalls' oldPos newPos 5 $ wallsNearPoint newPos w
-- finalPos = maybe newPos fst hitWl
-- finalVel = maybe newVel snd hitWl
-- theUpdate w' = w'
-- & clouds . ix (_clID c) . clTimer %~ (\t -> t - 1)
-- & clouds . ix (_clID c) . clVel .~ finalVel
-- & clouds . ix (_clID c) . clPos .~ finalPos
--
--clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2
--clClSpringVel a v b
-- | ida == idb = v
-- | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)
-- | otherwise = v
-- where
-- ida = _clID a
-- idb = _clID b
-- pa = _clPos a
-- pb = _clPos b
-- radDist = (_clRad a + _clRad b) / 2
simpleCrSprings :: World -> World
simpleCrSprings w = IM.foldr' crSpring w $ _creatures w