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

Commit before cloud changes

Browse Source
This commit is contained in:
justin
2021-07-20 23:45:45 +02:00
parent dd73c9c81c
commit af44a380fc
2 changed files with 8 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+2 -1
View File
@@ -110,7 +110,8 @@ creaturesNearPointI n p w = IM.unions [f b $ f a $ _creaturesZone w | a<-[x-n..
_ -> IM.empty _ -> IM.empty
cloudsNearPoint :: Point2 -> World -> IM.IntMap Cloud 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 where
(x,y) = cloudZoneOfPoint p (x,y) = cloudZoneOfPoint p
f i m = case IM.lookup i m of f i m = case IM.lookup i m of
src/Dodge/Update.hs
+6 -6
View File
@@ -165,10 +165,10 @@ checkEndGame w
--updateClouds = (clouds .~ IM.empty) . (cloudsZone .~ IM.empty) --updateClouds = (clouds .~ IM.empty) . (cloudsZone .~ IM.empty)
updateClouds :: World -> World updateClouds :: World -> World
updateClouds w = IM.foldr' updateCloud w $ _clouds w updateClouds w = IM.foldl' updateCloud w $ _clouds w
updateCloud :: Cloud -> World -> World updateCloud :: World -> Cloud -> World
updateCloud c w updateCloud w c
| _clTimer c < 1 = w & clouds %~ IM.delete (_clID c) | _clTimer c < 1 = w & clouds %~ IM.delete (_clID c)
| otherwise = moveCloud c w | otherwise = moveCloud c w
@@ -176,7 +176,7 @@ moveCloud :: Cloud -> World -> World
moveCloud c w = _clEffect c c . theUpdate $ w moveCloud c w = _clEffect c c . theUpdate $ w
where where
newVel = 0.95 *.* springVels 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 oldPos = _clPos c
newPos = oldPos +.+ newVel newPos = oldPos +.+ newVel
hitWl = collideCircWalls' oldPos newPos 5 $ wallsNearPoint newPos w 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) . clVel .~ finalVel
& clouds . ix (_clID c) . clPos .~ finalPos & clouds . ix (_clID c) . clPos .~ finalPos
clClSpringVel :: Cloud -> Cloud -> Point2 -> Point2 clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2
clClSpringVel a b v clClSpringVel a v b
| ida == idb = v | ida == idb = v
| dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb) | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)
| otherwise = v | otherwise = v