Make tanks into decorated blocks

src/Dodge/Placement/Instance/Block.hs

@@ -8,16 +8,20 @@ import Shape
 import Dodge.Default.Wall
 import Dodge.Default.Block
 
-lowBlock :: Material -> Color -> Float -> [Point2] -> PSType
-lowBlock mat col h ps = PutBlock bl wl $ reverse ps
+decoratedBlock :: (Block -> Shape) -> Material -> Color -> Float -> [Point2] -> PSType
+decoratedBlock decf mat col h ps = PutBlock bl wl $ reverse ps
   where
     bl = defaultBlock
-        & blDraw .~ const (noPic $ colorSH col (upperPrismPoly h $ reverse ps))
+        & blDraw .~ (\bl' -> noPic (colorSH col (upperPrismPoly h $ reverse ps) <> decf bl'))
         & blDeath .~ const id
+        & blHeight .~ h
+        & blMaterial .~ mat
     wl = defaultWall 
-        & wlUnshadowed .~ False 
         & wlColor .~ col 
         & wlRotateTo .~ False  
         & wlOpacity .~ SeeAbove
         & wlMaterial .~ mat
         & wlHeight .~ h
+
+lowBlock :: Material -> Color -> Float -> [Point2] -> PSType
+lowBlock = decoratedBlock (const mempty)

src/Dodge/Placement/Instance/Tank.hs

@@ -4,17 +4,13 @@ module Dodge.Placement.Instance.Tank
     , roundTankCross
     ) where
 import Dodge.Data
-import Dodge.Default.Block
---import Dodge.Placement.PlaceSpot
 import Dodge.LevelGen.Data
 import Dodge.Room.Foreground
-import Dodge.Default.Wall
---import Dodge.Placement.TopDecoration
+import Dodge.Placement.Instance.Block
 import Geometry
 import Shape
-import ShapePicture
 import Color
-import LensHelp
+--import LensHelp
 --import Quaternion
 
 tankSquareDec :: (Float -> Float -> Float -> Color -> Color -> Shape) 
@@ -22,18 +18,17 @@ tankSquareDec :: (Float -> Float -> Float -> Color -> Color -> Shape)
 tankSquareDec dec = tankShape (square 20) (dec 20 20 31)
 
 tankShape :: [Point2] -> (Color -> Color -> Shape) -> Color -> Color -> Placement
-tankShape baseshape facade col col' 
-    = sps0 $ PutBlock bl wl $ reverse baseshape
-  where
-    bl = defaultBlock
-        & blDraw .~ const (noPic $ colorSH col (upperPrismPoly 31 $ reverse baseshape) <> facade col col')
-        & blDeath .~ const id
-    wl = defaultWall 
-        & wlUnshadowed .~ False 
-        & wlColor .~ col 
-        & wlRotateTo .~ False  
-        & wlOpacity .~ SeeAbove
-        & wlMaterial .~ Metal
+tankShape baseshape facade col col' = sps0 $ decoratedBlock (const $ facade col col') Metal col 31 baseshape
+--    = sps0 $ PutBlock bl wl $ reverse baseshape
+--  where
+--    bl = defaultBlock
+--        & blDraw .~ const (noPic $ colorSH col (upperPrismPoly 31 $ reverse baseshape) <> facade col col')
+--        & blDeath .~ const id
+--    wl = defaultWall 
+--        & wlColor .~ col 
+--        & wlRotateTo .~ False  
+--        & wlOpacity .~ SeeAbove
+--        & wlMaterial .~ Metal
 
 --    = ps0jPushPS
 --    (PutShape $ colorSH col (upperPrismPoly 31 baseshape) <> facade col col')

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -74,6 +74,8 @@ plLineBlock basePane blwidth a b gw = ( 0
         , _blDir = 0    -- THIS IS NOT SENSIBLE. TODO rethink block positioning
         , _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise)
         , _blObstructs = []
+        , _blMaterial = _wlMaterial basePane
+        , _blHeight   = 100
         , _blPos = p, _blDraw = const mempty , _blDeath = makeBlockDebris}
         )
     insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -101,7 +101,9 @@ doorMechanism dr w = case mvDir of
     speed = _drSpeed dr
     drid = _drID dr
     moveUpdate = playSound . setStatus
-    playSound = soundContinue (WallSound drid) dpos slideDoorS (Just 1)
+    playSound 
+        | _drPushedBy dr == PushesItself = soundContinue (WallSound drid) dpos slideDoorS (Just 1)
+        | otherwise = id
     dpos = snd $ _drPos dr
     dop = snd $ _drOpenPos dr
     dcp = snd $ _drClosePos dr