Refactor vault room

src/Dodge/Room/Foreground.hs

@@ -47,11 +47,17 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
         ]
     yN = d * 0.5 *.* normalizeV (pa -.- pb)
 
-highBar :: Float -> Point2 -> Point2 -> Shape
-highBar h x y = translateSHz h $ colorSH orange $ upperPrismPoly 5
+thinHighBar :: Float -> Point2 -> Point2 -> Shape
+thinHighBar = highBar 3
+
+thickHighBar :: Float -> Point2 -> Point2 -> Shape
+thickHighBar = highBar 5
+
+highBar :: Float -> Float -> Point2 -> Point2 -> Shape
+highBar thickness h x y = translateSHz h $ colorSH orange $ upperPrismPoly thickness
     [x +.+ n, y +.+ n, y -.- n, x -.- n]
   where
-    n = 2.5 *.* normalizeV (vNormal (y -.- x))
+    n = 0.5 * thickness *.* normalizeV (vNormal (y -.- x))
 
 highPipe :: Float -> Point2 -> Point2 -> Shape
 highPipe h x y = colorSH orange $ prismPoly
@@ -67,10 +73,10 @@ girderZ
     -> Float -- ^ width
     -> Point2 -> Point2 -> Shape
 girderZ h d w x y = colorSH red $ mconcat $
-    [ highBar h xt yt
-    , highBar h xb yb
+    [ thinHighBar h xt yt
+    , thinHighBar h xb yb
     ]
-    <> zipWith (highBar (h- 5)) ps qs
+    <> zipWith (thinHighBar (h- 1)) ps qs
   where
     n = w *.* normalizeV (vNormal $ y -.- x)
     xb = x +.+ n
@@ -86,10 +92,10 @@ girderV
     -> Float -- ^ width
     -> Point2 -> Point2 -> Shape
 girderV h d w x y = colorSH red $ mconcat $
-    [ highBar h xt yt
-    , highBar h xb yb
+    [ thinHighBar h xt yt
+    , thinHighBar h xb yb
     ]
-    <> zipWith (highBar (h- 5)) ps qs
+    <> zipWith (thinHighBar (h- 1)) ps qs
   where
     n = w *.* normalizeV (vNormal $ y -.- x)
     xb = x +.+ n
@@ -109,10 +115,10 @@ girder
     -> Float -- ^ width
     -> Point2 -> Point2 -> Shape
 girder h d w x y = colorSH red $ mconcat $
-    [ highBar h xt yt
-    , highBar h xb yb
+    [ thinHighBar h xt yt
+    , thinHighBar h xb yb
     ]
-    <> zipWith (highBar (h- 5)) ps qs
+    <> zipWith (thinHighBar (h- 1)) ps qs
   where
     n = w *.* normalizeV (vNormal $ y -.- x)
     xb = x +.+ n

src/Dodge/Room/Procedural.hs

@@ -10,13 +10,16 @@ module Dodge.Room.Procedural
     , makeGrid
     ) where
 import Dodge.Data
+import Dodge.Default.Wall
 import Dodge.Room.Data
 import Dodge.Room.Placement
 import Dodge.Room.Link
 import Dodge.Room.Path
+import Dodge.Placement
 import Dodge.Default.Room
 import Dodge.Item.Consumable
 import Dodge.Item.Equipment
+import Dodge.Room.Foreground
 import Dodge.Item.Weapon
 import Dodge.RandomHelp
 import Dodge.LevelGen
@@ -222,9 +225,10 @@ centerVaultRoom n w h d = do
         nsDoors = rectNSWE (d + 20) (negate (d +20)) (-20) 20
         weDoors = rectNSWE 20 (-20) (d + 20) (negate (d +20)) 
         centerPoly = rectWdthHght (d - 20) (d - 20)
-        polys = centerPoly : nsDoors : weDoors : take 4 (iterate (map vNormal) northPoly)
+        --polys = centerPoly : nsDoors : weDoors : take 4 (iterate (map vNormal) northPoly)
     return $ defaultRoom
-        { _rmPolys  = polys
+        --{ _rmPolys  = polys
+        { _rmPolys  = [rectNSWE h (-h) (-w) w]
         , _rmLinks  = 
             [(V2 0    h  , 0   )
             ,(V2 w    0  ,-pi/2)
@@ -233,11 +237,15 @@ centerVaultRoom n w h d = do
             ]
         , _rmPath   = []
         , _rmPS     = 
-            [sPS (V2 (d-25) (d-25)) 0 putLamp
-            ,sPS (V2 (w-5) (h-5)) 0 putLamp
-            ,sPS (V2 (w-5) (5-h)) 0 putLamp
-            ,sPS (V2 (5-w) (h-5)) 0 putLamp
-            ,sPS (V2 (5-w) (5-h)) 0 putLamp
+            [sps0 $ PutWall (rectNSEW ( d) (d - 30) ( d) (d - 30)) defaultWall
+            ,sps0 $ PutWall (rectNSEW ( d) (d - 30) (-d) (30 - d)) defaultWall
+            ,sps0 $ PutWall (rectNSEW (-d) (30 - d) ( d) (d - 30)) defaultWall
+            ,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
+            ,sps0 $ PutForeground $ girder 55 10 10 (V2 (-w) (h/2)) (V2 w (h/2))
+            ,sps0 $ PutForeground $ girder 55 10 10 (V2 (-w) (h/2)) (V2 w (h/2))
+            ,mountedLight (V2 (-w) (h/2-20)) (V3 (20-w) (h/2-20) 70)
+            ,mountedLight (V2   w  (h/2-20)) (V3 (w-20) (h/2-20) 70)
+            ,mountedLightV (V2 0  (d-20)) (V3 0 0 70)
             ]
             ++ concat (zipWith (\i r -> map (shiftPSBy (V2 0 0,r)) $ theDoor i) 
                         [n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2])
@@ -246,7 +254,7 @@ centerVaultRoom n w h d = do
   where
     col = dim $ dim $ bright red
     theDoor i = 
-        [ sPS (V2 0  (d-10)) 0 $ PutDoubleDoor col (cond i) (V2 (-19) 0) (V2 19 0) 2
+        [ sPS (V2 0  (d-10)) 0 $ PutDoubleDoor col (cond i) (V2 (-21) 0) (V2 21 0) 2
         , sPS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col red
                            (over worldState (M.insert (DoorNumOpen i) True))
                            (over worldState (M.insert (DoorNumOpen i) False))