Linting, refactor random angle walk for flamer
This commit is contained in:
+119
-104
@@ -1,3 +1,6 @@
|
||||
{- |
|
||||
Effects of bullets upon impact with walls or creatures, and possibly force fields.
|
||||
-}
|
||||
module Dodge.Item.Weapon.Bullet
|
||||
where
|
||||
import Dodge.Data
|
||||
@@ -6,21 +9,16 @@ import Dodge.WorldEvent
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.RandomHelp
|
||||
import Dodge.WorldEvent.Shockwave
|
||||
|
||||
import Dodge.Creature.Property
|
||||
|
||||
import Geometry
|
||||
|
||||
import System.Random
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
|
||||
import Picture
|
||||
|
||||
-- | bullet effects
|
||||
import System.Random
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
|
||||
-- | Basic bullet hit creature effect.
|
||||
bulHitCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulHitCr' bt p cr w
|
||||
| crIsArmouredFrom p cr
|
||||
@@ -35,13 +33,13 @@ bulHitCr' bt p cr w
|
||||
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
|
||||
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
|
||||
hitSound = soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
flashEff = over worldEvents ((.) $ bloodFlashAt p)
|
||||
flashEff = over worldEvents (bloodFlashAt p . )
|
||||
cid = _crID cr
|
||||
(d1,g) = randomR (-0.7,0.7) $ _randGen w
|
||||
(colID,_) = randomR (0,11) $ _randGen w
|
||||
p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
|
||||
|
||||
{-
|
||||
{- |
|
||||
Bounce off armoured creatures, otherwise do damage.
|
||||
-}
|
||||
bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
@@ -63,112 +61,104 @@ bulBounceArmCr' bt p cr w
|
||||
newDir = safeNormalizeV (p -.- _crPos cr)
|
||||
pOut = p +.+ 2 *.* newDir
|
||||
reflectVel = magV bulVel *.* newDir
|
||||
addBouncer = worldEvents %~ ((over particles (bouncer :) ) . )
|
||||
addBouncer = worldEvents %~ ( over particles (bouncer :) . )
|
||||
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
|
||||
(_btHitEffect' bt) (_btWidth' bt)
|
||||
) {_btTimer' = _btTimer' bt - 1}
|
||||
|
||||
{-
|
||||
{- |
|
||||
Bullet pass through creatures.
|
||||
-}
|
||||
bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulPenCr' bt p cr w
|
||||
= over (creatures . ix cid . crState . crDamage)
|
||||
(\dams -> [Piercing 50 sp p ep
|
||||
,Blunt 50 sp p ep
|
||||
,TorqueDam 1 d1
|
||||
,PushDam 1 $ 3 *.* (ep -.- sp)
|
||||
] ++ dams
|
||||
)
|
||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
$ over worldEvents addPiercer
|
||||
w
|
||||
where (d1,g) = randomR (-0.7,0.7) $ _randGen w
|
||||
cid = _crID cr
|
||||
sp = head $ _btTrail' bt
|
||||
ep = sp +.+ _btVel' bt
|
||||
addPiercer = (.) $ over particles (piercer :)
|
||||
piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt)
|
||||
(_btHitEffect' bt) (_btWidth' bt)
|
||||
) {_btTimer' = _btTimer' bt - 1}
|
||||
|
||||
{- Heavy bullet effects when hitting creature:
|
||||
piercing, blunt, twisting and pushback damage all applied.
|
||||
-}
|
||||
hvBulHitCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
hvBulHitCr' bt p cr w = over (creatures . ix cid . crState . crDamage)
|
||||
(\dams -> [Piercing 200 sp p ep
|
||||
,Blunt 100 sp p ep
|
||||
,TorqueDam 1 d1
|
||||
,PushDam 1 $ 3 *.* (ep -.- sp)
|
||||
] ++ dams
|
||||
)
|
||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
w
|
||||
([Piercing 50 sp p ep
|
||||
,Blunt 50 sp p ep
|
||||
,TorqueDam 1 d1
|
||||
,PushDam 1 $ 3 *.* (ep -.- sp)
|
||||
]
|
||||
++
|
||||
)
|
||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
$ over worldEvents (addPiercer . )
|
||||
w
|
||||
where
|
||||
(d1,g) = randomR (-0.7,0.7) $ _randGen w
|
||||
cid = _crID cr
|
||||
sp = head $ _btTrail' bt
|
||||
ep = sp +.+ _btVel' bt
|
||||
|
||||
addPiercer = over particles (piercer :)
|
||||
piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt)
|
||||
(_btHitEffect' bt) (_btWidth' bt)
|
||||
) {_btTimer' = _btTimer' bt - 1}
|
||||
{- |
|
||||
Heavy bullet effects when hitting creature:
|
||||
piercing, blunt, twisting and pushback damage all applied. -}
|
||||
hvBulHitCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
hvBulHitCr' bt p cr w
|
||||
= over (creatures . ix cid . crState . crDamage)
|
||||
([Piercing 200 sp p ep
|
||||
,Blunt 100 sp p ep
|
||||
,TorqueDam 1 d1
|
||||
,PushDam 1 $ 3 *.* (ep -.- sp)
|
||||
]
|
||||
++
|
||||
)
|
||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
w
|
||||
where
|
||||
(d1,g) = randomR (-0.7,0.7) $ _randGen w
|
||||
cid = _crID cr
|
||||
sp = head $ _btTrail' bt
|
||||
ep = sp +.+ _btVel' bt
|
||||
{- |
|
||||
Create a flamelet when hitting a creature. -}
|
||||
bulIncCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulIncCr' bt p cr w
|
||||
= over (creatures . ix cid . crState . crDamage)
|
||||
(\dams -> [Piercing 60 sp p ep
|
||||
] ++ dams
|
||||
)
|
||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
$ incFlamelets
|
||||
w
|
||||
( Piercing 60 sp p ep : )
|
||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
$ incFlamelets
|
||||
w
|
||||
where
|
||||
cid = _crID cr
|
||||
sp = head $ _btTrail' bt
|
||||
ep = sp +.+ _btVel' bt
|
||||
v = evalState (randInCirc 1) $ _randGen w
|
||||
incFlamelets = over worldEvents $ (.) (makeFlameletTimed p v Nothing 3 20)
|
||||
|
||||
{-
|
||||
Creates a shockwave when hitting a creature.
|
||||
-}
|
||||
{- |
|
||||
Creates a shockwave when hitting a creature. -}
|
||||
bulConCr' :: Particle -> Point2 -> Creature -> World -> World
|
||||
bulConCr' bt p cr w
|
||||
= over (creatures . ix cid . crState . crDamage)
|
||||
(\dams -> [Piercing 60 sp p ep
|
||||
] ++ dams
|
||||
)
|
||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
$ mkwave
|
||||
w
|
||||
( Piercing 60 sp p ep : )
|
||||
$ soundMultiFrom [CrHitSound 0] 15 10 0
|
||||
$ mkwave
|
||||
w
|
||||
where
|
||||
cid = _crID cr
|
||||
sp = head $ _btTrail' bt
|
||||
ep = sp +.+ _btVel' bt
|
||||
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
|
||||
|
||||
{-
|
||||
Hitting wall effects: create a spark, damage blocks.
|
||||
-}
|
||||
{- |
|
||||
Hitting wall effects: create a spark, damage blocks. -}
|
||||
bulHitWall' :: Particle -> Point2 -> Wall -> World -> World
|
||||
bulHitWall' bt p x w = damageBlocks x
|
||||
$ createSpark 8 colID pOut (reflectDir x) Nothing
|
||||
$ set randGen g
|
||||
w
|
||||
bulHitWall' bt p x w = damageBlocks x
|
||||
$ createSpark 8 colID pOut (reflectDir x) Nothing
|
||||
$ set randGen g
|
||||
w
|
||||
where
|
||||
sp = head $ _btTrail' bt
|
||||
pOut = p +.+ safeNormalizeV (sp -.- p)
|
||||
(colID,g) = randomR (0,11) $ _randGen w
|
||||
(a, _) = randomR (-0.1,0.1) $ _randGen w
|
||||
spid = newKey $ _projectiles w
|
||||
reflectDir wall = a + (argV $ reflectIn
|
||||
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
||||
(p -.- sp)
|
||||
)
|
||||
damageBlocks wall w
|
||||
= case wall ^? blHP of
|
||||
reflectDir wall = a +
|
||||
argV (reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (p -.- sp) )
|
||||
damageBlocks wall w = case wall ^? blHP of
|
||||
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
||||
_ -> w
|
||||
|
||||
{-
|
||||
{- |
|
||||
Bounce off walls, do damage to blocks.
|
||||
-}
|
||||
bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World
|
||||
@@ -183,16 +173,21 @@ bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w
|
||||
bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel
|
||||
(_btHitEffect' bt) (_btWidth' bt)
|
||||
) {_btTimer' = _btTimer' bt - 1}
|
||||
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
|
||||
wallV = _wlLine wl !! 1 -.- _wlLine wl !! 0
|
||||
reflectVel = (reflectIn wallV (_btVel' bt))
|
||||
addBouncer = (.) ( over particles (bouncer : ) )
|
||||
-- the hack is to get around the fact that the particles list gets reset after
|
||||
-- all projectiles in it are checked, so we cannot add to it as we accumulate over
|
||||
-- this list
|
||||
|
||||
{- Create flamelet on wall.
|
||||
{- | Create flamelet on wall.
|
||||
-}
|
||||
bulIncWall' :: Particle -> Point2 -> Wall -> World -> World
|
||||
bulIncWall'
|
||||
:: Particle
|
||||
-> Point2 -- Impact point
|
||||
-> Wall
|
||||
-> World
|
||||
-> World
|
||||
bulIncWall' bt p wl w = damageBlocks wl $ incFlamelets w
|
||||
where
|
||||
sp = head $ _btTrail' bt
|
||||
@@ -201,12 +196,17 @@ bulIncWall' bt p wl w = damageBlocks wl $ incFlamelets w
|
||||
= case wall ^? blHP of
|
||||
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
||||
_ -> w
|
||||
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
|
||||
wallV = _wlLine wl !! 1 -.- _wlLine wl !! 0
|
||||
reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
|
||||
incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20)
|
||||
|
||||
{- Create a shockwave on wall-}
|
||||
bulConWall' :: Particle -> Point2 -> Wall -> World -> World
|
||||
{- | Create a shockwave on wall-}
|
||||
bulConWall'
|
||||
:: Particle
|
||||
-> Point2 -- Impact point
|
||||
-> Wall
|
||||
-> World
|
||||
-> World
|
||||
bulConWall' bt p wl w = damageBlocks wl $ mkwave w
|
||||
where
|
||||
sp = head $ _btTrail' bt
|
||||
@@ -215,25 +215,27 @@ bulConWall' bt p wl w = damageBlocks wl $ mkwave w
|
||||
= case wall ^? blHP of
|
||||
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
|
||||
_ -> w
|
||||
wallV = (_wlLine wl !! 1 -.- _wlLine wl !! 0)
|
||||
wallV = _wlLine wl !! 1 -.- _wlLine wl !! 0
|
||||
mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
|
||||
|
||||
hvBulHitWall' :: Particle -> Point2 -> Wall -> World -> World
|
||||
hvBulHitWall'
|
||||
:: Particle
|
||||
-> Point2 -- Impact point
|
||||
-> Wall
|
||||
-> World
|
||||
-> World
|
||||
hvBulHitWall' bt p x w = damageBlocks x $ set randGen g $ foldr ($) w (sparks pOut sv)
|
||||
where
|
||||
sp = head $ _btTrail' bt
|
||||
pOut = p +.+ safeNormalizeV (sp -.- p)
|
||||
(a, g) = randomR (-0.1,0.1) $ _randGen w
|
||||
spid = newKey $ _projectiles w
|
||||
reflectDir wall = a + (argV $ reflectIn
|
||||
(_wlLine wall !! 1 -.- _wlLine wall !! 0)
|
||||
(p -.- sp)
|
||||
)
|
||||
reflectDir wall = a +
|
||||
argV (reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0) (p -.- sp) )
|
||||
sv = unitVectorAtAngle $ reflectDir x
|
||||
damageBlocks wall w
|
||||
= case wall ^? blHP of
|
||||
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall)
|
||||
_ -> w
|
||||
damageBlocks wall w = case wall ^? blHP of
|
||||
Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 20)) w (_blIDs wall)
|
||||
_ -> w
|
||||
cs = take 10 $ randomRs (0,11) $ _randGen w
|
||||
ds = randomRs (-0.7,0.7) $ _randGen w
|
||||
ts = randomRs (4,8) $ _randGen w
|
||||
@@ -242,15 +244,20 @@ hvBulHitWall' bt p x w = damageBlocks x $ set randGen g $ foldr ($) w (sparks p
|
||||
bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World
|
||||
bulHitFF' _ _ _ = id
|
||||
|
||||
bulletEffect' :: HitEffect
|
||||
bulletEffect' = destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
|
||||
{-
|
||||
Typical effect: destroy on impact, damage creatures and blocks, create spark on walls.
|
||||
-}
|
||||
basicBulletEffect :: HitEffect
|
||||
basicBulletEffect = destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
|
||||
|
||||
bulletParticleSideEffect :: Particle -> HitEffect
|
||||
bulletParticleSideEffect pt = destroyOnImpact mkPt mkPt noEff
|
||||
where
|
||||
mkPt _ p _ = over particles ((pt {_btTrail' = [p]}) :)
|
||||
|
||||
aGenBulAt' :: Maybe Int -> Color -> Point2 -> Point2 -> HitEffect -> Float -> Particle
|
||||
aGenBulAt'
|
||||
:: Maybe Int -- ^ Pass-through creature id
|
||||
-> Color
|
||||
-> Point2 -- ^ Start position
|
||||
-> Point2 -- ^ Velocity
|
||||
-> HitEffect
|
||||
-> Float -- ^ Bullet width
|
||||
-> Particle
|
||||
aGenBulAt' maycid col pos vel hiteff width = Bul'
|
||||
{ _ptDraw = drawBul
|
||||
, _ptUpdate' = mvGenBullet'
|
||||
@@ -263,7 +270,15 @@ aGenBulAt' maycid col pos vel hiteff width = Bul'
|
||||
, _btHitEffect' = hiteff
|
||||
}
|
||||
|
||||
aCurveBulAt :: Maybe Int -> Color -> Point2 -> Point2 -> Point2 -> HitEffect -> Float -> Particle
|
||||
aCurveBulAt
|
||||
:: Maybe Int -- ^ Pass-through creature id
|
||||
-> Color
|
||||
-> Point2 -- ^ Start position
|
||||
-> Point2 -- ^ Control position
|
||||
-> Point2 -- ^ Target position
|
||||
-> HitEffect
|
||||
-> Float -- ^ Bullet width
|
||||
-> Particle
|
||||
aCurveBulAt maycid col pos control targ hiteff width = Bul'
|
||||
{ _ptDraw = drawBul
|
||||
, _ptUpdate' = \w -> mvGenBullet' w . setVel
|
||||
|
||||
Reference in New Issue
Block a user