Refactor

src/Dodge/LevelGen/AutoDoor.hs

@@ -1,4 +1,4 @@
-{-
+{- |
 Creation of doors that open when creatures approach them.
  -}
 {-# LANGUAGE BangPatterns #-}
@@ -68,11 +68,12 @@ mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane (pl,pr))
 
     addSound (x:xs) = f x : xs
     f wl = over doorMech g wl
-    g dm w | dist wp pld > 2 && dist wp hwd > 2 
-              = soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0 $ dm w
-           | otherwise = dm w
+    g dm w 
+        | dist wp pld > 2 && dist wp hwd > 2 
+            = soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0 $ dm w
+        | otherwise = dm w
       where 
-        wp = snd (_wlLine $ _walls w IM.! (head xs))
+        wp = snd (_wlLine $ _walls w IM.! head xs)
 
 autoDoorPane 
     :: (Point2,Point2)  -- ^ Trigger line

src/Dodge/LevelGen/Block.hs

@@ -1,5 +1,5 @@
-{-
-Creation, update and descruction of destructible walls.
+{- |
+Creation, update and destruction of destructible walls.
  -}
 module Dodge.LevelGen.Block where
 import Dodge.Data
@@ -26,17 +26,18 @@ updateBlocks w = (\w' -> seq (_wallsZone w') w') $ flip (foldr removeFromZone) d
     removeFromZone :: Wall -> World -> World
     removeFromZone bl = over (wallsZone . ix x . ix y) (IM.delete (_wlID bl))
       where 
-        (x,y) = zoneOfPoint $ pHalf (fst $ _wlLine bl) (snd $ _wlLine bl)
+        (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine bl)
     deadPanes = filter blockIsDead (IM.elems $ _walls w)
     deadBlocks = nubBy ((==) `on` _blIDs) deadPanes
     blockIsDead wl = case wl ^? blHP of 
         Just x  -> x <= 0
         Nothing -> False
-
+{- | Destroy a block.
+Plays destruction sound and sets to be displayed other walls that were shadowed by this wall. -}
 killBlock :: Wall -> World -> World
-killBlock bl w =  f bl .  flip (foldr unshadow) (_blShadows bl) $ w
+killBlock bl w =  f bl . flip (foldr unshadow) (_blShadows bl) $ w
   where
-    f bl@(Block {_blDegrades = (x:xs)}) = degradeBlock bl . hitSound bl
+    f bl@Block{_blDegrades = (x:xs)} = degradeBlock bl . hitSound bl
     f bl          = hitSound' bl
     pos = fst $ _wlLine bl
     hitSound bl 
@@ -50,7 +51,7 @@ killBlock bl w =  f bl .  flip (foldr unshadow) (_blShadows bl) $ w
     unshadow :: Int -> World -> World
     unshadow bid w = case w ^? walls . ix bid of 
         Just b -> 
-            let (x,y) = zoneOfPoint $ pHalf (fst $ _wlLine b) (snd $ _wlLine b)
+            let (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine b)
             in w & wallsZone . ix x . ix y . ix bid . blVisible %~ const True
                  & walls . ix bid . blVisible %~ const True
         Nothing -> w
@@ -97,33 +98,34 @@ addBlock (p:ps) hp col isSeeThrough degradability w
     | hp <= 0 && null degradability = w
     | hp <= 0 = addBlock (p:ps) (head degradability + hp) col isSeeThrough (tail degradability) w
     | otherwise = w  
-            & wallsZone %~ flip (IM.foldr wallInZone) panes
-            & walls     %~ IM.union panes
+        & wallsZone %~ flip (IM.foldr wallInZone) panes
+        & walls     %~ IM.union panes
   where 
     lines = zip (p:ps) (ps ++ [p])
     i = newKey $ _walls w
     is = [i.. i + length lines-1]
-    panes = IM.fromList $ zip is 
-              $ zipWith (\j (a,b) -> Block { _wlLine = (a,b)
-                                           , _wlID = j
-                                           , _wlColor = col
-                                           , _wlSeen = False
-                                           , _blIDs = is
-                                           , _blHP = hp
-                                           , _wlIsSeeThrough = isSeeThrough
-                                           , _blVisible = True
-                                           , _blShadows = []
-                                           , _blDegrades = degradability
-                                           }
-                         ) is lines
+    panes = IM.fromList $ zip is $ zipWith 
+        (\j (a,b) -> Block 
+            { _wlLine = (a,b)
+            , _wlID = j
+            , _wlColor = col
+            , _wlSeen = False
+            , _blIDs = is
+            , _blHP = hp
+            , _wlIsSeeThrough = isSeeThrough
+            , _blVisible = True
+            , _blShadows = []
+            , _blDegrades = degradability
+            }
+        ) is lines
     wallInZone wl 
-        | dist (fst $ _wlLine wl) (snd $ _wlLine wl) <= 2*zoneSize 
-                      = insertIMInZone x y wlid wl
+        | uncurry dist (_wlLine wl) <= 2*zoneSize 
+            = insertIMInZone x y wlid wl
         | otherwise = flip (foldr (\(a,b) -> insertIMInZone a b wlid wl)) ips
       where 
-        (x,y) = zoneOfPoint $ pHalf (fst $ _wlLine wl) (snd $ _wlLine wl)
+        (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
         wlid  = _wlID wl
-        ips = map zoneOfPoint $ divideLine (2*zoneSize) (fst $ _wlLine wl) (snd $ _wlLine wl)
+        ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
         
 putBlock :: [Point2] -> Int -> Color -> Bool -> [Int] -> World -> World
 putBlock (p:ps) i c b is w = foldr (uncurry removePathsCrossing) wWithBlock pairs

src/Dodge/LevelGen/LineBlock.hs

@@ -1,28 +1,26 @@
+{- | Splits a line into many four cornered blocks. -}
 module Dodge.LevelGen.LineBlock
-    (putLineBlock
+    ( putLineBlock
     )
     where
 import Dodge.Data
 import Dodge.Base
 import Dodge.LevelGen.Pathing
-
 import Picture
 import Geometry
 
 import Control.Lens
-
 import qualified Data.IntMap as IM
-
--- taken from online, splits a list into its even and odd elements
+-- | Taken from online, splits a list into its even and odd elements
 evenOddSplit = foldr f ([],[])
     where f a (ls,rs) = (rs, a : ls)
 
 putLineBlock 
-    :: Wall     -- Base pane
-    -> Float    -- Block width
-    -> Float    -- Block depth
-    -> Point2   -- Start point (symmetric)
-    -> Point2   -- End point (symmetric)
+    :: Wall     -- ^ Base pane
+    -> Float    -- ^ Block width
+    -> Float    -- ^ Block depth
+    -> Point2   -- ^ Start point (symmetric)
+    -> Point2   -- ^ End point (symmetric)
     -> World 
     -> World
 putLineBlock basePane blockWidth depth a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
@@ -30,7 +28,7 @@ putLineBlock basePane blockWidth depth a b w = removePathsCrossing a b $ foldr i
     d = dist a b
     rot = argV (b -.- a)
     psOnLine = divideLineOddNumPoints blockWidth a b
-    halfBlockWidth = d / (fromIntegral $ length psOnLine - 1)
+    halfBlockWidth = d / fromIntegral (length psOnLine - 1)
     blockCenPs = snd $ evenOddSplit psOnLine
     numBlocks = length blockCenPs
     is = [0.. numBlocks - 1]

src/Dodge/LevelGen/StaticWalls.hs

@@ -132,7 +132,7 @@ cutWalls' qs walls =
 expandPolyBy :: Float -> [Point2] -> [Point2]
 expandPolyBy x ps = map f ps
   where
-    cp = 1/(fromIntegral (length ps)) *.* foldr (+.+) (0,0) ps
+    cp = 1/fromIntegral (length ps) *.* foldr (+.+) (0,0) ps
     f p = p +.+ x *.* (p -.- cp)
 -- | Given a polygon expressed as a list of points and a collection of walls,
 -- returns: 
@@ -171,7 +171,7 @@ addPolyWall (p1,p2) walls =
         Just ws -> if all (\(x,y) -> isLHS x y p3) ws
             then walls
             else (p1,p2) : walls
-        Nothing -> ((p1,p2) : walls)
+        Nothing -> (p1,p2) : walls
   where 
     p3 = 0.5 *.* (p1 +.+ p2)
     p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)