Fix poison gas

This commit is contained in:
2021-08-28 19:24:15 +01:00
parent ef73964d09
commit f977742f06
6 changed files with 42 additions and 16 deletions
+1 -1
View File
@@ -132,7 +132,7 @@ data Cloud = Cloud
, _clRad :: Float , _clRad :: Float
, _clTimer :: Int , _clTimer :: Int
, _clType :: CloudType , _clType :: CloudType
-- , _clEffect :: Cloud -> World -> World , _clEffect :: Cloud -> World -> World
} }
data CloudType data CloudType
= SmokeCloud = SmokeCloud
+6 -3
View File
@@ -541,17 +541,20 @@ poisonSprayer = defaultAutoGun
, _itUseTime = 0 , _itUseTime = 0
, _itUse = const aGasCloud , _itUse = const aGasCloud
, _itUseModifiers = , _itUseModifiers =
[ useTimeCheckI [ ammoCheckI
, withSoundI buzzSound , useTimeCheckI
, withSoundForI foamSpray 5
, useAmmo 1 , useAmmo 1
, spreadNumI
] ]
, _wpSpread = 0.3
, _wpRange = 8 , _wpRange = 8
, _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itFloorPict = onLayer FlItLayer $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _itAimingSpeed = 0.2 , _itAimingSpeed = 0.2
, _itAimingRange = 0 , _itAimingRange = 0
, _itZoom = defaultItZoom , _itZoom = defaultItZoom
, _itEquipPict = pictureWeaponOnAim $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4) , _itEquipPict = pictureWeaponOnAim $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
, _wpSpread = 0.1
, _wpNumBarrels = 3
} }
flamer :: Item flamer :: Item
flamer = defaultAutoGun flamer = defaultAutoGun
+2
View File
@@ -24,6 +24,8 @@ launcherSound = 20
smokeTrailSound = 21 smokeTrailSound = 21
foot1Sound = 22 foot1Sound = 22
foot2Sound = 23 foot2Sound = 23
foamSpray :: Int
foamSpray = 41
foamSprayFadeOutSound :: Int foamSprayFadeOutSound :: Int
foamSprayFadeOutSound = 42 foamSprayFadeOutSound = 42
sineRaisePitchOneSecSound :: Int sineRaisePitchOneSecSound :: Int
+27 -6
View File
@@ -166,17 +166,22 @@ checkEndGame w
| _crHP (you w) < 1 = haltSound $ w {_menuLayers = [GameOverMenu]} | _crHP (you w) < 1 = haltSound $ w {_menuLayers = [GameOverMenu]}
| otherwise = w | otherwise = w
--updateClouds :: World -> World
--updateClouds w = w' & clouds %~ mapMaybe (updateCloud w)
updateClouds :: World -> World updateClouds :: World -> World
updateClouds w = w & clouds %~ mapMaybe (updateCloud w) updateClouds w = w' & clouds .~ catMaybes mclouds
--updateClouds w = IM.foldl' updateCloud w $ _clouds w where
(w',mclouds) = mapAccumR updateCloud' w (_clouds w)
-- did i write a mapMaybeAccumR ?
updateCloud :: World -> Cloud -> Maybe Cloud updateCloud' :: World -> Cloud -> (World,Maybe Cloud)
updateCloud w c updateCloud' w c
| _clTimer c < 1 = Nothing | _clTimer c < 1 = (w, Nothing)
| otherwise = Just $ c | otherwise = (_clEffect c c w, Just $ c
& clPos .~ finalPos & clPos .~ finalPos
& clVel .~ finalVel & clVel .~ finalVel
& clTimer -~ 1 & clTimer -~ 1
)
where where
newVel = 0.95 *.* springVels newVel = 0.95 *.* springVels
springVels = foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w) springVels = foldl' (clClSpringVel c) (_clVel c) (cloudsNearPoint oldPos w)
@@ -186,6 +191,22 @@ updateCloud w c
finalPos = maybe newPos fst hitWl finalPos = maybe newPos fst hitWl
finalVel = maybe newVel snd hitWl finalVel = maybe newVel snd hitWl
--updateCloud :: World -> Cloud -> Maybe Cloud
--updateCloud w c
-- | _clTimer c < 1 = Nothing
-- | otherwise = Just $ c
-- & clPos .~ finalPos
-- & clVel .~ finalVel
-- & clTimer -~ 1
-- where
-- newVel = 0.95 *.* springVels
-- springVels = 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
clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2 clClSpringVel :: Cloud -> Point2 -> Cloud -> Point2
clClSpringVel a v b clClSpringVel a v b
| dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb) | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)
+1 -1
View File
@@ -19,7 +19,7 @@ makeCloudAt rad t drawFunc p w = w & clouds %~ (theCloud :)
, _clRad = rad , _clRad = rad
, _clTimer = t , _clTimer = t
, _clType = SmokeCloud , _clType = SmokeCloud
--, _clEffect = const id , _clEffect = const id
} }
drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
+5 -5
View File
@@ -10,7 +10,7 @@ import Dodge.Base
import Dodge.Base.Zone import Dodge.Base.Zone
import Dodge.Base.Collide import Dodge.Base.Collide
import Dodge.Picture import Dodge.Picture
import Dodge.Picture.Layer --import Dodge.Picture.Layer
import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.HitEffect
import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.ThingsHit
import Dodge.WorldEvent.Cloud import Dodge.WorldEvent.Cloud
@@ -197,8 +197,8 @@ drawFlameletZ rot pt = pictures
$ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2) $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2)
pic = setDepth (z + 20) pic = setDepth (z + 20)
. uncurryV translate ep . uncurryV translate ep
. color (brightX 1 2 $ mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time)
white (dark red) (V4 1 1 1 3) (V4 1 0 0 1)
) )
. rotate (negate ( 0.1 * fromIntegral time + rot)) . rotate (negate ( 0.1 * fromIntegral time + rot))
. scale (0.5* sc) (0.5 *sc) . scale (0.5* sc) (0.5 *sc)
@@ -281,12 +281,12 @@ makeGasCloud pos vel w = w
theCloud = Cloud theCloud = Cloud
{ _clPos = pos { _clPos = pos
, _clVel = vel , _clVel = vel
, _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col) , _clPict = \_ -> setLayer 2 . setDepth 30 $ color (withAlpha 0.1 col)
$ circleSolid 20 $ circleSolid 20
, _clRad = 10 , _clRad = 10
, _clTimer = 400 , _clTimer = 400
, _clType = GasCloud , _clType = GasCloud
-- , _clEffect = cloudPoisonDamage , _clEffect = cloudPoisonDamage
} }
(col, g) = runState (takeOne [green,yellow]) $ _randGen w (col, g) = runState (takeOne [green,yellow]) $ _randGen w