diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 37444bfa4..8fb22cf67 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -15,6 +15,7 @@ import Dodge.RandomHelp import Dodge.WorldEvent.Shockwave import Dodge.Creature.State.Data import Dodge.Creature.Property +import Dodge.Wall.Reflect import Geometry --import Geometry.Vector3D import Picture @@ -118,18 +119,17 @@ bulIncCr' bt p cr w v = evalState (randInCirc 1) $ _randGen w incFlamelets = over worldEvents $ (.) (makeFlameletTimed p 20 v Nothing 3 20) {- | Creates a shockwave when hitting a creature. -} -bulConCr' :: Particle -> Point2 -> Creature -> World -> World -bulConCr' bt p cr w +bulConCr :: Particle -> Point2 -> Creature -> World -> World +bulConCr bt p cr w = over (creatures . ix cid . crState . crDamage) - ( Piercing 60 sp p ep : ) + ( Blunt 10 sp p ep : ) $ bulletHitSound p - $ mkwave + $ (worldEvents %~ (makeShockwaveAt [] p 15 4 1 white . )) 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. -} bulHitWall :: Particle -> Point2 -> Wall -> World -> World bulHitWall bt p = damageWall (Piercing 100 sp p ep) @@ -145,8 +145,7 @@ bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl . over worldEvents addB pOut = p +.+ safeNormalizeV (sp -.- p) bouncer = (aGenBulAt Nothing pOut reflectVel (_btHitEffect' bt) (_btWidth' bt) ) {_btTimer' = _btTimer' bt - 1} - wallV = uncurry (-.-) (_wlLine wl) - reflectVel = reflectIn wallV (_btVel' bt) + reflectVel = reflVelWall wl (_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 @@ -168,14 +167,17 @@ bulIncWall bt p wl = damageWall (Blunt 50 sp p ep) wl . incFlamelets reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt) incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut 20 reflectVel Nothing 3 20) {- | Create a shockwave on wall-} -bulConWall' +bulConWall :: Particle -> Point2 -- ^ Impact point -> Wall -> World -> World -bulConWall' _ p wl = damageBlocksBy 1 wl . +bulConWall bt p wl = damageWall (Blunt 10 sp p ep) wl . over worldEvents ( makeShockwaveAt [] p 15 4 1 white . ) + where + ep = sp +.+ _btVel' bt + sp = head $ _btTrail' bt hvBulHitWall :: Particle @@ -183,14 +185,15 @@ hvBulHitWall -> Wall -> World -> World -hvBulHitWall bt p x w = damageBlocksBy 5 x $ set randGen g $ foldr ($) w (sparks pOut sv) +hvBulHitWall bt p wl w = damageWall (Piercing 200 sp p ep) wl + . damageWall (Blunt 100 sp p ep) wl + $ set randGen g $ foldr ($) w (sparks pOut sv) where + ep = sp +.+ _btVel' bt sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) (a, g) = randomR (-0.2,0.2) $ _randGen w - reflectDir wall = a + - argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) ) - sv = unitVectorAtAngle $ reflectDir x + sv = unitVectorAtAngle $ a + reflDirWall sp p wl cs' = take 10 $ randomRs (0,11) $ _randGen w cs = map (brightX 100 1.5 . numColor) cs' ts = randomRs (4,8) $ _randGen w diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index 42e37bb3b..df5658ad6 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -9,6 +9,7 @@ import Dodge.Data import Dodge.Data.DamageType import Dodge.WorldEvent.SpawnParticle import Dodge.WorldEvent.Cloud +import Dodge.Wall.Reflect import Geometry import Geometry.Vector3D import Color @@ -41,8 +42,6 @@ wallEff dt wl = case dt of 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 diff --git a/src/Dodge/Wall/Reflect.hs b/src/Dodge/Wall/Reflect.hs new file mode 100644 index 000000000..f73375af8 --- /dev/null +++ b/src/Dodge/Wall/Reflect.hs @@ -0,0 +1,11 @@ +module Dodge.Wall.Reflect + where +import Geometry +import Dodge.Data + +reflDirWall :: Point2 -> Point2 -> Wall -> Float +reflDirWall sp ep wl = argV (reflectIn (uncurry (-.-) (_wlLine wl)) (ep -.- sp)) + +-- point free nonsense +reflVelWall :: Wall -> Point2 -> Point2 +reflVelWall = reflectIn . uncurry (-.-) . _wlLine