Improve rooms

src/Dodge/LevelGen.hs

@@ -31,6 +31,9 @@ layoutLevelFromSeed i seed = do
     let rmtree = inorderNumberTree $ evalState initialRoomTree g
     putStrLn "Abstract layout: "
     putStrLn $ compactDrawTree $ fmap (show . snd) rmtree
+    let nameshow (r,rid) = _rmName r ++ "-" ++ show rid
+    writeFile "aGeneratedRoomLayout" $ drawTree $ fmap nameshow rmtree
+    putStrLn "Layout with room names written to aGeneratedRoomLayout"
     mrs <- positionRoomsFromTree rmtree
     case mrs of
         Just rs -> do

src/Dodge/Placement/Instance/Wall.hs

@@ -152,6 +152,18 @@ subZipWith f g xs ys =
 isPutID :: Int -> Placement -> Bool
 isPutID i ps = Just i == ps ^? plType . putID
 
+putBlockRect' :: Float -> Float -> Placement
+putBlockRect' w h = ps0jPushPS (aline tl tr)
+    $ ps0jPushPS (aline tr br)
+    $ ps0jPushPS (aline br bl)
+    $ sps0 (aline bl tl)
+  where
+    tl = V2 (-w) h
+    tr = V2 w h
+    br = V2 w (-h)
+    bl = V2 (-w) (-h)
+    aline = PutLineBlock baseBlockPane StoneBlock 9 9
+
 putBlockRect :: Float -> Float -> Float -> Float -> [Placement]
 putBlockRect a x b y =
     [ blockLine (V2 a b) (V2 a y)

src/Dodge/PlacementSpot.hs

@@ -26,6 +26,8 @@ module Dodge.PlacementSpot
     , resetPLUse
     , psposAddLabel
     , shiftByV2
+    , usedRoomLinkPoss
+    , usedRoomInLinkPoss
     ) where
 import Dodge.LevelGen.Data
 import Geometry

src/Dodge/Room.hs

@@ -22,6 +22,7 @@ module Dodge.Room
     , module Dodge.Room.Containing
     , module Dodge.Room.SensorDoor
     , module Dodge.Room.Ngon
+    , module Dodge.Room.Pillar
     ) where
 import Dodge.Room.Room
 import Dodge.Room.RoadBlock
@@ -45,3 +46,4 @@ import Dodge.Room.Tanks
 import Dodge.Room.Containing
 import Dodge.Room.SensorDoor
 import Dodge.Room.Ngon
+import Dodge.Room.Pillar

src/Dodge/Room/Room.hs

@@ -7,7 +7,8 @@ import Dodge.Default.Room
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Weapon.Launcher
 import Dodge.Creature
-import Dodge.Room.Foreground
+import Dodge.Room.Pillar
+import Dodge.Room.Modify.Girder
 import Dodge.LevelGen.Data
 import Dodge.RandomHelp
 import Dodge.Default.Wall
@@ -23,8 +24,9 @@ import Geometry
 import Tile
 import MonadHelp
 import LensHelp
+--import Color
 
---import qualified Data.Set as S
+import qualified Data.Set as S
 import Control.Monad.State
 --import Control.Monad.Loops
 import System.Random
@@ -54,18 +56,6 @@ roomPadCut ps p = defaultRoom
     , _rmLinks = muout [(p,0)] ++ muin [(V2 0 0,pi)]
     , _rmPath  = [(V2 0 0,p)]
     }
-roomPillars :: Room
-roomPillars = roomRect 240 240 2 2
-    & rmPmnts .~ plmnts
-  where 
-    plmnts = spanLightI (V2 120 24) (V2 120 216) 
-        : mntLS vShape (V2 12 12) (V3 25 25 70)
-        : mntLS vShape (V2 228 228) (V3 215 215 70)
-        : sps0 (PutShape $ thinHighBar 75 (V2 26 25) (V2 120 25))
-        : sps0 (PutShape $ thinHighBar 75 (V2 214 215) (V2 120 215))
-        : g 180 150 90 60
-    f a x b y = putBlockRect a x b y
-    g a b c d = f a b a b ++ f a b c d ++ f c d a b ++ f c d c d
 
 branchWith :: Room -> [Tree Room] -> SubCompTree Room
 branchWith r ts = Node (PassDown r) $ return (UseAll door) : fmap (fmap PassDown) ts
@@ -74,7 +64,6 @@ branchWith r ts = Node (PassDown r) $ return (UseAll door) : fmap (fmap PassDown
 manyDoors :: Int -> SubCompTree Room
 manyDoors i = treeFromPost (replicate i (PassDown door)) $ UseAll door
 
-
 glassSwitchBack :: RandomGen g => State g Room
 glassSwitchBack = do
     wth <- state $ randomR (200,400)
@@ -102,6 +91,7 @@ glassSwitchBack = do
     return $ roomRect wth hgt 2 4
         & rmPmnts .~ plmnts
         & rmRandPSs .~ [northPSs,midPS]
+        & rmName .~ "glassSwitchBack"
 
 glassSwitchBackCrits :: RandomGen g => State g Room
 glassSwitchBackCrits = glassSwitchBack 
@@ -143,7 +133,7 @@ rot90Around cen p = cen +.+ vNormal (p -.- cen)
 roomMiniIntro :: RandomGen g => State g (SubCompTree Room)
 roomMiniIntro = do
     midroom <- join $ takeOne [miniTree2] --,glassLesson]
-    return $ chainUses [return $ UseAll door, midroom,return $ UseAll corridor]
+    return $ chainUses [return $ UseAll corridor,return $ UseAll corridor,return $ UseAll corridor,return $ UseAll door, midroom,return $ UseAll corridor]
 
 roomCenterPillar :: RandomGen g => State g Room
 roomCenterPillar = randomiseAllLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10) . fst) 
@@ -206,7 +196,8 @@ weaponEmptyRoom = do
             ,mntLightLnkCond useUnusedLnk
             ]
         f (V2 x y,a) = (a == pi && x > 25 && x < w - 25) || (a /= 0 && y > w - 30)
-    rm <- shuffleLinks $ restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts)
+    rm <- addHighGirder >=> shuffleLinks 
+        $ restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts)
     return $ treeFromTrunk [PassDown corridor] (singleUseAll rm )
      
 weaponUnderCrits :: RandomGen g => State g (SubCompTree Room)
@@ -222,7 +213,7 @@ weaponUnderCrits = do
             (singleUseAll (set rmPmnts plmnts corridorN))
     rcp <- roomCenterPillar
     deadEndRoom' <- takeOne 
-        [ addwpat (V2 120 20) roomPillars
+        [ addwpat (V2 120 20) (roomPillars 0 240 240 2 2)
         , addwpat (V2 120 20) rcp]
     junctionRoom <- takeOne [PassDown tEast,PassDown tWest]
     return $ treeFromTrunk [PassDown corridorN,PassDown corridorN] 
@@ -251,10 +242,21 @@ weaponBehindPillar  = do
 
 weaponBetweenPillars :: RandomGen g => State g (SubCompTree Room)
 weaponBetweenPillars = do
-    let wpPos = unusedSpotNearInLink 100
+    w <- state $ randomR (240,360)
+    h <- state $ randomR (240,360)
+    let wpPos = rprBool $ \rp r -> and 
+            [ RoomPosOnPath `S.member` _rpType rp
+            , _rpPlacementUse rp == 0
+            , _rpLinkStatus rp == NotLink
+            , any ((<100) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
+            ]
     ncrits <- state $ randomR (1,3)
-    critPlacementSpots <- replicateM ncrits $ randDirPS $ unusedSpotAwayFromInLink 100
+    critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r -> and 
-    let theRoom = roomPillars & rmPmnts .++~
+            [ RoomPosOnPath `S.member` _rpType rp
+            , _rpPlacementUse rp == 0
+            , all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
+            ]
+    let theRoom = roomPillars 0 w h 1 1 & rmPmnts .++~
             sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots
     return $ singleUseAll theRoom
 
@@ -290,11 +292,11 @@ deadEndRoom = defaultRoom
 {- A random Either tree with a weapon and melee monster challenge.  -}
 weaponRoom :: RandomGen g => State g (SubCompTree Room)
 weaponRoom = join $ takeOne 
-    [ weaponEmptyRoom
+--    [ weaponEmptyRoom
-    , weaponUnderCrits
+--    , weaponUnderCrits
-    , weaponBehindPillar
+--    , weaponBehindPillar
-    , weaponBetweenPillars
+    [ weaponBetweenPillars
-    , weaponLongCorridor
+--    , weaponLongCorridor
     ]
 
 roomCCrits :: RandomGen g => State g Room

src/Dodge/Room/Start.hs

@@ -50,13 +50,13 @@ powerFakeout = do
 
 startRoom :: RandomGen g => Int -> State g (SubCompTree Room)
 startRoom i = join $ uncurry takeOneWeighted $ unzip 
-    [ (,) (0.5::Float) $ chainUses <$> sequence [powerFakeout,weaponRoom]
+--    [ (,) (0.5::Float) $ chainUses <$> sequence [powerFakeout,weaponRoom]
-    , (,) one rezBoxesWp
+--    , (,) one rezBoxesWp
-    , (,) one rezBoxesThenWeaponRoom
+--    , (,) one rezBoxesThenWeaponRoom
-    , (,) 1 rezBoxThenWeaponRoom
+    [ (,) one rezBoxThenWeaponRoom
-    , (,) one rezBoxesWpCrit
+--    , (,) one rezBoxesWpCrit
-    , (,) 1 $ runPastStart i
+--    , (,) 1 $ runPastStart i
-    , (,) 5 $ startCrafts >>= roomsContaining [] >>= rezBoxThenRooms
+--    , (,) 1 $ startCrafts >>= roomsContaining [] >>= rezBoxThenRooms
     ]
   where
     one = 1::Float

src/Dodge/Room/Tanks.hs

@@ -4,21 +4,22 @@ import Dodge.LevelGen.Data
 import Dodge.RandomHelp
 import Dodge.Room.Procedural
 import Dodge.Room.Foreground
+import Dodge.Room.Modify.Girder
 --import Dodge.Room.RoadBlock
 import Dodge.Placement.Instance
 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
 import Control.Monad.State
 import System.Random
-import qualified Data.Set as S
+--import qualified Data.Set as S
 
 randomTank :: RandomGen g => State g Placement
 randomTank = takeOne $ map (\f -> f (dim orange) orange)
@@ -29,29 +30,6 @@ 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