diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs index 50c970845..90de1bce8 100644 --- a/src/Dodge/Combine/Combinations.hs +++ b/src/Dodge/Combine/Combinations.hs @@ -2,7 +2,6 @@ module Dodge.Combine.Combinations where import Geometry import Dodge.Data -import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.SpawnParticle import Dodge.Particle.Bullet.HitEffect import Dodge.Item.Equipment @@ -115,8 +114,9 @@ moduleCombinations = ) , ( ModBullet , bulletWeapons - , [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ bulletDestroySpawn incBall) - ,amod [BOUNCEMODULE] "+BOUNCE" (f $ destroyOnImpact bulBounceArmCr bulBounceWall) +-- , [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ bulletDestroySpawn incBall) + , [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ bulletDestroyDamage $ spawnBulDams incBall') + ,amod [BOUNCEMODULE] "+BOUNCE" (f $ bulletDestroyDamage bounceBulDams) ,amod [STATICMODULE] "+STATIC" (f $ bulletDestroySpawn aStaticBall) ,amod [CONCUSSMODULE] "+CONCUSS" (f $ bulletDestroySpawn concBall) ] diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs index b52d8d691..5b90ac39a 100644 --- a/src/Dodge/Creature/Damage.hs +++ b/src/Dodge/Creature/Damage.hs @@ -7,6 +7,8 @@ import Color import Geometry import LensHelp +import Control.Monad.State +import System.Random import Data.List defaultApplyDamage :: [Damage] -> Creature -> (World -> World, Creature) @@ -39,8 +41,9 @@ applyDamageEffect dm de (f,cr) = case de of reflectVel = magV bulVel *.* newDir newDir = squashNormalizeV (p -.- _crPos cr) bulVel = _ptVel bt - SparkBullet _ -> (f, cr) -- TODO - _ -> (f,cr) + DamageSpawn f -> (instantParticles .:~ thepart, cr) + where + thepart = evalState (f (Left cr) dm) $ mkStdGen 0 where fromDir = _dmFrom dm p = _dmAt dm diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index f09cb8e69..bc5394bc2 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -1013,6 +1013,8 @@ data DamageEffect | PushBackDamage {_dePushBack :: Point2 } | BounceBullet {_bulToBounce :: Particle} | SparkBullet {_bulToSpark :: Particle} + | DamageSpawn {_spawnFunc + :: Either Creature Wall -> Damage -> State StdGen Particle} | NoDamageEffect -- deriving (Eq,Ord,Show) diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index d79411986..c54134e56 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -1,6 +1,5 @@ module Dodge.Item.Weapon.Bullet ( basicBullet - , ltBullet , hvBullet ) where import Dodge.Data @@ -11,19 +10,12 @@ import Geometry.Data basicBullet :: AmmoType basicBullet = BulletAmmo { _amString = "BASIC" - , _amBulEff = destroyOnImpact bulHitCr bulHitWall + --, _amBulEff = destroyOnImpact bulHitCr bulHitWall + , _amBulEff = bulletDestroyDamage basicBulDams , _amBulWth = 2 , _amBulVel = V2 50 0 , _amBulTraj = BasicBulletTrajectory } -ltBullet :: AmmoType -ltBullet = BulletAmmo - { _amString = "LTBULLET" - , _amBulEff = destroyOnImpact bulHitCr bulHitWall - , _amBulWth = 2 - , _amBulVel = V2 40 0 - , _amBulTraj = BasicBulletTrajectory - } hvBullet :: AmmoType hvBullet = BulletAmmo { _amString = "HVBULLET" diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 92eab9b3a..1ca1bff54 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -1,20 +1,21 @@ {- | Effects of bullets upon impact with walls or creatures. -} module Dodge.Particle.Bullet.HitEffect - ( bulHitCr - , bulHitWall + ( basicBulDams + , bounceBulDams + , spawnBulDams , hvBulHitCr , hvBulHitWall , bulletDestroySpawn - , bulBounceArmCr - , bulBounceWall + , bulletDestroyDamage + , bulBounceCr +-- , bulBounceWall ) where import Dodge.Data import Dodge.Particle.Spark import Dodge.Wall.Damage import Dodge.WorldEvent -import Dodge.Particle.Bullet.Spawn +--import Dodge.WorldEvent.HitEffect import Dodge.RandomHelp -import Dodge.Creature.Property import Dodge.Wall.Reflect import Geometry import Picture @@ -23,48 +24,49 @@ import LensHelp import System.Random import Control.Monad.State -crArmourSplit - :: (Particle -> Point2 -> Creature -> World -> World) -- | normal effect - -> (Particle -> Point2 -> Creature -> World -> World) -- | armoured effect - -> Particle -> Point2 -> Creature -> World -> World -crArmourSplit normalf armourf bt p cr - | crIsArmouredFrom p cr = armourf bt p cr - | otherwise = normalf bt p cr - - -bounceArmour :: Particle -> Point2 -> Creature -> World -> World -bounceArmour bt p cr = addBouncer . addDamageArmoured +spawnBulDams :: (Particle -> Either Creature Wall -> Damage -> State StdGen Particle) + -> Particle -> Point2 -> [Damage] +spawnBulDams thespawn bt p = + [ Damage Piercing 50 sp p ep (DamageSpawn $ thespawn bt) + , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel + ] + where + sp = head $ _ptTrail bt + bulVel = _ptVel bt + ep = sp +.+ bulVel + +basicBulDams :: Particle -> Point2 -> [Damage] +basicBulDams bt p = + [ Damage Piercing 100 sp p ep NoDamageEffect + , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel + ] + where + sp = head $ _ptTrail bt + bulVel = _ptVel bt + ep = sp +.+ bulVel + +bounceBulDams :: Particle -> Point2 -> [Damage] +bounceBulDams bt p = + [ Damage Piercing 80 sp p ep (BounceBullet bt) + , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel + ] where sp = head $ _ptTrail bt bulVel = _ptVel bt ep = sp +.+ bulVel - mvDams = [ Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel ] - addDamageArmoured = creatures . ix cid . crState . crDamage .++~ mvDams - cid = _crID cr - newDir = squashNormalizeV (p -.- _crPos cr) - pOut = p +.+ 2 *.* newDir - reflectVel = magV bulVel *.* newDir - addBouncer = instantParticles .:~ bouncer - bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt) - (_ptHitEff bt) (_ptWidth bt) - ) {_ptTimer = _ptTimer bt - 1} -- | Basic bullet hit creature effect. -bulHitCr :: Particle -> Point2 -> Creature -> World -> World -bulHitCr bt p cr = addDamage +bulBounceCr :: Particle -> Point2 -> Creature -> World -> World +bulBounceCr bt p cr = addDamage where sp = head $ _ptTrail bt bulVel = _ptVel bt ep = sp +.+ bulVel mvDams = [ Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel ] addDamage = creatures . ix cid . crState . crDamage .++~ - (Damage Piercing 100 sp p ep NoDamageEffect : mvDams) + (Damage Piercing 100 sp p ep (BounceBullet bt) : mvDams) cid = _crID cr - -{- | Bounce off armoured creatures, otherwise do damage. -} -bulBounceArmCr :: Particle -> Point2 -> Creature -> World -> World -bulBounceArmCr = crArmourSplit bulHitCr bounceArmour {- | Heavy bullet effects when hitting creature: piercing, blunt, twisting and pushback damage all applied. -} hvBulHitCr :: Particle -> Point2 -> Creature -> World -> World @@ -92,6 +94,25 @@ bulletDestroySpawn :: (Point2 -> State StdGen Particle) -> (World, Maybe Particle) bulletDestroySpawn f = destroyOnImpact (bulDestroyCr f) (bulDestroyWall f) +bulletDestroyDamage :: (Particle -> Point2 -> [Damage]) + -> Particle + -> [(Point2, Either Creature Wall)] + -> World + -> (World, Maybe Particle) +bulletDestroyDamage fdm bt hitThings w = case hitThings of + [] -> (w, mvPt bt) + ((p,Left cr):_) -> (creff cr p w, destroyAt p bt) + ((p,Right wl):_) -> (wleff wl p, destroyAt p bt) + where + creff cr p = addDamage + where + dams = fdm bt p + addDamage = creatures . ix cid . crState . crDamage .++~ dams + cid = _crID cr + wleff wl p = foldr (\d -> damageWall d wl) w dams + where + dams = fdm bt p + {- | Create a particle when hitting a creature. -} bulDestroyCr :: (Point2 -> State StdGen Particle) -> Particle -> Point2 -> Creature -> World -> World @@ -123,19 +144,6 @@ bulDestroyWall f bt p wl w = w wallV = uncurry (-.-) (_wlLine wl) reflectVel = squashNormalizeV $ reflectIn wallV (_ptVel bt) -{- | Hitting wall effects: create a spark, damage blocks. -} -bulHitWall :: Particle -> Point2 -> Wall -> World -> World -bulHitWall bt p = damageWall (Damage Piercing 100 sp p ep NoDamageEffect) - where - ep = sp +.+ _ptVel bt - sp = head $ _ptTrail bt -{- | Bounce off walls, do damage to blocks. -} -bulBounceWall :: Particle -> Point2 -> Wall -> World -> World -bulBounceWall bt p = damageWall (Damage Blunt 50 sp p ep (BounceBullet bt)) - where - ep = sp +.+ _ptVel bt - sp = head $ _ptTrail bt - hvBulHitWall :: Particle -> Point2 -- ^ Impact point diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index 2a9282bd2..8ba43fe19 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -8,6 +8,8 @@ import Geometry import Color import LensHelp +import Control.Monad.State + defaultWallDamage :: Damage -> Wall -> World -> World defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of Lasering -> colSpark 8 lSparkCol outTo (reflDirWall sp p wl) @@ -31,8 +33,8 @@ defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of lSparkCol = V4 20 (-5) 0 1 wallDamageEffect :: Damage -> Wall -> World -> World -wallDamageEffect dm wl = case _dmEffect dm of - BounceBullet bt -> instantParticles .:~ thebouncer +wallDamageEffect dm wl w = case _dmEffect dm of + BounceBullet bt -> w & instantParticles .:~ thebouncer where reflectVel = reflVelWall wl (_ptVel bt) thebouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt) @@ -40,4 +42,8 @@ wallDamageEffect dm wl = case _dmEffect dm of pOut = p +.+ squashNormalizeV (sp -.- p) p = _dmAt dm sp = _dmFrom dm - _ -> id + DamageSpawn f -> w & instantParticles .:~ thepart + & randGen .~ g + where + (thepart,g) = runState (f (Right wl) dm) $ _randGen w + _ -> w diff --git a/src/Dodge/WorldEvent/HitEffect.hs b/src/Dodge/WorldEvent/HitEffect.hs index 88e74899c..b8fb330c9 100644 --- a/src/Dodge/WorldEvent/HitEffect.hs +++ b/src/Dodge/WorldEvent/HitEffect.hs @@ -1,6 +1,8 @@ module Dodge.WorldEvent.HitEffect ( destroyOnImpact , penWalls + , mvPt + , destroyAt ) where import Dodge.Data import Geometry diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 31a017267..fda38ec69 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -6,6 +6,7 @@ module Dodge.WorldEvent.SpawnParticle , aStaticBall , makeStaticBall , incBall + , incBall' , concBall ) where import Dodge.Data @@ -83,16 +84,16 @@ moveFlame :: Point2 -- ^ Rotation direction moveFlame rotd w pt | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing) | otherwise = case thingsHitExceptCr (_ptCrIgnore pt) sp ep w of - ((_,Left _):_) -> (doSound $ damwls damcrs , mvPt 0.7) + ((_,Left _):_) -> (doSound $ damwls damcrs , mvPt' 0.7) ((p,Right wl):_) -> (doSound $ damwls damcrs , rfl wl p) - _ -> (ptFlicker pt . damwls $ doSound damcrs , mvPt 0.98) + _ -> (ptFlicker pt . damwls $ doSound damcrs , mvPt' 0.98) where time = _ptTimer pt doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2) sp@(V2 x y) = _ptPos pt vel = _ptVel pt ep = sp +.+ vel - mvPt speed = Just $ pt + mvPt' speed = Just $ pt { _ptTimer = time - 1 , _ptPos = ep , _ptCrIgnore = Nothing @@ -130,6 +131,24 @@ incBall vel = do , _ptZ = 20 } +incBall' :: Particle -> Either Creature Wall -> Damage -> State StdGen Particle +incBall' bt ecrwl dm = do + rot <- state $ randomR (0,3) + return PtZ + { _ptDraw = drawFlameletZ rot + , _ptUpdate = moveFlamelet + , _ptVel = vel + , _ptColor = red + , _ptPos = p + , _ptCrIgnore = Nothing + , _ptWidth = 3 + , _ptTimer = 20 + , _ptHitEff = damageBothTypeAmount Flaming 20 + , _ptZ = 20 + } + where + vel = 0 + p = _dmFrom dm concBall :: Point2 -> State g Particle concBall _ = return Shockwave { _ptDraw = drawShockwave @@ -284,9 +303,9 @@ Applies movement and attaches damage to nearby creatures. -} moveFlamelet :: World -> Particle -> (World, Maybe Particle) moveFlamelet w pt | _ptTimer pt <= 0 = ( w, Nothing) - | otherwise = (ptFlicker pt $ damageInRadius 5 mvPt w, Just mvPt) + | otherwise = (ptFlicker pt $ damageInRadius 5 mvPt' w, Just mvPt') where - mvPt = pt + mvPt' = pt & ptTimer -~ 1 & ptPos .~ _ptPos pt +.+ _ptVel pt & ptCrIgnore .~ Nothing