diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index aaf5299eb..02913f49a 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -110,7 +110,8 @@ creaturesNearPointI n p w = IM.unions [f b $ f a $ _creaturesZone w | a<-[x-n.. _ -> IM.empty cloudsNearPoint :: Point2 -> World -> IM.IntMap Cloud -cloudsNearPoint p w = IM.unions [f b $ f a $ _cloudsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]] +--cloudsNearPoint p w = IM.unions [f b $ f a $ _cloudsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]] +cloudsNearPoint p w = f y $ f x $ _cloudsZone w where (x,y) = cloudZoneOfPoint p f i m = case IM.lookup i m of diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index e25c26e11..338f43f80 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -165,10 +165,10 @@ checkEndGame w --updateClouds = (clouds .~ IM.empty) . (cloudsZone .~ IM.empty) updateClouds :: World -> World -updateClouds w = IM.foldr' updateCloud w $ _clouds w +updateClouds w = IM.foldl' updateCloud w $ _clouds w -updateCloud :: Cloud -> World -> World -updateCloud c w +updateCloud :: World -> Cloud -> World +updateCloud w c | _clTimer c < 1 = w & clouds %~ IM.delete (_clID c) | otherwise = moveCloud c w @@ -176,7 +176,7 @@ moveCloud :: Cloud -> World -> World moveCloud c w = _clEffect c c . theUpdate $ w where newVel = 0.95 *.* springVels - springVels = IM.foldr' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w) + springVels = IM.foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w) oldPos = _clPos c newPos = oldPos +.+ newVel hitWl = collideCircWalls' oldPos newPos 5 $ wallsNearPoint newPos w @@ -187,8 +187,8 @@ moveCloud c w = _clEffect c c . theUpdate $ w & clouds . ix (_clID c) . clVel .~ finalVel & clouds . ix (_clID c) . clPos .~ finalPos -clClSpringVel :: Cloud -> Cloud -> Point2 -> Point2 -clClSpringVel a b v +clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2 +clClSpringVel a v b | ida == idb = v | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb) | otherwise = v