Commit before generalising FromWest/South etc

src/Dodge/Room/Room.hs

@@ -1,6 +1,11 @@
 --{-# LANGUAGE TupleSections #-}
-module Dodge.Room.Room where
-import Data.Tile
+module Dodge.Room.Room 
+    ( shootingRange
+    , weaponRoom
+    , roomMiniIntro
+    , roomCCrits
+    , doubleCorridorBarrels
+    ) where
 import Dodge.UseAll
 import Dodge.Data
 import Dodge.PlacementSpot
@@ -9,6 +14,7 @@ import Dodge.Default.Room
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Creature
 import Dodge.Room.Pillar
+import Dodge.Room.Girder
 import Dodge.Room.Modify.Girder
 import Dodge.LevelGen.Data
 import RandomHelp
@@ -18,18 +24,16 @@ import Dodge.Placement.Instance
 --import Dodge.LevelGen.Data
 import Dodge.Room.Procedural
 import Dodge.Room.Corridor
+import Dodge.Room.Tanks
 import Dodge.Room.Link
 import Dodge.Room.Door
 import Dodge.Room.Airlock
 import Geometry
-import Tile
 import MonadHelp
 import LensHelp
 --import Color
 
 import qualified Data.Set as S
---import Control.Monad.Loops
-import Data.Bifunctor
 
 roomC :: RandomGen g => Float -> Float -> State g Room
 roomC w h = do
@@ -37,12 +41,18 @@ roomC w h = do
             [ sPS (V2 0 0) 0 $ PutWall (rectNSWE (h-60) 0 (w/2-10) (w/2+10)) defaultCrystalWall
             , windowLine (V2 (w/2) 0) (V2 (w/2) (h-60))
             ]
-    shuffleLinks $ roomRectAutoLinks w h
-        & restrictOutLinks fromCond 
-        & rmPmnts .:~ wl
+    ntanks <- takeOne [0,0,0,0,0,1,1,1,1,2,3,4]
+    thetank <- randomTank <&> plSpot .~ unusedOffPathAwayFromLink 50
+    maybeaddgird <- takeOne [return, addRandomGirderFromWest 0, addRandomGirderFrom North 0]
+    maybeaddgird =<< (shuffleLinks $ roomRectAutoLinks w h
+        & rmLinks %~ 
+            ( (setInLinks (\rl -> S.fromList [FromEast 0,OnEdge South] `S.isSubsetOf` _rlType rl))
+            . (setOutLinks (\rl -> OnEdge West `S.member` _rlType rl))
+            )
+        & rmPmnts .++~ (wl : replicate ntanks thetank)
         & rmRandPSs .~ [farside]
+        )
   where
-    fromCond (V2 x _,_) = x < w / 2 - 10
     farside = do
         x <- state $ randomR (5, w/2 - 20)
         y <- state $ randomR (5, h - 70)
@@ -59,10 +69,6 @@ roomPadCut ps p = defaultRoom
 branchWith :: Room -> [Tree Room] -> Tree Room
 branchWith r ts = Node r $ return (cleatOnward door) : ts
 
-
-manyDoors :: Int -> Tree Room
-manyDoors i = treeFromPost (replicate i door) $ cleatOnward door
-
 glassSwitchBack :: RandomGen g => State g Room
 glassSwitchBack = do
     wth <- state $ randomR (200,400)
@@ -103,23 +109,6 @@ miniTree2 = do
     rm <- glassSwitchBackCrits >>= shuffleLinks . restrictInLinks (\p -> (sndV2 . fst) p < 70)
     return $ branchWith rm (replicate 3 $ treePost [door,corridor,critInDeadEnd])
 
-miniRoom3 :: RandomGen g => State g (Tree Room)
-miniRoom3 = do
-    w <- state $ randomR (300,400)
-    h <- state $ randomR (300,400)
-    let cp = V2 0 (h/2+40)
-    let b = PutBlock StoneBlock 5 [20,20] baseBlockPane $ rectNSEW 10 (-10) (-60) (-80)
-                -- baseBlockPlane might need a reverse...
-    let plmnts = concatMap 
-            (\i -> [ sPS cp (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
-                , sPS cp (pi/8+fromIntegral i*pi/4) b]
-            ) [0..7::Int]
-            ++ [ sPS cp 0 $ PutCrit miniGunCrit , sPS (V2 (w/2) (h/2)) 0 putLamp ]
-    pure <$> shuffleLinks (cleatOnward $ set rmPmnts plmnts $ roomRectAutoLinks w h)
-
-rot90Around :: Point2 -> Point2 -> Point2
-rot90Around cen p = cen +.+ vNormal (p -.- cen)
-
 -- So, the idea is to attach outer children to the bottommost right nodes
 -- inside an inner tree
 -- no idea what was going on here...
@@ -142,31 +131,6 @@ roomCenterPillar = shuffleLinks . restrictInLinks ((\p -> dist p (V2 120 0) < 10
         , mntLightLnkCond (resetPLUse $ rprBool $ \rp _ -> isInLnk rp)       
         ]
 
-roomOctogon :: Room
-roomOctogon = defaultRoom
-    { _rmPolys = [poly ]
-    , _rmLinks = muout (init lnks) ++ muin [last lnks]
-    , _rmPath  = allPairs $ map fst lnks -- this is too much
-    , _rmPmnts = []
-    , _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ]
-    , _rmFloor = Tiled [makeTileFromPoly poly 7]
-    }
-  where 
-    poly = map toV2 [(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)]
-    lnks = map (first toV2)
-        [((0,140),0)
-        ,((35,125),negate $ pi/4)
-        ,((-35,125),pi/4)
-        ,( (50,90),negate $ pi/2)
-        ,( (-50,90),pi/2)
-        ,((35,55),negate $ 3*pi/4)
-        ,((-35,55),3*pi/4)
-        ,( (0,40),pi)
-        ]
-
-allPairs :: Eq a => [a] -> [(a,a)]
-allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
-
 {- Probabilites of the type of the first floor weapon.  -}
 randFirstWeapon :: State StdGen PSType
 randFirstWeapon = do
@@ -287,9 +251,9 @@ weaponRoom i = join $ takeOne
     , weaponLongCorridor    >>= rToOnward "weaponLongCorridor"
     ]
 
-roomCCrits :: RandomGen g => State g Room
-roomCCrits = roomC 200 200
-    <&> rmPmnts %~ (replicate 20 (spNoID (PSRoomRand 0 (uncurry PS)) randC1) ++ )
+roomCCrits :: RandomGen g => Int -> State g Room
+roomCCrits i = roomC 200 200
+    <&> rmPmnts .++~ replicate i (spNoID (PSRoomRand 0 (uncurry PS)) randC1)
 
 doubleCorridorBarrels :: RandomGen g => State g Room
 doubleCorridorBarrels = do
@@ -297,13 +261,11 @@ doubleCorridorBarrels = do
     let cond x = (sndV2 . fst) x < h - 40
     return $ restrictInLinks cond $ roomRect 100 h 1 1 & rmPmnts .~
         [blockLine (V2 50 50) (V2 50 h)
-        ,sPS (V2 25 (h-25)) 0 $ PutCrit $ addArmour autoCrit
-        ,sPS (V2 75 (h-30)) 0 $ PutCrit explosiveBarrel
-        ,sPS (V2 75 (h-60)) 0 $ PutCrit explosiveBarrel
-        ,sPS (V2 85 (h-10)) 0 $ PutCrit explosiveBarrel
-        ,sPS (V2 85 (h-45)) 0 $ PutCrit explosiveBarrel
+        ,sPS (V2 25 (h-25)) (negate pi/2) $ PutCrit $ addArmour autoCrit
         ,sPS (V2 75 (h-80)) 0 putLamp
-        ]
+        ] ++
+        [sPS p 0 $ PutCrit explosiveBarrel
+            | p <- [ V2 75 (h-30) ,V2 75 (h-60) ,V2 85 (h-10) ,V2 85 (h-45) ]   ]
 
 shootersRoom' :: RandomGen g => State g Room
 shootersRoom' = do