From e4c73b9b8b51f71c4b5716bde721ce3dce5c425a Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 1 Nov 2021 16:50:09 +0000 Subject: [PATCH] Control wall damage effects using the wall --- src/Dodge/Default.hs | 10 ++-- src/Dodge/Item/Weapon/BatteryGuns.hs | 7 +-- src/Dodge/Particle/Bullet/HitEffect.hs | 27 ++++------ src/Dodge/Update.hs | 8 ++- src/Dodge/Wall/Damage.hs | 71 ++++++++++++++++++++++++++ src/Dodge/WorldEvent/DamageBlock.hs | 25 --------- src/Dodge/WorldEvent/Shockwave.hs | 2 +- 7 files changed, 93 insertions(+), 57 deletions(-) create mode 100644 src/Dodge/Wall/Damage.hs delete mode 100644 src/Dodge/WorldEvent/DamageBlock.hs diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index c91acf6bd..0e2c763cf 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -218,15 +218,15 @@ defaultMachine = Machine , _mcDraw = const mempty , _mcPos = V2 0 0 , _mcDir = 0 - , _mcHP = 100 + , _mcHP = 1000 , _mcSensor = 0 , _mcDamage = [] } defaultMachineUpdate :: Machine -> World -> World -defaultMachineUpdate mc w - | _mcHP mc < 1 = w & machines %~ IM.delete mcid - & deleteWallIDs (_mcWallIDs mc) - | otherwise = w & machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) ) +defaultMachineUpdate mc + | _mcHP mc < 1 = (machines %~ IM.delete mcid) + . deleteWallIDs (_mcWallIDs mc) + | otherwise = machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) ) where dams = sum $ map _dmAmount $ _mcDamage mc mcid = _mcID mc diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 142bbd901..9687dba9d 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -9,7 +9,7 @@ import Dodge.SoundLogic.LoadSound import Dodge.Creature.State.Data import Dodge.Data.DamageType import Dodge.WorldEvent -import Dodge.WorldEvent.DamageBlock +import Dodge.Wall.Damage import Dodge.Default import Dodge.Item.Draw import Dodge.Item.Data @@ -186,7 +186,6 @@ moveLaser phaseV pos dir w pt ) where xp = pos +.+ 800 *.* unitVectorAtAngle dir - reflectDir wall = argV (reflectIn (uncurry (-.-) (_wlLine wall)) (xp -.- pos)) f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either Creature Wall),[Point2]) f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of Just (p,Right wl) @@ -225,9 +224,7 @@ moveLaser phaseV pos dir w pt hitEffect = case thHit of Just (p,Left cr) -> creatures . ix (_crID cr) . crState . crDamage %~ (Lasering 19 pos p xp :) - Just (p,Right wl) -> colSpark 8 (V4 20 (-5) 0 1) (p +.+ safeNormalizeV (pos -.- p)) - (reflectDir wl) - . damageWall (Lasering 19 pos p xp) wl + Just (p,Right wl) -> damageWall (Lasering 19 pos p xp) wl _ -> id pic = setLayer 1 $ pictures [ setDepth 19 . color (brightX 0 0.5 yellow) $ lineOfThickness 20 (pos:ps) diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 3a6f8db23..37444bfa4 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -6,7 +6,7 @@ module Dodge.Particle.Bullet.HitEffect import Dodge.Data import Dodge.Data.DamageType import Dodge.Data.SoundOrigin -import Dodge.WorldEvent.DamageBlock +import Dodge.Wall.Damage import Dodge.WorldEvent import Dodge.Particle.Bullet.Spawn import Dodge.SoundLogic @@ -16,7 +16,7 @@ import Dodge.WorldEvent.Shockwave import Dodge.Creature.State.Data import Dodge.Creature.Property import Geometry -import Geometry.Vector3D +--import Geometry.Vector3D import Picture import System.Random @@ -132,24 +132,18 @@ bulConCr' bt p cr w mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white) {- | Hitting wall effects: create a spark, damage blocks. -} bulHitWall :: Particle -> Point2 -> Wall -> World -> World -bulHitWall bt p wl w = damageBlocksBy 5 wl - . smokeCloudAt dustcol 20 200 1 (addZ 20 pOut) - $ colSpark' 0.2 8 theCol pOut (reflectDir wl) - w +bulHitWall bt p = damageWall (Piercing 100 sp p ep) where - dustcol = _wlColor wl & _4 .~ 1 - theCol = brightX 100 1.5 white + ep = sp +.+ _btVel' bt sp = head $ _btTrail' bt - pOut = p +.+ safeNormalizeV (sp -.- p) - reflectDir wall = argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) ) {- | Bounce off walls, do damage to blocks. -} -bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World -bulBounceWall' bt p wl w = damageBlocksBy 5 wl $ over worldEvents addBouncer w +bulBounceWall :: Particle -> Point2 -> Wall -> World -> World +bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl . over worldEvents addBouncer where + ep = sp +.+ _btVel' bt sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) - bouncer = (aGenBulAt Nothing pOut reflectVel - (_btHitEffect' bt) (_btWidth' bt) + bouncer = (aGenBulAt Nothing pOut reflectVel (_btHitEffect' bt) (_btWidth' bt) ) {_btTimer' = _btTimer' bt - 1} wallV = uncurry (-.-) (_wlLine wl) reflectVel = reflectIn wallV (_btVel' bt) @@ -159,14 +153,15 @@ bulBounceWall' bt p wl w = damageBlocksBy 5 wl $ over worldEvents addBouncer w -- this list {- | Create flamelet on wall. -} -bulIncWall' +bulIncWall :: Particle -> Point2 -- Impact point -> Wall -> World -> World -bulIncWall' bt p wl w = damageBlocksBy 5 wl $ incFlamelets w +bulIncWall bt p wl = damageWall (Blunt 50 sp p ep) wl . incFlamelets where + ep = sp +.+ _btVel' bt sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) wallV = uncurry (-.-) (_wlLine wl) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index bac6cb20f..e07d4d1c5 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -89,11 +89,10 @@ splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardC & blocks . ix (_blID bl) . blHPs %~ tail & theSoundEffect cen where - wls = map (_walls w IM.!) (IS.toList $ _blWallIDs bl) - ps = map (fst . _wlLine) wls - cen = centroid ps + wls = IM.restrictKeys (_walls w) (_blWallIDs bl) + cen = centroid $ fmap (fst . _wlLine) wls theSoundEffect - | _wlOpacity (head wls) == SeeThrough = mkSoundSplinterGlass + | _wlOpacity (snd $ IM.findMin wls) == SeeThrough = mkSoundSplinterGlass | otherwise = mkSoundSplinterBlock unshadowBlock :: Int -> World -> World @@ -121,7 +120,6 @@ destroyBlock bl w = w where wlids = _blWallIDs bl pos = fst . _wlLine $ _walls w IM.! IS.findMin wlids - -- | Note the explict use of record syntax. Using lens created a space leak. resetWorldEvents :: World -> World resetWorldEvents w = w {_worldEvents = id} diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs new file mode 100644 index 000000000..42e37bb3b --- /dev/null +++ b/src/Dodge/Wall/Damage.hs @@ -0,0 +1,71 @@ +{- | Controls a walls response to external damage. + - Indestructible walls may still produce sparks, dust etc + -} +module Dodge.Wall.Damage + ( damageBlocksBy + , damageWall + ) where +import Dodge.Data +import Dodge.Data.DamageType +import Dodge.WorldEvent.SpawnParticle +import Dodge.WorldEvent.Cloud +import Geometry +import Geometry.Vector3D +import Color + +import Control.Lens +damageWall :: DamageType -> Wall -> World -> World +damageWall dt wl = case _wlStructure wl of + MachinePart mcid -> machines . ix mcid . mcDamage %~ (dt :) + BlockPart blid -> wallEff dt wl . (blocks . ix blid %~ damageBlockWith dt) + _ -> wallEff dt wl +{- | Damage effects on indestructible walls -} +-- TODO take into account damage amount for amount of dust/sparks? +wallEff :: DamageType -> Wall -> World -> World +wallEff dt wl = case dt of + Lasering _ sp p _ -> colSpark 8 lSparkCol (outTo sp p) (reflDirWall sp p wl) + Piercing _ sp p _ -> colSpark' 0.2 8 pSparkCol (outTo sp p) (reflDirWall sp p wl) + . smokeCloudAt dustcol 20 200 1 (addZ 20 (outTo sp p)) + Blunt _ sp p _ -> smokeCloudAt dustcol 20 200 1 (addZ 20 (outTo sp p)) + Cutting {} -> id + SparkDam {} -> id + Flaming {} -> id + Electrical {} -> id + Concussive {} -> id + TorqueDam {} -> id + PushDam {} -> id + PoisonDam {} -> id + where + outTo sp p = p +.+ safeNormalizeV (sp -.- p) + dustcol = _wlColor wl & _4 .~ 1 + pSparkCol = brightX 100 1.5 white + lSparkCol = V4 20 (-5) 0 1 + +reflDirWall :: Point2 -> Point2 -> Wall -> Float +reflDirWall sp ep wl = argV (reflectIn (uncurry (-.-) (_wlLine wl)) (ep -.- sp)) + +damageBlockWith :: DamageType -> Block -> Block +damageBlockWith dt = case dt of + Piercing dam _ _ _ -> blHPs %~ reduceHead dam + Blunt dam _ _ _ -> blHPs %~ reduceHead dam + Cutting dam _ _ _ -> blHPs %~ reduceHead dam + Concussive dam _ _ _ _ -> blHPs %~ reduceHead dam + Lasering {} -> id + SparkDam {} -> id + Flaming {} -> id + Electrical {} -> id + TorqueDam {} -> id + PushDam {} -> id + PoisonDam {} -> id + +reduceHead :: Int -> [Int] -> [Int] +reduceHead y (x:xs) = x-y:xs +reduceHead _ _ = [] + +damageBlocksBy :: Int -> Wall -> World -> World +damageBlocksBy x wl = case wl ^? wlStructure . wlStBlock of + Just blid -> blocks . ix blid . blHPs %~ reduceHeadBy x + Nothing -> id + where + reduceHeadBy y (z:zs) = z - y : zs + reduceHeadBy _ [] = [] diff --git a/src/Dodge/WorldEvent/DamageBlock.hs b/src/Dodge/WorldEvent/DamageBlock.hs deleted file mode 100644 index 9e6771928..000000000 --- a/src/Dodge/WorldEvent/DamageBlock.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Dodge.WorldEvent.DamageBlock - ( damageBlocksBy - , damageWall - ) where -import Dodge.Data -import Dodge.Data.DamageType - -import Control.Lens - -damageWall :: DamageType -> Wall -> World -> World -damageWall dt wl = case _wlStructure wl of - MachinePart mcid -> machines . ix mcid . mcDamage %~ (dt :) - BlockPart blid -> blocks . ix blid %~ damageBlockWith dt - _ -> id - -damageBlockWith :: DamageType -> Block -> Block -damageBlockWith _ = id - -damageBlocksBy :: Int -> Wall -> World -> World -damageBlocksBy x wl = case wl ^? wlStructure . wlStBlock of - Just blid -> blocks . ix blid . blHPs %~ reduceHeadBy x - Nothing -> id - where - reduceHeadBy y (z:zs) = z - y : zs - reduceHeadBy _ [] = [] diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs index 4997a27b4..2e5710e15 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -6,7 +6,7 @@ module Dodge.WorldEvent.Shockwave import Dodge.Data import Dodge.Data.DamageType import Dodge.Creature.State.Data -import Dodge.WorldEvent.DamageBlock +import Dodge.Wall.Damage import Dodge.Base import Dodge.Zone import Dodge.Picture.Layer