Simplify and unify block placement

src/Dodge/LevelGen/Block.hs

@@ -76,8 +76,7 @@ addBlockNoShadow (p:ps) hp col isSeeThrough degradability hasAllShadows w
     | hp <= 0 = addBlock (p:ps) (head degradability + hp) col isSeeThrough (tail degradability) w
     | otherwise = over wallsZone (flip (IM.foldr wallInZone) blocks)
       $ over walls (IM.union blocks) w
---addBlock (p:p':ps) w = over walls (IM.insert i b) w
-    where 
+  where 
         shadowList | hasAllShadows = repeat True
                    | otherwise     = concat $ repeat [False,True]
         lines = zip (p:ps) (ps ++ [p])

src/Dodge/LevelGen/LineBlock.hs

@@ -0,0 +1,57 @@
+module Dodge.LevelGen.LineBlock
+    (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
+evenOddSplit = foldr f ([],[])
+    where f a (ls,rs) = (rs, a : ls)
+
+putLineBlock :: Wall -> Float -> Float -> Point2 -> Point2 -> World -> World
+putLineBlock basePane blockWidth depth a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
+  where 
+    d = dist a b
+    rot = argV (b -.- a)
+    psOnLine = divideLineOddNumPoints blockWidth a b
+    halfBlockWidth = d / (fromIntegral $ length psOnLine - 1)
+    blockCenPs = snd $ evenOddSplit psOnLine
+    numBlocks = length blockCenPs
+    is = [0.. numBlocks - 1]
+    cornerPoints = [(-halfBlockWidth,-depth)   -- goes anticlockwise around the block
+                   ,(-halfBlockWidth, depth)
+                   ,( halfBlockWidth, depth)
+                   ,( halfBlockWidth,-depth)
+                   ]
+    cornersAt p = fmap ( (p +.+) . rotateV rot) cornerPoints
+    linesAt p = map (\(a,b) -> [a,b]) $ makeLoopPairs $ cornersAt p
+    k = newKey $ _walls w
+    ksAtI i = map ( + (k + i*4) ) [0,1,2,3]
+    visibilityAt i | i == 0             = [ True,True,False,True]
+                   | i == numBlocks - 1 = [False,True, True,True]
+                   | otherwise          = [False,True,False,True]
+    shadowsAt i | i == 0             = ksAtI 1
+                | i == numBlocks - 1 = ksAtI $ numBlocks - 2
+                | otherwise          = ksAtI (i-1) ++ ksAtI (i+1)
+    makeBlockAt :: Point2 -> Int -> [Wall]
+    makeBlockAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
+    makePane i visStatus k' ps 
+          = basePane {_wlID = k'
+                     ,_wlLine = ps
+                     ,_blIDs = ksAtI i
+                     ,_blShadows = shadowsAt i
+                     ,_blVisible = visStatus
+                     }
+    listBlocks = concat $ zipWith makeBlockAt blockCenPs is
+    insertBlock :: Wall -> World -> World
+    insertBlock wl = over walls $ IM.insert (_wlID wl) wl
+

src/Dodge/LevelGen/WindowBlock.hs

@@ -1,72 +0,0 @@
-module Dodge.LevelGen.WindowBlock
-    (putWindowBlock'
-    )
-    where
-import Dodge.Data
-import Dodge.Base
-import Dodge.LevelGen.Pathing
-
-import Picture
-import Geometry
-
-import Control.Lens
-
-import qualified Data.IntMap as IM
-
-basePane :: Wall
-basePane = Block
-    { _wlLine = []
-    , _wlID = 0
-    , _wlColor = withAlpha 0.2 cyan
-    , _wlDraw = Nothing
-    , _wlSeen = False
-    , _blIDs = []
-    , _blHP = 1
-    , _wlIsSeeThrough = True
-    , _blVisible = True
-    , _blShadows = []
-    , _blDegrades = [5,5]
-    }
---singleBlock :: [Int] -> IM.IntMap Wall
-
--- taken from online, splits a list into its even and odd elements
-evenOddSplit = foldr f ([],[])
-    where f a (ls,rs) = (rs, a : ls)
-
-putWindowBlock' :: Point2 -> Point2 -> World -> World
-putWindowBlock' a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
-    where d = dist a b
-          rot = argV (b -.- a)
-          psOnLine = divideLineOddNumPoints 9 a b
-          halfBlockWidth = d / (fromIntegral $ length psOnLine - 1)
-          blockCenPs = snd $ evenOddSplit psOnLine
-          numBlocks = length blockCenPs
-          is = [0.. numBlocks - 1]
-          cornerPoints = [(-halfBlockWidth,-9)   -- goes anticlockwise around the block
-                         ,(-halfBlockWidth, 9)
-                         ,( halfBlockWidth, 9)
-                         ,( halfBlockWidth,-9)
-                         ]
-          cornersAt p = fmap ( (p +.+) . rotateV rot) cornerPoints
-          linesAt p = map (\(a,b) -> [a,b]) $ makeLoopPairs $ cornersAt p
-          k = newKey $ _walls w
-          ksAtI i = map ( + (k + i*4) ) [0,1,2,3]
-          visibilityAt i | i == 0             = [ True,True,False,True]
-                         | i == numBlocks - 1 = [False,True, True,True]
-                         | otherwise          = [False,True,False,True]
-          shadowsAt i | i == 0             = ksAtI 1
-                      | i == numBlocks - 1 = ksAtI $ numBlocks - 2
-                      | otherwise          = ksAtI (i-1) ++ ksAtI (i+1)
-          makeBlockAt :: Point2 -> Int -> [Wall]
-          makeBlockAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
-          makePane i visStatus k' ps 
-                = basePane {_wlID = k'
-                           ,_wlLine = ps
-                           ,_blIDs = ksAtI i
-                           ,_blShadows = shadowsAt i
-                           ,_blVisible = visStatus
-                           }
-          listBlocks = concat $ zipWith makeBlockAt blockCenPs is
-          insertBlock :: Wall -> World -> World
-          insertBlock wl = over walls $ IM.insert (_wlID wl) wl
-