Refactor

2021-05-04 18:11:59 +02:00
parent 6d4c17fc07
commit f0e5095b5f
28 changed files with 477 additions and 584 deletions
@@ -30,5 +30,5 @@ heal25 = heal 25
 heal :: Int -> Int -> World -> Maybe World
 heal hp n w | _crHP (_creatures w IM.! n) >= 10000 = Nothing
            | otherwise = Just $ soundOnce healSound 
-                               $ over (creatures . ix n . crHP) ((\x-> min x 10000). (+ hp) ) w
+                               $ over (creatures . ix n . crHP) ((min 10000) . (+ hp) ) w

@@ -136,8 +136,7 @@ autoGun = defaultGun
 autoFireMode = shootWithSound (fromIntegral autoGunSound) 
    . torqueBefore 0.05
    $ autoGunNonTwistEff
-singleFireMode = hammerCheck $ shootWithSound (fromIntegral autoGunSound) 
-    $ autoGunNonTwistEff
+singleFireMode = hammerCheck $ shootWithSound (fromIntegral autoGunSound) autoGunNonTwistEff
 autoGunNonTwistEff = withRecoil 40
    . withRandomDir (autogunSpread/2)
    . withMuzFlare
@@ -612,12 +611,12 @@ aTeslaArc cid w = aTeslaArc' cid
                $ soundFrom (CrWeaponSound cid) 25 1 0 w

 aTeslaArc' :: Int -> World -> World
-aTeslaArc' cid w = 
-                teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
-                $ over projectiles (IM.insert i (makeTeslaArcAt i pos dir)) 
-                $ set randGen g w
+aTeslaArc' cid w 
+    = teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
+    $ over projectiles (IM.insert i (makeTeslaArcAt i pos dir)) 
+    $ set randGen g w
  where 
-    cr  = (_creatures w IM.! cid)
+    cr  = _creatures w IM.! cid
    i = newProjectileKey w
    pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) 
                    +.+ sideOffset *.* vNormal (unitVectorAtAngle dir)
@@ -1019,13 +1018,18 @@ moveRemoteShell time i cid itid dir w
                          . _Just . scopePos .~ (newPos -.- _crPos (_creatures w' IM.! cid))
              _   -> w'

-explodeRemoteRocket :: Int -> Int -> Int -> World -> World
+explodeRemoteRocket 
+    :: Int  -- ^ Item id
+    -> Int  -- ^ Projectile id
+    -> Int 
+    -> World 
+    -> World
 explodeRemoteRocket itid pjid n w
    = set (projectiles . ix pjid . pjUpdate) (retireRemoteRocket itid 30 pjid)
-        $ set (projectiles . ix pjid . pjPict) blank
-        $ set (itPoint . wpFire) (flip const)
-        $ resetName
-        $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
+    $ set (projectiles . ix pjid . pjPict) blank
+    $ set (itPoint . wpFire) (const id)
+    $ resetName
+    $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
  where 
    resetName = set (itPoint . itName) "REMOTELAUNCHER"
    itPoint = pointToItem $ _itemPositions w IM.! itid
@@ -1073,7 +1077,7 @@ explodeRemoteBomb :: Int -> Int -> Int -> World -> World
 explodeRemoteBomb itid pjid n w
    = set (projectiles . ix pjid . pjUpdate) (retireRemoteBomb itid 30 pjid)
        $ set (projectiles . ix pjid . pjPict) blank
-        $ set (creatures . ix n . crInv . ix j . twFire) (flip const)
+        $ set (creatures . ix n . crInv . ix j . twFire) (const id)
        $ resetName
        $ resetPict
 --        $ resetScope
@@ -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'

@@ -1,3 +1,4 @@
+{- | Laser effects -}
 module Dodge.Item.Weapon.Laser
    where
 import Dodge.Data
@@ -15,6 +16,7 @@ import Picture

 import Control.Lens
 import System.Random
+import Data.Tuple
 import Data.List (find)
 import Data.Maybe (fromMaybe)
 import qualified Data.Sequence as Seq
@@ -38,7 +40,6 @@ charToPhaseV 'V'    = 0.2
 charToPhaseV '/'   = 1
 charToPhaseV 'Z'    = 5

-
 makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle
 makeLaserAt phaseV pos dir mcid = Particle
    { _ptDraw = const blank
@@ -55,13 +56,12 @@ moveLaser
    -> (World, Maybe Particle)
 moveLaser phaseV pos dir mcid w pt
    = ( set randGen g $ hitEffect w
-      , Just pt {_ptDraw = const $ onLayer PtLayer $ pic ,_ptUpdate' = ptTimer' 0 }
+      , Just pt {_ptDraw = const $ onLayer PtLayer pic ,_ptUpdate' = ptTimer' 0 }
      )
  where 
    xp = pos +.+ 800 *.* unitVectorAtAngle dir
    (a,g)  = randomR (-0.7,0.7) $ _randGen w
-    reflectDir wall = a + 
-        (argV $ reflectIn ((fst $ _wlLine wall) -.- (snd $ _wlLine wall)) (xp -.- pos) )
+    reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (xp -.- pos))
    (colID,_) = randomR (0,11) $ _randGen w
    f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either3 Creature Wall ForceField),[Point2])
    f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of
@@ -76,20 +76,23 @@ moveLaser phaseV pos dir mcid w pt
    h x y wl p | isEntering = p +.+ rotateV angleRef normalDist
               | otherwise = p +.+ rotateV angleRef' normalDist'
      where 
-        wlNormal = vNormal $ (snd $ _wlLine wl) -.- (fst $ _wlLine wl)
+        wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl)
        normalDist = magV (p -.- y) *.* normalizeV wlNormal
        angleInc = piRange $ argV wlNormal - argV (x -.- y)
-        angleRef | reflectExternal = angleInc
-                 | otherwise = asin $ sin angleInc / phaseV
-        piRange a | a > pi = a - 2 * pi
-                  | a > negate pi = a
-                  | otherwise  = a + 2 * pi
-        isEntering = isLeftOf (x -.- y) ((snd $ _wlLine wl) -.- (fst $ _wlLine wl))
+        angleRef 
+            | reflectExternal = angleInc
+            | otherwise = asin $ sin angleInc / phaseV
+        piRange a 
+            | a > pi = a - 2 * pi
+            | a > negate pi = a
+            | otherwise  = a + 2 * pi
+        isEntering = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl))
        wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl)
        normalDist' = magV (p -.- y) *.* normalizeV wlNormal'
        angleInc' = piRange $ argV wlNormal' - argV (x -.- y)
-        angleRef' | reflectInternal = angleInc'
-                  | otherwise = asin $ phaseV * sin angleInc'
+        angleRef' 
+            | reflectInternal = angleInc'
+            | otherwise = asin $ phaseV * sin angleInc'
        reflectInternal = 1 < abs (phaseV * sin angleInc')
        reflectExternal = 1 < abs (sin angleInc / phaseV)
            
@@ -104,10 +107,11 @@ moveLaser phaseV pos dir mcid w pt
          Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (pos -.- p))
                                                      (reflectDir wl) Nothing
          _   -> id
-    pic = pictures [ fadeLine pos (head ps) 0.2 40 yellow
-                   , setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps)
-                   , setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps)
-                   ]
+    pic = pictures 
+        [ fadeLine pos (head ps) 0.2 40 yellow
+        , setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps)
+        , setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps)
+        ]

 fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture
 fadeLine sp ep alph width col = setLayer 1 $ polygonCol 
@@ -351,10 +351,8 @@ torqueAfter torque feff cid w
    (rot, g) = randomR (-torque,torque) $ _randGen w
    rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
                          . itAttachment . _Just . scopePos %~ rotateV rot 
-{- |
-Create multiple bullets with a given spread, a given amount, given velocity,
-given width and given 'HitEffect'.
- -}
+{- | Create multiple bullets with a given spread, a given amount, given velocity,
+given width and given 'HitEffect'.  -}
 spreadNumVelWthHiteff 
    :: Float    -- ^ Spread
    -> Int      -- ^ Number of bullets
@@ -371,15 +369,13 @@ spreadNumVelWthHiteff spread num vel wth eff cid w = over particles (newbuls ++)
        (\pos d colid -> aGenBulAt' (Just cid) (numColor colid) pos (rotateV d vel) eff wth) 
        poss dirs colids
    poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
-              $ (replicateM num . randInCirc) 5 & evalState $ _randGen w
-    dirs = map ((+) (_crDir cr)) 
-              $ zipWith (+) [-spread,-spread+(2*spread/fromIntegral num)..]
-                            $ randomRs (0,spread/5) (_randGen w)
+        $ (replicateM num . randInCirc) 5 & evalState $ _randGen w
+    dirs = map ((_crDir cr) +) $ zipWith (+) 
+        [-spread,-spread+(2*spread/fromIntegral num)..]
+        (randomRs (0,spread/5) (_randGen w))
    colids = take num $ randomRs (0,11) (_randGen w)
-{- | 
-Create a number of bullets side by side with a given velocity,
-given width and given 'HitEffect'.
- -}
+{- | Create a number of bullets side by side with a given velocity,
+given width and given 'HitEffect'.  -}
 numVelWthHitEff 
    :: Int      -- ^ Amount of bullets
    -> Point2   -- ^ Velocity, x axis is direction of creature
@@ -90,18 +90,17 @@ mvRadar
    -> Point2   -- ^ Center of expanding circle
    -> World -> Particle -> (World, Maybe Particle)
 mvRadar 0 _ w _  = (w, Nothing)
-mvRadar x p w pt = (putBlips w, Just $ pt {_ptDraw = const pic
-                              ,_ptUpdate' = mvRadar (x-1) p
-                              }
-                   )
+mvRadar x p w pt = 
+    ( putBlips w
+    , Just $ pt {_ptDraw = const pic ,_ptUpdate' = mvRadar (x-1) p }
+    )
  where 
-    pic = onLayerL [levLayer ShadowLayer, 1] $ pictures $ sweepPics
-    putBlips = over worldEvents ((.) $ over particles ((++) blips))
-    blips = map (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50) 
-                $ circPoints
-    circPoints = mapMaybe (\wl -> collidePointCircCorrect (fst $ _wlLine wl) (snd $ _wlLine wl) r p)
-                  $ (map (over wlLine swp) $ IM.elems $ wallsAlongCirc p r w)
-                      ++ (IM.elems $ wallsAlongCirc p r w)
+    pic = onLayerL [levLayer ShadowLayer, 1] $ pictures sweepPics
+    putBlips = over worldEvents ( ( over particles (blips ++) ) . )
+    blips = map (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50) circPoints
+    circPoints = mapMaybe (\wl -> uncurry collidePointCircCorrect (_wlLine wl) r p)
+        $ map (over wlLine swp) (IM.elems $ wallsAlongCirc p r w)
+                      ++ IM.elems (wallsAlongCirc p r w)
    swp (a,b) = (b,a)
    r = fromIntegral (800 - x*16)
    sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15
@@ -117,14 +116,14 @@ aTractorBeam
    -> Int      -- ^ Creature id
    -> World 
    -> World
-aTractorBeam col cid w
-        = set (creatures . ix cid . crInv . ix itRef . wpFire)
-                        (shoot $ aTractorBeam ((col + 1) `mod` 10))
-                      $ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w
+aTractorBeam col cid w 
+    = set (creatures . ix cid . crInv . ix itRef . wpFire)
+        (shoot $ aTractorBeam ((col + 1) `mod` 10))
+    $ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w
  where 
    i = newProjectileKey w
-    cr  = (_creatures w IM.! cid)
-    pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir)
+    cr  = _creatures w IM.! cid
+    pos = _crPos cr +.+ ((_crRad cr + 10) *.* unitVectorAtAngle dir)
    dir = _crDir cr
    itRef = _crInvSel cr