Tweak block sounds

src/Dodge/Placement/Instance/Wall.hs

@@ -23,7 +23,7 @@ lowWall ps = ps0j (PutForeground . colorSH col $ upperPrismPoly 30 ps)
 singleBlock :: Point2 -> [Placement]
 singleBlock a = 
     [sPS a 0 
-        $ PutBlock [5,20,20] (greyN 0.5)
+        $ PutBlock StoneBlock [5,20,20] (greyN 0.5)
         $ reverse 
         $ rectNSWE 10 (-10) (-10) 10
     ]
@@ -32,14 +32,14 @@ Places a line of blocks between two points.
 Width 9, also extends out from each point by 9.
  -}
 blockLine :: Point2 -> Point2 -> Placement
-blockLine a b = sps0 $ PutLineBlock baseBlockPane 9 9 a b
+blockLine a b = sps0 $ PutLineBlock baseBlockPane StoneBlock 9 9 a b
 
 {-
 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 baseWindowPane 8 8 a b
+windowLine a b = sps0 $ PutLineBlock baseWindowPane GlassBlock 8 8 a b
 {-
 Places an unbreakable window between two points.
 Width 7, also extends out from each point by 7.
@@ -70,7 +70,7 @@ wallLine a b = sps0 $ PutWall ps defaultWall
     up   = vNormal left
 
 windowLineType :: Point2 -> Point2 -> PSType
-windowLineType = PutLineBlock baseWindowPane 8 8
+windowLineType = PutLineBlock baseWindowPane GlassBlock 8 8
 
 baseBlockPane :: Wall
 baseBlockPane = defaultWall

src/Dodge/Placement/PlaceSpot.hs

@@ -102,9 +102,9 @@ placeSpotID ps pt w = case pt of
     PutDoor col f pss -> placeDoor col f (map (bimap doShift doShift) pss) w
     PutCoordinate coordp -> placeNewInto coordinates (doShift coordp) w
     PutSlideDoor pathing col f a b spd -> placeSlideDoor pathing col f (doShift a) (doShift b) spd w
-    PutBlock (hp:hps) col ps' -> placeBlock (map doShift ps') hp col Opaque hps w
+    PutBlock bm (hp:hps) col ps' -> placeBlock (map doShift ps') hp col Opaque hps bm w
     PutBlock{} -> error "messed up block placement somehow"
-    PutLineBlock wl wdth dpth a b -> placeLineBlock wl wdth dpth (doShift a) (doShift b) w
+    PutLineBlock wl bm wdth dpth a b -> placeLineBlock wl bm wdth dpth (doShift a) (doShift b) w
     PutWall { _pwPoly = ps', _pwWall = wl } -> (0,placeWallPoly (map doShift ps') wl w)
     PutForeground sh -> (0,w & foregroundShape %~ ((uncurryV translateSHf p . rotateSH rot) sh <>))
     PutNothing -> (0,w)

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -23,15 +23,17 @@ addBlock
     -> Color 
     -> Opacity         -- ^ Is the block see through?
     -> [Int]        -- ^ Extra layers of health
+    -> BlockMaterial
     -> World 
     -> World
-addBlock (p:ps) hp col opacity hps w 
+addBlock (p:ps) hp col opacity hps bm w 
     | hp <= 0 && null hps = w
-    | hp <= 0 = addBlock (p:ps) (head hps + hp) col opacity (tail hps) w
+    | hp <= 0 = addBlock (p:ps) (head hps + hp) col opacity (tail hps) bm w
     | otherwise = w
         & wallsZone . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes
         & walls  %~ IM.union panes
-        & blocks %~ IM.insert blid (Block {_blID = blid,_blWallIDs = IS.fromList is, _blHPs = hp:hps, _blShadows=[]})
+        & blocks %~ IM.insert blid Block 
+            {_blID = blid,_blWallIDs = IS.fromList is, _blHPs = hp:hps, _blShadows=[], _blMaterial = bm}
   where 
     blid = IM.newKey $ _blocks w
     lns = zip (p:ps) (ps ++ [p])
@@ -55,24 +57,26 @@ addBlock (p:ps) hp col opacity hps w
         (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
         wlid  = _wlID wl
         ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
-addBlock _ _ _ _ _ _ = error "Trying to add a block with incomplete polygon"
+addBlock _ _ _ _ _ _ _ = error "Trying to add a block with incomplete polygon"
         
-placeBlock :: [Point2] -> Int -> Color -> Opacity -> [Int] -> World -> (Int,World)
-placeBlock poly i c opac is w = (0, foldr (uncurry removePathsCrossing) wWithBlock pairs)
+placeBlock :: [Point2] -> Int -> Color -> Opacity -> [Int] -> BlockMaterial -> World -> (Int,World)
+placeBlock poly i c opac is bm w 
+    = (0, foldr (uncurry removePathsCrossing) wWithBlock pairs)
   where 
     pairs = loopPairs poly
-    wWithBlock = addBlock poly i c opac is w
+    wWithBlock = addBlock poly i c opac is bm w
 
 {- | Splits a line into many four cornered blocks. -}
 placeLineBlock 
     :: Wall     -- ^ Base pane
+    -> BlockMaterial
     -> Float    -- ^ Block width
     -> Float    -- ^ Block depth
     -> Point2   -- ^ Start point (symmetric)
     -> Point2   -- ^ End point (symmetric)
     -> World 
     -> (Int, World)
-placeLineBlock basePane blockWidth depth a b w = (,) 0 
+placeLineBlock basePane bm blockWidth depth a b w = (,) 0 
     $ removePathsCrossing a b $ foldr insertWall (insertBlocks w) listWalls
   where 
     psOnLine = divideLineOddNumPoints blockWidth a b
@@ -86,7 +90,8 @@ placeLineBlock basePane blockWidth depth a b w = (,) 0
     wlid = IM.newKey $ _walls w
     blid = IM.newKey $ _blocks w
     insertBlock i = over blocks $ IM.insert (i+blid) Block 
-        {_blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i, _blHPs = [5,5], _blShadows = shadowsAt i}
+        { _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i
+        , _blHPs = [5,5], _blShadows = shadowsAt i, _blMaterial = bm}
     insertBlocks = flip (foldr insertBlock) is
     ksAtI i = map ( + (wlid + i*4) ) [0,1,2,3]
     visibilityAt i