justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add more procedural girders

Browse Source
This commit is contained in:
justin
2022-03-16 18:02:17 +00:00
parent 6e05756ed3
commit 58a24c58e3
18 changed files with 150 additions and 123 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine/Combinations.hs
+1 -1
View File
@@ -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
+8
View File
@@ -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
+2
View File
@@ -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
+4
View File
@@ -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
+1 -14
View File
@@ -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
+12 -9
View File
@@ -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] )
[(sensorRoomRunPast Electrical, return SPARKGUN )
--,(sensorRoomRunPast Flaming, return FLAMESPITTER )
--,(sensorRoomRunPast Lasering, return LASGUN )
--,(const slowDoorRoomRunPast, return MINIGUN)
--,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
--,(const glassLessonRunPast, takeOne [LASGUN])
--,(const $ lasTunnelRunPast 400, return FLATSHIELD)
[(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] )
,(sensorRoomRunPast Electrical, return SPARKGUN )
,(sensorRoomRunPast Flaming, return FLAMESPITTER )
,(sensorRoomRunPast Lasering, return LASGUN )
,(const slowDoorRoomRunPast, return MINIGUN)
,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
,(const glassLessonRunPast, takeOne [LASGUN])
,(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
+33 -2
View File
@@ -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
& plGenUpdate .~ Nothing
g gp pl = (gp,
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
+3 -11
View File
@@ -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
-- -> PlacementSpot
--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
shiftByV2 :: Point2 -> (Point2,Float) -> (Point2,Float)
shiftByV2 x (p,a) = (p +.+ rotateV a x,a)
-- this should probably check the placement use, but so should others: should
-- unify these
src/Dodge/Room.hs
+2
View File
@@ -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
+16 -1
View File
@@ -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
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
+8 -3
View File
@@ -96,8 +96,12 @@ addButtonSlowDoor x h rm = do
& rmPmnts .++~ [butDoor , theterminal]
& rmBound .:~ openDoorBound
where
theterminal = putTerminal (const NoTerminalParams)
& plSpot .~ rprBoolShift (\rp _ -> RoomPosLab 0 `S.member` _rpType rp) (shiftInBy 20)
theterminal = putTerminal (simpleTermMessage themessage)
& 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
+1 -2
View File
@@ -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
-22
View File
@@ -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
+10 -24
View File
@@ -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 =
topflush ++
[horline
,"SENSOR ATTRIBUTES"
,horline
,mtoup $ show senseType
,"COLOR:"++ mtoup (show pc)
,"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
in [horline
,"SENSOR ATTRIBUTES"
,horline
,mtoup $ show senseType
,"COLOR:"++ mtoup (show pc)
,"SHAPE:"++ mtoup (reverse . drop 10 . reverse $ show ds)
,horline
]
src/Dodge/Room/Start.hs
+11 -21
View File
@@ -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.BulletGuns
import Dodge.Item.Weapon.Utility
import Dodge.Item.Weapon
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)
minigunFakeout = do
rcol <- rezColor
powerFakeout :: RandomGen g => State g (SubCompTree Room)
powerFakeout = do
ncor <- state $ randomR (0,2)
roomwithmini <- randomiseAllLinks $ roomRectAutoLinks 150 150
& rmPmnts .:~ plRRpt 0 (PutFlIt $ miniGunX 6)
it <- takeOne
[miniGunX 6
,launcherX 7
]
roomwithmini <- pedestalRoom it
randcors <- replicateM ncor $ (fmap PassDown . shuffleLinks) corridor
return $ ([PassDown $ rezBox rcol
,PassDown door
return $ ([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]
[ (,) one rezBoxesWp
[ (,) (0.5::Float) $ chainUses <$> sequence [powerFakeout,weaponRoom]
, (,) 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
+36 -11
View File
@@ -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
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 (\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"