Cleanup

2021-12-15 22:21:58 +00:00
parent 9dadea2c36
commit 9ead5b3979
11 changed files with 130 additions and 174 deletions
@@ -5,6 +5,7 @@ import Dodge.Data
 import Picture

 drawBul :: Particle -> Picture
-drawBul pt = setLayer 1 . setDepth 20 . color thecolor $ thickLine (take 3 $ _btTrail' pt) (_btWidth' pt)
-  where
-    thecolor = _btColor' pt
+drawBul pt = setLayer 1 
+    . setDepth 20 
+    . color (_ptColor pt) 
+    $ thickLine (take 3 $ _ptTrail pt) (_btWidth' pt)
@@ -1,8 +1,5 @@
-{- |
-Effects of bullets upon impact with walls or creatures.
- -}
-module Dodge.Particle.Bullet.HitEffect
-    where
+{- | Effects of bullets upon impact with walls or creatures.  -}
+module Dodge.Particle.Bullet.HitEffect where
 import Dodge.Data
 import Dodge.Particle.Spark
 import Dodge.Wall.Damage
@@ -14,27 +11,25 @@ import Dodge.WorldEvent.Shockwave
 import Dodge.Creature.Property
 import Dodge.Wall.Reflect
 import Geometry
--import Geometry.Vector3D
 import Picture
+import LensHelp

 import System.Random
-import Control.Lens
 import Control.Monad.State
 -- | Basic bullet hit creature effect.
 bulHitCr :: Particle -> Point2 -> Creature -> World -> World
 bulHitCr bt p cr w 
    | crIsArmouredFrom p cr
-        = colSpark 8 colID p1 (argV (p1 -.- p)) $ addDamageArmoured w
+        = colSpark 8 (_ptColor bt) p1 (argV (p1 -.- p)) $ addDamageArmoured w
    | otherwise = addDamage . bulletHitSound p $ w
  where
-    sp = head $ _btTrail' bt
+    sp = head $ _ptTrail bt
    bulVel = _ptVel bt
    ep = sp +.+ bulVel
    mvDams = [ PushDam 1 $ 2 *.* bulVel ]
-    addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
-    addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
+    addDamage = creatures . ix cid . crState . crDamage .++~ (Piercing 100 sp p ep : mvDams)
+    addDamageArmoured = creatures . ix cid . crState . crDamage .++~ mvDams
    cid = _crID cr
-    colID = _btColor' bt
    p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)

 bulletHitSound :: Point2 -> World -> World
@@ -45,38 +40,35 @@ bulBounceArmCr' bt p cr w
    | crIsArmouredFrom p cr = addBouncer . addDamageArmoured $ w
    | otherwise = addDamage . bulletHitSound p $ w
  where
-    sp = head $ _btTrail' bt
+    sp = head $ _ptTrail bt
    bulVel = _ptVel bt
    ep = sp +.+ bulVel
    mvDams = [ PushDam 1 $ 2 *.* bulVel ]
-    addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
-    addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
+    addDamage = creatures . ix cid . crState . crDamage .++~ (Piercing 100 sp p ep : mvDams)
+    addDamageArmoured = creatures . ix cid . crState . crDamage .++~ mvDams
    cid = _crID cr
    newDir = squashNormalizeV (p -.- _crPos cr)
    pOut = p +.+ 2 *.* newDir
    reflectVel = magV bulVel *.* newDir
-    addBouncer = worldEvents %~ ( over particles (bouncer :) . )
+    addBouncer = instantParticles .:~ bouncer
    bouncer = (aGenBulAt Nothing pOut reflectVel (_btDrag bt)
                                      (_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)
-           ([Piercing 50 sp p ep
-            ,Blunt    50  sp p ep
-            ,TorqueDam 1 d1
-            ,PushDam 1 $ 3 *.* (ep -.- sp)
-            ] 
-            ++
-           )
-    $ bulletHitSound ep
-    $ over instantParticles (piercer :)
-    w
+bulPenCr' bt p cr w = w
+    & instantParticles .:~ piercer
+    & bulletHitSound ep
+    & creatures . ix cid . crState . crDamage .++~
+        [Piercing 50 sp p ep
+        ,Blunt    50  sp p ep
+        ,TorqueDam 1 d1
+        ,PushDam 1 $ 3 *.* (ep -.- sp)
+        ] 
  where 
    (d1,_)  = randomR (-0.7,0.7) $ _randGen w
    cid = _crID cr
-    sp = head $ _btTrail' bt
+    sp = head $ _ptTrail bt
    ep = sp +.+ _ptVel bt
    piercer = (aGenBulAt (Just cid) p (_ptVel bt) (_btDrag bt)
                                      (_btHitEffect' bt) (_btWidth' bt)
@@ -84,63 +76,56 @@ bulPenCr' bt p cr w
 {- | 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)
-            ] 
-            ++
-           )
-    $ bulletHitSound ep
-    w
+hvBulHitCr bt p cr w = w
+    & creatures . ix cid . crState . crDamage .++~
+        [Piercing 200 sp p ep
+        ,Blunt    100  sp p ep
+        ,TorqueDam 1 d1
+        ,PushDam 1 $ 3 *.* (ep -.- sp)
+        ] 
+    & bulletHitSound ep
  where 
    (d1,_)  = randomR (-0.7,0.7) $ _randGen w
    cid = _crID cr
-    sp = head $ _btTrail' bt
+    sp = head $ _ptTrail bt
    ep = sp +.+ _ptVel 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)
-           ( Piercing 60 sp p ep : )
-    $ bulletHitSound p
-    $ incFlamelets
-    w
+bulIncCr bt p cr w = w
+    & makeFlameletTimed p 20 v Nothing 3 20
+    & bulletHitSound p
+    & creatures . ix cid . crState . crDamage .:~ Piercing 60 sp p ep
  where   
    cid = _crID cr
-    sp = head $ _btTrail' bt
+    sp = head $ _ptTrail bt
    ep = sp +.+ _ptVel bt
    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
-    = over (creatures . ix cid . crState . crDamage) (Blunt 10 sp p ep :)
-    . over worldEvents (makeShockwaveAt [] p 15 4 1 white .)
+bulConCr bt p cr = over (creatures . ix cid . crState . crDamage) (Blunt 10 sp p ep :)
+    . makeShockwaveAt [] p 15 4 1 white
    . bulletHitSound p
  where   
    cid = _crID cr
-    sp = head $ _btTrail' bt
+    sp = head $ _ptTrail bt
    ep = sp +.+ _ptVel bt
 {- | Hitting wall effects: create a spark, damage blocks.  -}
 bulHitWall :: Particle -> Point2 -> Wall -> World -> World
 bulHitWall bt p = damageWall (Piercing 100 sp p ep)
  where 
    ep = sp +.+ _ptVel bt
-    sp = head $ _btTrail' bt
+    sp = head $ _ptTrail bt
 {- | Bounce off walls, do damage to blocks.  -}
 bulBounceWall :: Particle -> Point2 -> Wall -> World -> World
-bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl . over worldEvents addBouncer
+bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl 
+    . over instantParticles (bouncer :)
  where 
    ep = sp +.+ _ptVel bt
-    sp = head $ _btTrail' bt
+    sp = head $ _ptTrail bt
    pOut = p +.+ squashNormalizeV (sp -.- p)
-    bouncer = (aGenBulAt Nothing pOut reflectVel 0.5 (_btHitEffect' bt) (_btWidth' bt)
+    bouncer = (aGenBulAt Nothing pOut reflectVel (_btDrag bt) (_btHitEffect' bt) (_btWidth' bt)
              ) {_btTimer' = _btTimer' bt - 1}
    reflectVel = reflVelWall wl (_ptVel 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
@@ -152,14 +137,14 @@ bulIncWall
    -> Wall 
    -> World 
    -> World
-bulIncWall bt p wl =  damageWall (Blunt 50 sp p ep) wl . incFlamelets
+bulIncWall bt p wl = damageWall (Blunt 50 sp p ep) wl 
+    . makeFlameletTimed pOut 20 reflectVel Nothing 3 20
  where   
    ep = sp +.+ _ptVel bt
-    sp = head $ _btTrail' bt
+    sp = head $ _ptTrail bt
    pOut = p +.+ squashNormalizeV (sp -.- p)
    wallV = uncurry (-.-) (_wlLine wl)
    reflectVel = squashNormalizeV $ reflectIn wallV (_ptVel bt)
-    incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut 20 reflectVel Nothing 3 20)
 {- | Create a shockwave on wall-}
 bulConWall
    :: Particle 
@@ -168,12 +153,12 @@ bulConWall
    -> World 
    -> World
 bulConWall bt p wl = damageWall (Blunt 10 sp p ep) wl .
-    over worldEvents ( makeShockwaveAt [] p 15 4 1 white . ) 
+    makeShockwaveAt [] p 15 4 1 white
  where   
    ep = sp +.+ _ptVel bt
-    sp = head $ _btTrail' bt
+    sp = head $ _ptTrail bt

-hvBulHitWall 
+hvBulHitWall
    :: Particle 
    -> Point2   -- ^ Impact point
    -> Wall 
@@ -184,7 +169,7 @@ hvBulHitWall bt p wl w = damageWall (Piercing 200 sp p ep) wl
    $ set randGen g $ foldr ($) w (sparks pOut sv)
  where 
    ep = sp +.+ _ptVel bt
-    sp = head $ _btTrail' bt
+    sp = head $ _ptTrail bt
    pOut = p +.+ squashNormalizeV (sp -.- p)
    (a, g) = randomR (-0.2,0.2) $ _randGen w
    sv = unitVectorAtAngle $ a + reflDirWall sp p wl
@@ -25,8 +25,8 @@ aGenBulAt maycid pos vel drag hiteff width = BulletPt
    , _ptUpdate = mvBullet
    , _ptVel    = vel
    , _btDrag   = drag
-    , _btColor' = V4 2 2 2 2
-    , _btTrail' = [pos]
+    , _ptColor = V4 2 2 2 2
+    , _ptTrail = [pos]
    , _btPassThrough' = maycid
    , _btWidth' = width
    , _btTimer' = 100
@@ -46,8 +46,8 @@ aDelayedBulAt vfact maycid pos vel drag hiteff width = BulletPt
    , _ptUpdate = \w -> resetVel . mvBullet w
    , _ptVel  = vfact *.* vel
    , _btDrag = drag
-    , _btColor' = V4 2 2 2 2
-    , _btTrail' = [pos]
+    , _ptColor = V4 2 2 2 2
+    , _ptTrail = [pos]
    , _btPassThrough' = maycid
    , _btWidth' = width
    , _btTimer' = 100
@@ -70,8 +70,8 @@ aCurveBulAt maycid col pos control targ hiteff width = BulletPt
    , _ptUpdate = \w -> mvBullet w . setVel
    , _ptVel  = V2 0 0
    , _btDrag = 1
-    , _btColor' = col
-    , _btTrail' = [pos]
+    , _ptColor = col
+    , _ptTrail = [pos]
    , _btPassThrough' = maycid
    , _btWidth' = width
    , _btTimer' = 100
@@ -23,7 +23,7 @@ mvBullet w bt'
    dodrag = ptVel %~ (drag *.*)
    drag = _btDrag bt
    mcr     = _btPassThrough' bt
-    (p:_)  = _btTrail' bt
+    (p:_)   = _ptTrail bt
    vel     = _ptVel bt
    hiteff  = _btHitEffect' bt
    t       = _btTimer' bt
@@ -21,8 +21,8 @@ createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt
    , _ptUpdate = mvBullet
    , _ptVel = rotateV dir (V2 5 0)
    , _btDrag = 0.9
-    , _btColor' = numColor colid
-    , _btTrail' = [pos]
+    , _ptColor = numColor colid
+    , _ptTrail = [pos]
    , _btPassThrough' = maycid
    , _btWidth' = 1
    , _btTimer' = time
@@ -31,7 +31,7 @@ createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt
  where 
    sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ SparkDam 1 sp p ep
      where
-        sp = head (_btTrail' bt)
+        sp = head (_ptTrail bt)
        ep = sp +.+ _ptVel bt
 colSpark :: Int -> Color -> Point2 -> Float -> World -> World
 colSpark = colSparkRandDir 0.7
@@ -47,14 +47,14 @@ colSparkRandDir randDir time col pos baseDir w = w
        , _ptUpdate = mvBullet
        , _btDrag   = 0.9
        , _ptVel = rotateV dir (V2 5 0)
-        , _btColor' = col
-        , _btTrail' = [pos]
+        , _ptColor = col
+        , _ptTrail = [pos]
        , _btPassThrough' = Nothing
        , _btWidth' = 1
        , _btTimer' = time
        , _btHitEffect' = destroyOnImpact sparkEff noEff
        }
-    sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : )
+    sparkEff bt p cr = creatures . ix (_crID cr) . crState . crDamage .:~ SparkDam 1 sp p ep
      where 
-        sp = head (_btTrail' bt)
+        sp = head (_ptTrail bt)
        ep = sp +.+ _ptVel bt