Add more procedural girders

src/Dodge/Combine/Combinations.hs

@@ -27,7 +27,7 @@ itemCombinations =
     , po [BANGSTICK 1,CAN] revolver
     , po [REVOLVER, SPRING, HARDWARE] $ revolverX 1
 
-    , po [PIPE,TUBE,HARDWARE] bangCone
+    , po [TUBE,HARDWARE] bangCone
     , po [BANGCONE,PLANK] blunderbuss
     , po [BLUNDERBUSS,TUBE] bigBlunderbuss
     , po [BIGBLUNDERBUSS,TUBE] biggerBlunderbuss

src/Dodge/Data.hs

@@ -405,7 +405,14 @@ data Item = Item
     , _itTweaks     :: ItemTweaks
     , _itModules    :: M.Map ModuleSlot ItemModule
     , _itScope      :: Scope
+    , _itValue      :: ItemValue
     }
+data ItemValue = ItemValue
+    { _ivInt :: Int
+    , _ivType :: ItemValueType
+    }
+data ItemValueType = MundaneItem | ArtefactItem
+
 data Targeting
     = NoTargeting
     | TargetingOnHeld
@@ -1019,3 +1026,4 @@ makeLenses ''HUDElement
 makeLenses ''SubInventory
 makeLenses ''TerminalParams
 makeLenses ''TerminalLine
+makeLenses ''ItemValue

src/Dodge/Default.hs

@@ -157,6 +157,7 @@ defaultEquipment = Item
     , _itModules = M.empty 
     , _itScope = NoScope
     , _itTargeting = NoTargeting
+    , _itValue = defaultItemValue
     }
 defaultItZoom :: ItZoom
 defaultItZoom = ItZoom 20 0.2 1
@@ -182,6 +183,7 @@ defaultConsumable = Item
     , _itModules = M.empty 
     , _itScope = NoScope
     , _itTargeting = NoTargeting
+    , _itValue = defaultItemValue
     }
 defaultApplyDamage :: [Damage] -> Creature -> (World -> World, Creature)
 defaultApplyDamage ds cr = (id, doPoisonDam $ foldl' (flip $ \d c -> snd $ applyIndividualDamage d c) cr ds')

src/Dodge/Default/Weapon.hs

@@ -106,7 +106,10 @@ defaultGun = Item
         ]
     , _itScope = NoScope
     , _itTargeting = NoTargeting
+    , _itValue = defaultItemValue
     }
+defaultItemValue :: ItemValue
+defaultItemValue = ItemValue 10 MundaneItem
 defaultCraftable :: Item
 defaultCraftable = Item 
     { _itName = "default"
@@ -128,6 +131,7 @@ defaultCraftable = Item
     , _itModules = M.empty
     , _itScope = NoScope
     , _itTargeting = NoTargeting
+    , _itValue = defaultItemValue
     }
 defItDim :: ItemDimension
 defItDim = ItemDimension

src/Dodge/Floor.hs

@@ -36,23 +36,10 @@ import System.Random
 initialAnoTree :: RandomGen g => Tree [Annotation g]
 initialAnoTree = padSucWithCorridors $ treeFromTrunk 
     [[AnoApplyInt 0 startRoom]
---    , [SpecificRoom $ sensorRoom Flaming 50]
+    , [SpecificRoom $ fmap (return . UseAll) $ tanksRoom [] []]
     , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
     , [SpecificRoom randomChallenges]
     , [AnoApplyInt 1 lasSensorTurretTest]
---    ,[ChainAnos 
---        [[SetLabel 0 $ return $ roomRectAutoLinks 200 200 
---            & rmExtPmnt ?~ triggerSwitchSPicLight (drawSwitchWire red red)
---                (anyLnkInPS 5 & psLnkRoomEff .~ (putWireStart 0 . extractRoomPos) )
---            & rmLinkEff .~ [putWireEnd 0]
---         ]
---        ,[UseLabel 0 $ return switchDoorRoom]
---        ]
---     ]
---    ,[SpecificRoom $ return $ connectRoom lasTunnel ]
---    ,[SpecificRoom $ fmap singleUseAll slowDoorRoom ]
---    ,[Corridor]
---    ,[Corridor]
 --    ,[SpecificRoom $ fmap singleUseAll roomCCrits]
 --    ,[AirlockAno]
 --    ,[Corridor]

src/Dodge/LockAndKey.hs

@@ -14,14 +14,14 @@ import Control.Monad.State
 
 lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g CombineType ) ]
 lockRoomKeyItems = 
-    --[(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] )
+    [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] )
-    [(sensorRoomRunPast Electrical, return SPARKGUN )
+    ,(sensorRoomRunPast Electrical, return SPARKGUN )
-    --,(sensorRoomRunPast Flaming, return FLAMESPITTER )
+    ,(sensorRoomRunPast Flaming, return FLAMESPITTER )
-    --,(sensorRoomRunPast Lasering, return LASGUN )
+    ,(sensorRoomRunPast Lasering, return LASGUN )
-    --,(const slowDoorRoomRunPast, return MINIGUN)
+    ,(const slowDoorRoomRunPast, return MINIGUN)
-    --,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
+    ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
-    --,(const glassLessonRunPast, takeOne [LASGUN])
+    ,(const glassLessonRunPast, takeOne [LASGUN])
-    --,(const $ lasTunnelRunPast 400, return FLATSHIELD)
+    ,(const $ lasTunnelRunPast 400, return FLATSHIELD)
     ]
 
 itemRooms :: RandomGen g => [(CombineType, State g (SubCompTree Room))]
@@ -31,7 +31,10 @@ itemRooms =
         , rc $ map makeTypeCraft [TUBE,TUBE,HARDWARE]
         ] 
       )
-    , (MINIGUN  , join $ takeOne [roomMiniIntro, minigunFakeout] )
+    , (MINIGUN  , join $ takeOne 
+        [roomMiniIntro
+        , rc $ map makeTypeCraft ([MOTOR,HARDWARE] ++ replicate 6 PIPE)
+        ] )
     , (LASGUN   , join $ takeOne 
         [rc $ map makeTypeCraft [PRISM,TRANSFORMER,PIPE]
         ]

src/Dodge/Placement/Instance/Terminal.hs

@@ -1,6 +1,8 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Placement.Instance.Terminal 
     ( putTerminal
+    , simpleTermMessage
+    , genTermMessage
     ) where
 import Dodge.Data
 import Dodge.LevelGen.Data
@@ -27,8 +29,9 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton)
     })
     $ const Nothing
   where
-    g gp pl = (gp, pl & plType . pstPutButton . btTerminalParams .~ f gp
+    g gp pl = (gp, 
-                    & plGenUpdate .~ Nothing
+        pl  & plType . pstPutButton . btTerminalParams .~ f gp
+            & plGenUpdate .~ Nothing
         )
     thebutton = Button
         { _btPict = const mempty
@@ -52,3 +55,31 @@ displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory Display
     { _termID = btid
     , _termParams = fromMaybe NoTerminalParams $ w ^? buttons . ix btid . btTerminalParams
     }
+
+simpleTermMessage :: [String] -> (GenParams -> TerminalParams)
+simpleTermMessage ss = const $ TerminalParams
+    {_termDisplayedLines = []
+    ,_termFutureLines = TerminalLineEffect 0 termsound
+        : map totermline (topflush ++ ss)
+    ,_termMaxLines = 7
+    }
+  where
+    topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]]
+    totermline s = TerminalLineDisplay 0 s white
+    termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w'
+      where
+        tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos
+
+genTermMessage :: (GenParams -> [String]) -> (GenParams -> TerminalParams)
+genTermMessage f = \gp -> TerminalParams
+    {_termDisplayedLines = []
+    ,_termFutureLines = TerminalLineEffect 0 termsound
+        : map totermline (topflush (f gp) ++ f gp)
+    ,_termMaxLines = 7
+    }
+  where
+    topflush ss = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]]
+    totermline s = TerminalLineDisplay 0 s white
+    termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w'
+      where
+        tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos

src/Dodge/PlacementSpot.hs

@@ -25,6 +25,7 @@ module Dodge.PlacementSpot
     , shiftInBy
     , resetPLUse
     , psposAddLabel
+    , shiftByV2
     ) where
 import Dodge.LevelGen.Data
 import Geometry
@@ -192,17 +193,8 @@ atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n
 shiftInBy :: Float -> (Point2,Float) -> (Point2,Float)
 shiftInBy x (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a)
 
---anyLnkInPS :: Float -- ^ amount to shift inward
+shiftByV2 :: Point2 -> (Point2,Float) -> (Point2,Float)
---    -> PlacementSpot
+shiftByV2 x (p,a) = (p +.+ rotateV a x,a)
---anyLnkInPS x = PSPos f (const id) Nothing
---  where
---    f rp _ = case _rpLinkStatus rp of
---        UnusedLink {} -> Just (PS v' a', rp & rpPlacementUse +~ 1)
---        _ -> Nothing
---      where
---        a = _rpDir rp
---        v' = _rpPos rp -.- x *.* unitVectorAtAngle (a + 0.5 * pi)
---        a' = a + pi
 
 -- this should probably check the placement use, but so should others: should
 -- unify these

src/Dodge/Room.hs

@@ -21,6 +21,7 @@ module Dodge.Room
     , module Dodge.Room.Tanks
     , module Dodge.Room.Containing
     , module Dodge.Room.SensorDoor
+    , module Dodge.Room.Ngon
     ) where
 import Dodge.Room.Room
 import Dodge.Room.RoadBlock
@@ -43,3 +44,4 @@ import Dodge.Room.GlassLesson
 import Dodge.Room.Tanks
 import Dodge.Room.Containing
 import Dodge.Room.SensorDoor
+import Dodge.Room.Ngon

src/Dodge/Room/Containing.hs

@@ -5,12 +5,15 @@ import Dodge.LevelGen.Data
 import Dodge.RandomHelp
 import Dodge.Room.Procedural
 import Dodge.Room.Tanks
+import Dodge.Room.Link
+import Dodge.Room.Ngon
+import LensHelp
+import Geometry
 --import Dodge.Item.Equipment
 
 import System.Random
 import Control.Monad.State
 
-
 roomsContaining :: RandomGen g => [Creature] -> [Item] -> State g (SubCompTree Room)
 roomsContaining crs its = do
     endroom <- join $ takeOne
@@ -18,3 +21,15 @@ roomsContaining crs its = do
         , tanksRoom crs its
         ]
     return $ treeFromPost [] $ UseAll endroom
+
+pedestalRoom :: RandomGen g => Item -> State g Room
+pedestalRoom it = do
+    let flit = PutFlIt it
+    x <- state $ randomR (150,250)
+    ngon <- state $ randomR (5,9)
+    r <- takeOne 
+        [ shuffleLinks =<< (centerVaultRoom x x 50 <&> rmPmnts .:~ sps0 flit)
+        , shuffleLinks $ roomRectAutoLinks (2*x) (2*x) & rmPmnts .:~ sPS (V2 x x) 0 flit
+        , shuffleLinks $ roomNgon ngon x & rmPmnts .:~ sps0 flit
+        ]
+    r <&> rmName .++~ "ped-"

src/Dodge/Room/Foreground.hs

@@ -93,7 +93,7 @@ girderV
     -> Float -- ^ distance between cross bars
     -> Float -- ^ width
     -> Point2 -> Point2 -> Shape
-girderV h d w x y = colorSH red $ mconcat $
+girderV h d w x y = mconcat $
     [ thinHighBar h xt yt
     , thinHighBar h xb yb
     ]

src/Dodge/Room/LasTurret.hs

@@ -5,9 +5,9 @@ import Dodge.Data
 import Dodge.Tree
 import Dodge.RoomLink
 import Dodge.Room.Door
-import Dodge.Room.Room
 import Dodge.Room.Corridor
 import Dodge.Room.Link
+import Dodge.Room.Ngon
 --import Dodge.Room.Procedural
 import Dodge.Room.Foreground
 --import Dodge.Room.RoadBlock

src/Dodge/Room/LongDoor.hs

@@ -96,8 +96,12 @@ addButtonSlowDoor x h rm = do
         & rmPmnts .++~ [butDoor , theterminal]
         & rmBound .:~ openDoorBound
   where
-    theterminal = putTerminal (const NoTerminalParams) 
+    theterminal = putTerminal (simpleTermMessage themessage)
-        & plSpot .~ rprBoolShift (\rp _ -> RoomPosLab 0 `S.member` _rpType rp) (shiftInBy 20)
+        & plSpot .~ rprBoolShift (isUnusedLnkType InLink) (shiftByV2 (V2 0 (-10)))
+    themessage = 
+        ["WARNING:"
+        ,"LARGE BIOMASS DETECTED"
+        ] ++ replicate 5 ""
     openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2)
     belowH y = (sndV2 . fst) y < h - 40
     aboveH y = (sndV2 . fst) y > h + 40
@@ -105,7 +109,8 @@ addButtonSlowDoor x h rm = do
                 (V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90)) . const . const
     -- TODO make the height of this light source and of other mounted lights
     -- be taken from a single consistent source
-    butDoor = putLitButOnPos col (psposAddLabel (RoomPosLab 0) $ rprBool $ isUnusedLnkType InLink)
+    butDoor = putLitButOnPos col 
+        (rprBool (isUnusedLnkType InLink))
         $  \btplmnt -> Just $ putDoubleDoorThen False col (cond' $ fromJust $ _plMID btplmnt) 
                             30 (V2 0 h) (V2 x h) 2
         $ \dr1 dr2 -> amountedlight dr1 50

src/Dodge/Room/Procedural.hs

@@ -22,7 +22,6 @@ import Dodge.Room.Path
 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.Data
@@ -248,13 +247,13 @@ centerVaultRoom w h d = do
             ,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 $ PutShape $ girder 70 10 10 (V2 (d-11) (-d)) (V2 (d-11) (-h))
             ]
             ++ map (\a -> mntLS vShape (rotateV a $ V2 0  d) (rotate3z a $ V3 0 (d+30) 70))
                 [0,0.5*pi,pi,1.5*pi]
             ++ concatMap (\r -> map (shiftPlacement (V2 0 0,r)) theDoor) 
                         [0,pi/2,pi,3*pi/2]
         , _rmBound  = [rectNSWE h (-h) (-w) w]
+        , _rmName = "cenVault"
         }
   where
     col = dim $ dim $ bright red

src/Dodge/Room/Room.hs

@@ -28,10 +28,8 @@ import LensHelp
 import Control.Monad.State
 --import Control.Monad.Loops
 import System.Random
-import Data.Maybe
 import Data.Tree
 import Data.Bifunctor
-import Data.List
 
 roomC :: RandomGen g => Float -> Float -> State g Room
 roomC w h = do
@@ -182,26 +180,6 @@ roomOctogon = defaultRoom
         ,( (0,40),pi)
         ]
 
-roomNgon :: Int -> Float -> Room
-roomNgon n x = defaultRoom
-    { _rmPolys = [poly]
-    , _rmLinks = map toBothLnk lnks -- muout (init lnks) ++ muin[last lnks]
-    , _rmPath  = [] -- TODO
-    , _rmPmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ const . isInLnk]
-    , _rmBound = [poly]
-    , _rmFloor = Tiled [makeTileFromPoly poly 9]
-    , _rmName = show n ++ "gon"
-    }
-  where 
-    rot = 2*pi / fromIntegral n
-    rots = map ((rot *) . fromIntegral) [0..n-1]
-    poly = mapMaybe 
-        (\(ra,rb) -> intersectLineLine' (rotateV ra bl) (rotateV ra br) (rotateV rb bl) (rotateV rb br)) 
-        $ loopPairs rots
-    bl = V2   x  x
-    br = V2 (-x) x
-    lnks = sortOn ((\(V2 a b) -> (negate b,a)) . fst) $ map (\r -> (rotateV r (V2 0 x),r)) rots
-
 allPairs :: Eq a => [a] -> [(a,a)]
 allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
 

src/Dodge/Room/SensorDoor.hs

@@ -6,15 +6,14 @@ import Dodge.Data
 import Dodge.Tree
 --import Dodge.RoomLink
 import Dodge.Room.Door
+import Dodge.Room.Ngon
 import Dodge.Room.Procedural
-import Dodge.Room.Room
 import Dodge.Room.Corridor
 import Dodge.Room.Link
 --import Dodge.Room.Procedural
 import Dodge.Room.Foreground
 --import Dodge.Room.RoadBlock
 import Dodge.Placement.Instance
-import Dodge.SoundLogic
 --import Dodge.Default.Room
 --import Dodge.Item.Weapon.BulletGuns
 --import Dodge.Item.Weapon.Utility
@@ -69,33 +68,20 @@ sensInsideDoor senseType outplid rm = rm
             thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
             <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
             <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
-        , putTerminal messagef 
+        , putTerminal (genTermMessage messagef)
             & plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
         ]
     & rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]
   where
     mtoup = map toUpper
     horline = "-----------------"
-    topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. length horline -1]]
     messagef gp = 
         let Just (pc,ds) = gp ^? sensorCoding . ix senseType
-            themessage =
+        in [horline
-                topflush ++
+           ,"SENSOR ATTRIBUTES"
-                [horline
+           ,horline
-                ,"SENSOR ATTRIBUTES"
+           ,mtoup $ show senseType
-                ,horline
+           ,"COLOR:"++ mtoup (show pc)
-                ,mtoup $ show senseType
+           ,"SHAPE:"++ mtoup (reverse . drop 10 . reverse $ show ds)
-                ,"COLOR:"++ mtoup (show pc)
+           ,horline
-                ,"SHAPE:"++ mtoup (reverse . drop 10 . reverse $ show ds)
+           ]
-                ,horline
-                ]
-        in TerminalParams
-            {_termDisplayedLines = [] --zip (replicate 7 horline) (repeat white)
-            ,_termFutureLines = TerminalLineEffect 0 termsound
-                : map totermline themessage
-            ,_termMaxLines = 7
-            }
-    totermline s = TerminalLineDisplay 0 s white
-    termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w'
-      where
-        tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos

src/Dodge/Room/Start.hs

@@ -3,7 +3,6 @@ import Dodge.Data
 import Dodge.LevelGen.Data
 --import Dodge.PlacementSpot
 import Dodge.Room.RunPast
-import Dodge.Room.Tanks
 import Dodge.Room.Containing
 import Dodge.Room.LongDoor
 --import Dodge.RoomLink
@@ -17,9 +16,7 @@ import Dodge.Room.RezBox
 import Dodge.Room.Corridor
 import Dodge.Room.Room
 import Dodge.Room.Link
-import Dodge.Room.Procedural
+import Dodge.Item.Weapon
-import Dodge.Item.Weapon.BulletGuns
-import Dodge.Item.Weapon.Utility
 import Dodge.Item.Craftable
 --import Dodge.LevelGen.Data
 --import Geometry.Data
@@ -33,15 +30,16 @@ import Control.Monad.State
 import System.Random
 --import qualified Data.IntMap.Strict as IM
 
-minigunFakeout :: RandomGen g => State g (SubCompTree Room)
+powerFakeout :: RandomGen g => State g (SubCompTree Room)
-minigunFakeout = do
+powerFakeout = do
-    rcol <- rezColor
     ncor <- state $ randomR (0,2)
-    roomwithmini <- randomiseAllLinks $ roomRectAutoLinks 150 150
+    it <- takeOne 
-        & rmPmnts .:~ plRRpt 0 (PutFlIt $ miniGunX 6)
+        [miniGunX 6
+        ,launcherX 7
+        ]
+    roomwithmini <- pedestalRoom it
     randcors <- replicateM ncor $ (fmap PassDown . shuffleLinks) corridor
-    return $ ([PassDown $ rezBox rcol
+    return $ ([PassDown door
-                ,PassDown door
                 ,PassDown roomwithmini 
                 ,PassDown door
                 ] 
@@ -52,8 +50,8 @@ minigunFakeout = do
 
 startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
 startRoom i = join $ uncurry takeOneWeighted $ unzip 
---    [ (,) (0.5::Float) $ chainUses <$> sequence [minigunFakeout,weaponRoom]
+    [ (,) (0.5::Float) $ chainUses <$> sequence [powerFakeout,weaponRoom]
-    [ (,) one rezBoxesWp
+    , (,) one rezBoxesWp
     , (,) one rezBoxesThenWeaponRoom
     , (,) 1 rezBoxThenWeaponRoom
     , (,) one rezBoxesWpCrit
@@ -106,11 +104,3 @@ startCrafts = takeOne $ map (map makeTypeCraft)
     [ [PIPE,PIPE,HARDWARE]
     , [TUBE,PIPE,HARDWARE]
     ]
-
-startRoom' :: RandomGen g => State g (SubCompTree Room)
-startRoom' = do
-    scrafts <- startCrafts
-    troom <- tanksRoom [] scrafts
-    thecol <- rezColor
-    treeFromPost [PassDown $ rezBox thecol, PassDown door] . UseAll 
-        <$> shuffleLinks troom

src/Dodge/Room/Tanks.hs

@@ -10,9 +10,9 @@ import Dodge.Placement.TopDecoration
 import Dodge.PlacementSpot
 --import Padding
 import Color
---import Shape
+import Shape
 import LensHelp
---import Geometry
+import Geometry
 
 --import Data.Maybe
 --import Data.Tree
@@ -29,6 +29,29 @@ randomTank = takeOne $ map (\f -> f (dim orange) orange)
     , roundTankCross
     , tankSquareDec plusDecoration
     ]
+addGirderNS :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
+addGirderNS shapef col room = do
+    let nwestlnks = length $ filter ((OnEdge North `S.member`) . _rlType) $ _rmLinks room
+    girderPosOrder <- shuffle [1 .. nwestlnks - 2]
+    return $ room & rmPmnts .:~ foldr1 setFallback 
+        (sps0 PutNothing : [ twoRoomPoss 
+            (isUnusedLnkType (FromWest i)) 
+            (isUnusedLnkType (FromWest i)) 
+            $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) 
+       | i <- girderPosOrder]
+        )
+addGirderEW :: RandomGen g => (Point2 -> Point2 -> Shape) -> Color -> Room -> State g Room
+addGirderEW shapef col room = do
+    let nwestlnks = length $ filter ((OnEdge West `S.member`) . _rlType) $ _rmLinks room
+    girderPosOrder <- shuffle [1 .. nwestlnks - 2]
+    return $ room & rmPmnts .:~ foldr1 setFallback 
+        (sps0 PutNothing :
+        [ twoRoomPoss
+            (isUnusedLnkType (FromSouth i)) 
+            (isUnusedLnkType (FromSouth i)) 
+            $ \ps1 ps2 -> sps0 $ PutShape $ colorSH col $ shapef (_psPos ps1) (_psPos ps2) 
+       | i <- girderPosOrder]
+        )
 
 tanksRoom :: RandomGen g => [Creature] -> [Item] -> State g Room
 tanksRoom crs its = do
@@ -37,17 +60,19 @@ tanksRoom crs its = do
     ntanks  <- state $ randomR (3,6)
     thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50
     let room = roomRectAutoLinks w h
-        nwestlnks = length $ filter ((OnEdge West `S.member`) . _rlType) $ _rmLinks room
-    girderPosOrder <- shuffle [1 .. nwestlnks - 2]
     let plmnts = 
-            --ok, this has become complicated
+            map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its
-            foldr1 setFallback [ twoRoomPoss (isUnusedLnkType (FromSouth i)) 
-                (isUnusedLnkType (FromSouth i)) $ \ps1 ps2 ->
-                sps0 $ PutShape $ girderV 96 20 10 (_psPos ps1) (_psPos ps2) 
-                | i <- girderPosOrder]
-            : map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its
             ++ map (\cr -> sps0 (PutCrit cr) & plSpot .~ unusedSpotAwayFromLink 50) crs
             ++ replicate ntanks thetank
 --            , sps0 $ PutShape $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
-    return $ room & rmPmnts .++~ plmnts
+    hgshape <- takeOne [girder 96 20 10, girderZ 96 20 10, girderV 96 20 10]
+    addhighgirds <- takeOne $
+        [ addGirderEW hgshape black >=> addGirderEW hgshape black
+        , addGirderEW hgshape black
+        , addGirderNS hgshape black >=> addGirderNS hgshape black
+        , addGirderNS hgshape black
+        ] ++ replicate 4 return
+    lgshape <- takeOne [girder 60 20 10, girderZ 60 20 10, girderV 60 20 10]
+    addlowgirds  <- takeOne $ addGirderNS lgshape red : replicate 4 return
+    (addlowgirds >=> addhighgirds) $ room & rmPmnts .++~ plmnts
         & rmName .~ "tanksRoom"