diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 30c1c9e09..37ec61875 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -80,7 +80,7 @@ update' w = case _menuLayers w of where (x,y) = crZoneOfPoint $ _crPos cr cid = _crID cr - zoneClouds = set cloudsZone (foldr cloudInZone IM.empty (_clouds w)) + zoneClouds = set cloudsZone (foldl' (flip cloudInZone) IM.empty (_clouds w)) cloudInZone cl = insertInZoneWith x y (++) [cl] where (x,y) = cloudZoneOfPoint $ _clPos cl @@ -161,9 +161,21 @@ checkEndGame w | otherwise = w updateClouds :: World -> World -updateClouds w = w +updateClouds w = w & clouds %~ mapMaybe (updateCloud w) --updateClouds w = IM.foldl' updateCloud w $ _clouds w +updateCloud :: World -> Cloud -> Maybe Cloud +updateCloud w c + | _clTimer c < 1 = Nothing + | otherwise = Just $ c + & clPos %~ (+.+ newVel) + & clVel .~ newVel + & clTimer -~ 1 + where + newVel = 0.90 *.* springVels + springVels = foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w) + oldPos = _clPos c + --updateCloud :: World -> Cloud -> World --updateCloud w c -- | _clTimer c < 1 = w & clouds %~ IM.delete (_clID c) @@ -184,17 +196,14 @@ updateClouds w = w -- & 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 +clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2 +clClSpringVel a v b + | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb) + | otherwise = v + where + pa = _clPos a + pb = _clPos b + radDist = (_clRad a + _clRad b) / 2 simpleCrSprings :: World -> World simpleCrSprings w = IM.foldr' crSpring w $ _creatures w diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index 0fed2477b..539beb87e 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -5,7 +5,7 @@ import Dodge.Data import Dodge.Base --import Geometry import Picture -import qualified IntMapHelp as IM +--import qualified IntMapHelp as IM import Control.Lens