Refactor

2021-05-04 18:11:59 +02:00
parent 6d4c17fc07
commit f0e5095b5f
28 changed files with 477 additions and 584 deletions
@@ -17,7 +17,6 @@ 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 
@@ -38,10 +37,7 @@ bulHitCr' bt p cr w
    (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.
- -}
+{- | Bounce off armoured creatures, otherwise do damage.  -}
 bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World
 bulBounceArmCr' bt p cr w 
    | crIsArmouredFrom p cr
@@ -65,10 +61,7 @@ bulBounceArmCr' bt p cr w
    bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel 
                                      (_btHitEffect' bt) (_btWidth' bt)
              ) {_btTimer' = _btTimer' bt - 1}
-
-{- |
-Bullet pass through creatures.
- -}
+{- | Bullet pass through creatures.  -}
 bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
 bulPenCr' bt p cr w 
    = over (creatures . ix cid . crState . crDamage)
@@ -91,8 +84,7 @@ bulPenCr' bt p cr w
    piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt) 
                                      (_btHitEffect' bt) (_btWidth' bt)
              ) {_btTimer' = _btTimer' bt - 1}
-{- | 
-Heavy bullet effects when hitting creature:
+{- | 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 
@@ -111,8 +103,7 @@ hvBulHitCr' bt p cr w
    cid = _crID cr
    sp = head $ _btTrail' bt
    ep = sp +.+ _btVel' bt
-{- |
-Create a flamelet when hitting a creature.  -}
+{- | Create a flamelet when hitting a creature.  -}
 bulIncCr' :: Particle -> Point2 -> Creature -> World -> World
 bulIncCr' bt p cr w 
    = over (creatures . ix cid . crState . crDamage)
@@ -126,8 +117,7 @@ bulIncCr' bt p cr w
    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)
@@ -140,8 +130,7 @@ bulConCr' bt p cr w
    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
@@ -153,14 +142,11 @@ bulHitWall' bt p x w = damageBlocks x
    (colID,g) = randomR (0,11) $ _randGen w
    (a, _) = randomR (-0.1,0.1) $ _randGen w
    spid = newKey $ _projectiles w
-    reflectDir wall = a + 
-        argV (reflectIn ((snd $ _wlLine wall) -.- (fst $ _wlLine wall)) (p -.- sp) )
+    reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
    damageBlocks wall w = case wall ^? blHP of 
-          Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
+          Just hp -> foldr (\j -> (walls . ix j . blHP -~ 5)) w (_blIDs wall)
          _ -> w
-{- |
-Bounce off walls, do damage to blocks.
- -}
+{- | Bounce off walls, do damage to blocks.  -}
 bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World
 bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w
  where 
@@ -168,20 +154,19 @@ bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w
    pOut = p +.+ safeNormalizeV (sp -.- p)
    damageBlocks wall w
      = case wall ^? blHP of 
-          Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
+          Just hp -> foldr (\j -> (walls . ix j . blHP -~ 5)) w (_blIDs wall)
          _ -> w
    bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel 
                                      (_btHitEffect' bt) (_btWidth' bt)
              ) {_btTimer' = _btTimer' bt - 1}
-    wallV = (snd $ _wlLine wl) -.- (fst $ _wlLine wl)
-    reflectVel = (reflectIn wallV (_btVel' bt))
-    addBouncer = (.) ( over particles (bouncer : ) )
+    wallV = uncurry (-.-) (_wlLine wl)
+    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   -- Impact point
@@ -194,16 +179,15 @@ bulIncWall' bt p wl w =  damageBlocks wl $ incFlamelets w
    pOut = p +.+ safeNormalizeV (sp -.- p)
    damageBlocks wall w
      = case wall ^? blHP of 
-          Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
+          Just hp -> foldr (\j -> (walls . ix j . blHP -~ 5)) w (_blIDs wall)
          _ -> w
-    wallV = (snd $ _wlLine wl) -.- (fst $ _wlLine wl)
+    wallV = uncurry (-.-) (_wlLine wl)
    reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
    incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20)
-
 {- | Create a shockwave on wall-}
 bulConWall'
    :: Particle 
-    -> Point2   -- Impact point
+    -> Point2   -- ^ Impact point
    -> Wall 
    -> World 
    -> World
@@ -213,14 +197,13 @@ bulConWall' bt p wl w =  damageBlocks wl $ mkwave w
    pOut = p +.+ safeNormalizeV (sp -.- p)
    damageBlocks wall w
      = case wall ^? blHP of 
-          Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
+          Just hp -> foldr (\j -> (walls . ix j . blHP -~ 5)) w (_blIDs wall)
          _ -> w
-    wallV = (snd $ _wlLine wl) -.- (fst $ _wlLine wl)
-    mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
+    mkwave = over worldEvents ((makeShockwaveAt [] p 15 4 1 white) . ) 

 hvBulHitWall' 
    :: Particle 
-    -> Point2   -- Impact point
+    -> Point2   -- ^ Impact point
    -> Wall 
    -> World 
    -> World
@@ -231,10 +214,10 @@ hvBulHitWall' bt p x w =  damageBlocks x $ set randGen g $ foldr ($) w (sparks p
    (a, g) = randomR (-0.1,0.1) $ _randGen w
    spid = newKey $ _projectiles w
    reflectDir wall = a + 
-        argV (reflectIn ((snd $ _wlLine wall) -.- (fst $ _wlLine wall)) (p -.- sp) )
+        argV (reflectIn (uncurry (-.-) (_wlLine wall)) (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)
+        Just hp -> foldr (\j -> (walls . ix j . blHP -~ 20)) w (_blIDs wall)
        _ -> w
    cs      = take 10 $ randomRs (0,11) $ _randGen w
    ds      = randomRs (-0.7,0.7) $ _randGen w
@@ -243,10 +226,7 @@ hvBulHitWall' bt p x w =  damageBlocks x $ set randGen g $ foldr ($) w (sparks p

 bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World
 bulHitFF' _ _ _ = id
-
-{-
-Typical effect: destroy on impact, damage creatures and blocks, create spark on walls.
- -}
+{- | Typical effect: destroy on impact, damage creatures and blocks, create spark on walls.  -}
 basicBulletEffect :: HitEffect
 basicBulletEffect = destroyOnImpact bulHitCr' bulHitWall' bulHitFF'