Fix shockwave damage radius for walls

src/Dodge/Placement/Instance/Wall.hs

@@ -22,7 +22,7 @@ import Dodge.Placement.Instance.Block
 import Geometry
 
 heightWallPS :: PlacementSpot -> Float -> [Point2] -> Placement
-heightWallPS spot h ps = psPtPl spot $ lowBlock Stone (materialColor Stone) h ps
+heightWallPS spot h = psPtPl spot . lowBlock Stone (materialColor Stone) h
 
 invisibleWall :: [Point2] -> Placement
 invisibleWall ps =
@@ -57,14 +57,14 @@ Places an breakable window between two points.
 Width 8, also extends out from each point by 8.
  -}
 windowLine :: Point2 -> Point2 -> Placement
-windowLine a b = sps0 $ PutLineBlock defaultWindow 8 a b
+windowLine a = sps0 . PutLineBlock defaultWindow 8 a
 
 {-
 Places an unbreakable window between two points.
 Width 7, also extends out from each point by 7.
  -}
 crystalLine :: Point2 -> Point2 -> Placement
-crystalLine a b = sps0 $ PutLineBlock defaultCrystalWall 7 a b
+crystalLine a = sps0 . PutLineBlock defaultCrystalWall 7 a
 
 --crystalLine a b = sps0 $ PutWall ps defaultCrystalWall
 --  where
@@ -109,8 +109,8 @@ replacePutID ::
     [PSType] ->
     Room ->
     Room
-replacePutID i psts r =
-    r & rmPmnts %~ flip (subZipWith (isPutID i) (\ps pt -> ps & plType .~ pt)) psts
+replacePutID i psts =
+    rmPmnts %~ flip (subZipWith (isPutID i) (\ps pt -> ps & plType .~ pt)) psts
 
 {- Partition a list by a predicate, apply a zip to those elements
 that satisfy the predicate, concatenate
@@ -146,17 +146,12 @@ isPutID i ps = Just i == ps ^? plType . putID
 --    aline = PutLineBlock baseBlockPane 9
 
 putBlockRect :: Float -> Float -> Float -> Float -> [Placement]
-putBlockRect a x b y =
-    [ blockLine (V2 a b) (V2 a y)
-    , blockLine (V2 a y) (V2 x y)
-    , blockLine (V2 x y) (V2 x b)
-    , blockLine (V2 x b) (V2 a b)
-    ]
+putBlockRect a x b y = uncurry blockLine <$> loopPairs (rectNSWE b y a x)
 
 putBlockV :: Float -> Float -> Float -> Float -> [Placement]
-putBlockV a x b y =
-    [ blockLine (V2 a b) (V2 a y)
-    , blockLine (V2 x b) (V2 a b)
+putBlockV a x b y = uncurry blockLine <$>
+    [ (V2 a b, V2 a y)
+    , (V2 x b, V2 a b)
     ]
 
 --putBlockC :: Float -> Float -> Float -> Float -> [Placement]
@@ -167,8 +162,8 @@ putBlockV a x b y =
 --    ]
 
 putBlockN :: Float -> Float -> Float -> Float -> [Placement]
-putBlockN a x b y =
-    [ blockLine (V2 a b) (V2 a y)
-    , blockLine (V2 x b) (V2 a b)
-    , blockLine (V2 x y) (V2 x b)
+putBlockN a x b y = uncurry blockLine <$>
+    [ (V2 a b, V2 a y)
+    , (V2 x b, V2 a b)
+    , (V2 x y, V2 x b)
     ]