From 3efdb9e4f8551ff279d3afaec931d70b08f8e1bb Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Sun, 31 Oct 2021 16:51:54 +0000
Subject: [PATCH] Cleanup

---
 src/Dodge/LevelGen/Pathing.hs          | 12 +++--
 src/Dodge/LevelGen/StaticWalls.hs      | 75 +++-----------------------
 src/Dodge/LevelGen/Switch.hs           |  5 +-
 src/Dodge/LightSources/Lamp.hs         |  5 --
 src/Dodge/Particle/Bullet/HitEffect.hs | 18 +++----
 5 files changed, 28 insertions(+), 87 deletions(-)

diff --git a/src/Dodge/LevelGen/Pathing.hs b/src/Dodge/LevelGen/Pathing.hs
index 7517118ea..15e772493 100644
--- a/src/Dodge/LevelGen/Pathing.hs
+++ b/src/Dodge/LevelGen/Pathing.hs
@@ -1,4 +1,7 @@
 module Dodge.LevelGen.Pathing
+    ( removePathsCrossing
+    , pairsToGraph
+    )
     where
 import Dodge.Data
 import Dodge.Base
@@ -19,10 +22,11 @@ pairsToGraph f pairs =
     in undir $ run_ Data.Graph.Inductive.empty $ insMapNodesM nodes' >> insMapEdgesM pairs'
 
 removePathsCrossing :: Point2 -> Point2 -> World -> World
-removePathsCrossing a b w = set pathGraph newGraph $ set pathGraphP pg'
-    $ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
-    w
+removePathsCrossing a b w = w
+    & pathGraph  .~ newGraph 
+    & pathGraphP .~ pg'
+    & pathPoints .~ (foldr insertPoint IM.empty (labNodes newGraph))
   where 
     pg' = filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraphP w
-    insertPoint  pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
+    insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
     newGraph = pairsToGraph dist pg'
diff --git a/src/Dodge/LevelGen/StaticWalls.hs b/src/Dodge/LevelGen/StaticWalls.hs
index 3cdbabf21..d25b8b255 100644
--- a/src/Dodge/LevelGen/StaticWalls.hs
+++ b/src/Dodge/LevelGen/StaticWalls.hs
@@ -3,6 +3,11 @@ Module      : Dodge.LevelGen.StaticWalls
 Description : Concerns carving out of static walls to create the general room plan of the level.
 -}
 module Dodge.LevelGen.StaticWalls 
+    ( cutWalls
+    , removeInverseWalls
+    , expandPolyByFixed
+    , cutPoly
+    )
     where
 import Geometry
 import Geometry.ConvexPoly
@@ -14,17 +19,6 @@ import Data.Maybe
 -- Order is important: the wall face is to the left of the line going from 
 -- 'fst' to 'snd'.
 type WallP = (Point2,Point2)
--- | Test whether lines are near parallel.
--- Assumes non-zero length lines.
-nearParallel :: WallP -> WallP -> Bool
-nearParallel (a,b) (x,y)
-    = dotV (a -.- b) (vNormal (x -.- y)) < 0.01
--- | Test for near collinearity.
--- Assumes non-zero length lines.
-nearCollinear :: WallP -> WallP -> Bool
-nearCollinear (a,b) (x,y)
-    | a /= x = nearParallel (a,b) (x,y) && nearParallel (a,b) (a,x)
-    | otherwise = nearParallel (a,b) (x,y) && nearParallel (a,b) (a,y)
 -- | Remove inverse walls.
 removeInverseWalls :: [WallP] -> [WallP]
 removeInverseWalls ((a,b):ps)
@@ -50,24 +44,6 @@ cutWallsRetry i ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
     x = fromIntegral i / 100
     a | even i    = 0.001
       | otherwise = negate 0.001
--- | Cut out a polygon from a set of walls, and check for errors in the
--- created walls.
--- Give error if created walls are not consistent.
-cutWalls'' :: [Point2] -> [WallP] -> [WallP]
-cutWalls'' ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
-    [] -> newWalls
-    errs -> error $ "during level generation function cutWalls: when cutting poly:\n" ++ show ps 
-        ++ "\nRight corner errors:\n"
-        ++ unlines (map show errs)
-        ++ "\nLeft corner errors:\n"
-        ++ unlines (map show errsL)
-        ++ "\nWalls before cut:\n"
-        ++ unlines (map show wls)
-        ++ "\nWalls after cut:\n"
-        ++ unlines (map show newWalls)
-  where
-    newWalls = cutPoly ps wls
-    errsL = mapMaybe (`checkWallLeft` newWalls) newWalls
 -- | Given a specific wall and list of walls, checks that the number of walls leaving the
 -- second point is the same as the number of walls entering the second point of
 -- the specific wall.
@@ -80,18 +56,6 @@ checkWallRight (x,y) wls
   where
     ins     = filter (\(_,b) -> b == y) wls
     outs    = filter (\(a,_) -> a == y) wls
--- | Given a specific wall and list of walls, checks that the number of walls leaving the
--- first point is the same as the number of walls entering the first point of
--- the specific wall.
--- On success returns Nothing, on failure returns Just the specific wall and the
--- list of walls leaving the first point.
-checkWallLeft :: WallP -> [WallP] -> Maybe (WallP,[WallP])
-checkWallLeft (x,y) wls
-    | length ins == length outs = Nothing
-    | otherwise                 = Just ((x,y), outs)
-  where
-    ins     = filter (\(a,_) -> a == x) wls
-    outs    = filter (\(_,b) -> b == x) wls
 -- | Given a polygon of points and collection of walls, cuts out the polygon.
 -- Ie returns a new set of walls with a hole determined by anticlockwise ordering of the points.
 -- The overall procedure is: 
@@ -109,8 +73,7 @@ checkWallLeft (x,y) wls
 -- collided with
 -- Be aware that we do not remove all colinear walls; this may still cause bugs
 cutPoly :: [Point2] -> [WallP] -> [WallP]
-cutPoly qs wls = 
-    nubOrd
+cutPoly qs wls = nubOrd
     . removeInverseWalls
     . filter (not . wallIsZeroLength) 
     . fuseWallsWith zs
@@ -126,15 +89,13 @@ cutPoly qs wls =
 expandPolyBy :: Float -> [Point2] -> [Point2]
 expandPolyBy x ps = map f ps
   where
-    cp = centroid ps
-    f p = p +.+ x *.* (p -.- cp)
+    f p = p +.+ x *.* (p -.- centroid ps)
 -- | Given a value and a poly, pushes the poly points out from the center by the
 -- fixed amount.
 expandPolyByFixed :: Float -> [Point2] -> [Point2]
 expandPolyByFixed x ps = map f ps
   where
-    cp = centroid ps
-    f p = p +.+ x *.* safeNormalizeV (p -.- cp)
+    f p = p +.+ x *.* safeNormalizeV (p -.- centroid ps)
 -- | Given a polygon expressed as a list of points and a collection of walls,
 -- returns: 
 -- fst: points of the polygon's intersection with walls
@@ -184,12 +145,6 @@ addPolyWall wls (p1,p2) =
 -- to the point.
 findClosePoint :: [Point2] -> Point2 -> Maybe Point2
 findClosePoint ps p = find (\q -> dist p q < 5) ps
--- | Given a list of points and a point, returns the point if none in the list
--- is close to the point.
-pointIfNotClose :: [Point2] -> Point2 -> Maybe Point2
-pointIfNotClose ps p = case findClosePoint ps p of
-    Nothing -> Just p
-    _       -> Nothing
 -- | Fuses a point with one in a list if any are close enough.
 fusePoint :: [Point2] -> Point2 -> ([Point2],Point2)
 fusePoint ps p = case findClosePoint ps p of
@@ -219,17 +174,3 @@ removeWallsInPolygon :: [Point2] -> [WallP] -> [WallP]
 removeWallsInPolygon ps = filter (not . cond)
   where 
     cond wall = pointInOrOnPolygon (0.5 *.* uncurry (+.+) wall) ps
-
------------------------DEBUG CODE:
--- | Given a polygon and list of walls, finds walls inside the polygon.
-findWallsInPolygon :: [Point2] -> [WallP] -> [WallP]
-findWallsInPolygon ps = filter cond
-  where 
-    cond wall = pointInOrOnPolygon (0.5 *.* uncurry (+.+) wall) ps
-
-expandToSquare :: (Point2,Point2) -> [(Point2,Point2)]
-expandToSquare (a,b) = [(a,b),(b,c),(c,d),(d,a)]
-  where
-    v = a -.- b
-    c = b +.+ vNormal v
-    d = a +.+ vNormal v
diff --git a/src/Dodge/LevelGen/Switch.hs b/src/Dodge/LevelGen/Switch.hs
index 0b1fdddb1..302dd3259 100644
--- a/src/Dodge/LevelGen/Switch.hs
+++ b/src/Dodge/LevelGen/Switch.hs
@@ -1,5 +1,7 @@
 module Dodge.LevelGen.Switch
-    where
+    ( makeSwitch
+    , makeButton
+    ) where
 import Dodge.Data
 import Dodge.Default
 import Dodge.Data.SoundOrigin
@@ -75,4 +77,3 @@ makeSwitch col1 col2 effOn effOff = Button
         { _btState = BtOff
         , _btText = "SWITCH/"
         }
-
diff --git a/src/Dodge/LightSources/Lamp.hs b/src/Dodge/LightSources/Lamp.hs
index 8b0e848d4..f88d22b63 100644
--- a/src/Dodge/LightSources/Lamp.hs
+++ b/src/Dodge/LightSources/Lamp.hs
@@ -3,7 +3,6 @@ module Dodge.LightSources.Lamp
     , tLight
     , lightAt
     , colorLightAt
-    , lampPic
     , lampCover
     , lampCoverWhen
     , doubleLampCover
@@ -73,10 +72,6 @@ tLight t rmax col (V3 x y z) = TLS
         | otherwise         = Just $ tls    
             & tlsTime -~ 1
 
-lampPic :: Float -> Picture
---{-# INLINE lampPic #-}
-lampPic h = setLayer 1 (setDepth h . color white $ circleSolid 3)
-
 lampCover :: Float -> Prop
 lampCover h = ShapeProp
     { _pjPos = V2 0 0
diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs
index 09ae28df0..3fc4de738 100644
--- a/src/Dodge/Particle/Bullet/HitEffect.hs
+++ b/src/Dodge/Particle/Bullet/HitEffect.hs
@@ -27,7 +27,7 @@ bulHitCr :: Particle -> Point2 -> Creature -> World -> World
 bulHitCr bt p cr w 
     | crIsArmouredFrom p cr
         = createSparkCol 8 colID p1 (argV (p1 -.- p) + d1) . addDamageArmoured $ w
-    | otherwise = addDamage . makeHitSound $ w
+    | otherwise = addDamage . bulletHitSound p $ w
   where
     sp = head $ _btTrail' bt
     bulVel = _btVel' bt
@@ -35,16 +35,18 @@ bulHitCr bt p cr w
     mvDams = [ PushDam 1 $ 2 *.* bulVel ]
     addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
     addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
-    makeHitSound = soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
     cid = _crID cr
     (d1,_)  = randomR (-0.7,0.7) $ _randGen w
     colID = _btColor' bt
     p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
+
+bulletHitSound :: Point2 -> World -> World
+bulletHitSound p = soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
 {- | Bounce off armoured creatures, otherwise do damage.  -}
 bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World
 bulBounceArmCr' bt p cr w 
     | crIsArmouredFrom p cr = addBouncer . addDamageArmoured $ w
-    | otherwise = addDamage . makeHitSound $ w
+    | otherwise = addDamage . bulletHitSound p $ w
   where
     sp = head $ _btTrail' bt
     bulVel = _btVel' bt
@@ -52,7 +54,6 @@ bulBounceArmCr' bt p cr w
     mvDams = [ PushDam 1 $ 2 *.* bulVel ]
     addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
     addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
-    makeHitSound = soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
     cid = _crID cr
     newDir = safeNormalizeV (p -.- _crPos cr)
     pOut = p +.+ 2 *.* newDir
@@ -72,7 +73,7 @@ bulPenCr' bt p cr w
             ] 
             ++
            )
-    $ soundMultiFrom [CrHitSound 0] ep hit1S (Just 10)
+    $ bulletHitSound ep
     $ over worldEvents (addPiercer . )
     w
   where 
@@ -96,7 +97,7 @@ hvBulHitCr bt p cr w
             ] 
             ++
            )
-    $ soundMultiFrom [CrHitSound 0] ep hit1S (Just 10)
+    $ bulletHitSound ep
     w
   where 
     (d1,_)  = randomR (-0.7,0.7) $ _randGen w
@@ -108,7 +109,7 @@ bulIncCr' :: Particle -> Point2 -> Creature -> World -> World
 bulIncCr' bt p cr w 
     = over (creatures . ix cid . crState . crDamage)
            ( Piercing 60 sp p ep : )
-    . soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
+    $ bulletHitSound p
     $ incFlamelets
     w
   where   
@@ -122,7 +123,7 @@ bulConCr' :: Particle -> Point2 -> Creature -> World -> World
 bulConCr' bt p cr w 
     = over (creatures . ix cid . crState . crDamage)
            ( Piercing 60 sp p ep : )
-    . soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
+    $ bulletHitSound p
     $ mkwave
     w
   where   
@@ -203,4 +204,3 @@ hvBulHitWall bt p x w =  damageBlocksBy 5 x $ set randGen g $ foldr ($) w (spark
     ds      = randomRs (-0.7,0.7) $ _randGen w
     ts      = randomRs (4,8) $ _randGen w
     sparks pos vel = zipWith3 (\t c d -> createSparkCol t c pos (argV vel + d)) ts cs ds
-