module Dodge.Room.Room where
import Dodge.Data
import Dodge.PlacementSpot
import Dodge.RoomLink
import Dodge.Default.Room
import Dodge.Item.Weapon.BulletGuns
import Dodge.Item.Weapon.Launcher
import Dodge.Creature
import Dodge.Room.Foreground
import Dodge.LevelGen.Data
import Dodge.RandomHelp
import Dodge.Default.Wall
import Dodge.Tree
import Dodge.Placement.Instance
--import Dodge.LevelGen.Data
import Dodge.Room.Procedural
import Dodge.Room.Corridor
import Dodge.Room.Link
import Dodge.Room.Door
import Dodge.Room.Airlock
import Geometry
import Tile

import Control.Lens
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
    wl <- takeOne 
            [ 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))
            ]
    changeLinkFrom fromCond $ roomRectAutoLinks w h
        & rmPmnts %~ (wl : )
        & 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)
        a <- state $ randomR (0, 2*pi)
        return (V2 x y,a)

roomPadCut :: [Point2] -> Point2 -> Room
roomPadCut ps p = defaultRoom
    { _rmPolys = [ps]
    , _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


manyDoors :: Int -> SubCompTree Room
manyDoors i = treeFromPost (replicate i (PassDown door)) $ UseAll door

-- TODO: partially combine a room tree into a room
glassLesson :: RandomGen g => State g (SubCompTree Room)
glassLesson = do
    i <- takeOne [1,2,3]
    corridors <- replicateM i $ PassDown <$> randomiseOutLinks corridor
    return $ Node (PassDown botRoom) [singleUseNone door,uppers, treeFromPost (PassDown door : corridors) $ UseAll door]
  where 
    uppers = Node (PassDown door) [singleUseNone topRoom]
    botRoom = set rmPmnts botplmnts $ roomRect 200 200 1 1
    topRoom = set rmPmnts topplmnts $ roomRect 200 200 1 1
    botplmnts = 
        [sPS    (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
        ,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
        ,RandomPlacement $ takeOne
            [ spanLightI (V2 160 0) (V2 160 220)
            , mntLS vShape (V2 180 200) (V3 160 180 50)
            ]
        ]
    topplmnts = 
        [windowLine (V2 100 200) (V2 100 0) 
        ,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
        --,sPS (V2 50 50) 0 putLamp
        ,RandomPlacement $ takeOne
            [ spanLightI (V2 160 (-20)) (V2 160 220)
            , mntLS vShape (V2 180 200) (V3 160 180 50)
            ]
        ]

glassSwitchBack :: RandomGen g => State g Room
glassSwitchBack = do
    wth <- state $ randomR (200,400)
    hgt <- state $ randomR (400,600)
    wllen <- state $ randomR (60,wth/2-40)
    let hf = hgt/5
        con1 cond (UnusedLink (V2 x y) a) _ | cond y = Just (PS (V2 x y) a , UsedSpot (V2 x y) a)
        con1 _ _ _ = Nothing
        plmnts = 
            [ mntLightLnkCond $ con1 (< 0.5 * hgt)
            , mntLightLnkCond $ con1 (> 0.5 * hgt)
            ,windowLine (V2 (wth-60   )    hf ) (V2 wllen  hf   )
            ,windowLine (V2 (wth-wllen) (2*hf)) (V2 60    (2*hf))
            ,windowLine (V2 (wth-60   ) (3*hf)) (V2 wllen (3*hf))
            ,windowLine (V2 (wth-wllen) (4*hf)) (V2 60    (4*hf))
            ,blockLine (V2          0  (1*hf)) (V2 wllen (1*hf))
            ,blockLine (V2 (wth-wllen) (2*hf)) (V2   wth (2*hf))
            ,blockLine (V2          0  (3*hf)) (V2 wllen (3*hf))
            ,blockLine (V2 (wth-wllen) (4*hf)) (V2   wth (4*hf))
            , sPS (V2 (wth/2) (hgt/2)) 0 putLamp
            ]
    let northPSs = do
            cry <- randomRanges [3*hf+10,4*hf-10
                                ,4*hf+10,5*hf-10
                                ]
            crx <- state $ randomR (wllen,wth-(wllen+40))
            return (V2 crx cry,1.5*pi)
        midPS = return (V2 (wth-20) (hgt/2+40), pi)
    return $ roomRect wth hgt 2 4
        & rmPmnts .~ plmnts
        & rmRandPSs .~ [northPSs,midPS]

glassSwitchBackCrits :: RandomGen g => State g Room
glassSwitchBackCrits = glassSwitchBack 
    <&> rmPmnts %~ ([spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit miniGunCrit)
                , spNoID (PSRoomRand 1 (uncurry PS)) randC1
                ] ++)

miniTree2 :: RandomGen g => State g (SubCompTree Room)
miniTree2 = glassSwitchBackCrits 
    >>= randomiseOutLinks 
    >>= changeLinkTo (\p -> (sndV2 . fst) p < 70) 
    <&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)

miniRoom3 :: RandomGen g => State g (SubCompTree 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 $ map toV2 [(-10,-60) 
                                               ,( 10,-60) 
                                               ,( 10,-80) 
                                               ,(-10,-80) 
                                               ]
        let plmnts = [sPS cp 0 $ PutCrit miniGunCrit
                     ,sPS cp 0        $ windowLineType (V2 0 (-40)) (V2 0 (-80))
                     ,sPS cp (1*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
                     ,sPS cp (2*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
                     ,sPS cp (3*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
                     ,sPS cp (4*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
                     ,sPS cp (5*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
                     ,sPS cp (6*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
                     ,sPS cp (7*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
                     ,sPS cp (pi/8)  b
                     ,sPS cp (pi/8+1*pi/4) b
                     ,sPS cp (pi/8+2*pi/4) b
                     ,sPS cp (pi/8+3*pi/4) b
                     ,sPS cp (pi/8+4*pi/4) b
                     ,sPS cp (pi/8+5*pi/4) b
                     ,sPS cp (pi/8+6*pi/4) b
                     ,sPS cp (pi/8+7*pi/4) b
                     ,sPS (V2 (w/2) (h/2)) 0 putLamp
                     ]
        fmap singleUseAll $ randomiseOutLinks $ 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
roomMiniIntro :: RandomGen g => State g (SubCompTree Room)
roomMiniIntro = do
    midroom <- join $ takeOne [miniTree2] --,glassLesson]
    return $ chainUses [return $ UseAll door, midroom,return $ UseAll corridor]

roomCenterPillar :: RandomGen g => State g Room
roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst) 
    $ set rmPmnts plmnts $ roomRect 240 240 2 2
  where 
    plmnts = 
        [ blockLine (V2 115 115) (V2 115 125)
        , blockLine (V2 125 115) (V2 125 125)
        --, sPS (V2 40 120) 0 putLamp
        --, sPS (V2 200 120) 0 putLamp
        , mntLightLnkCond unusedLnkToPS
        , mntLightLnkCond unusedLnkToPS
        ]

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 = [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)
        ]

roomNgon :: Int -> Float -> Room
roomNgon n x = defaultRoom
    { _rmPolys = [poly]
    , _rmLinks = muout (init lnks) ++ muin[last lnks]
    , _rmPath  = [] -- TODO
    , _rmPmnts = []
    , _rmBound = [poly]
    , _rmFloor = [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]

{- Probabilites of the type of the first floor weapon.  -}
randFirstWeapon :: State StdGen PSType
randFirstWeapon = do
    takeOne $ map PutFlIt $
        replicate 10 pistol
        ++ replicate 5 ltAutoGun
        ++ replicate 5 spreadGun
        ++ replicate 5 multGun
        ++ replicate 2 autoGun
        ++ [launcher]

weaponEmptyRoom :: RandomGen g => State g (SubCompTree Room)
weaponEmptyRoom = do
    w <- state $ randomR (220,300)
    h <- state $ randomR (220,300)
    let plmnts = 
            [sPS (V2 (w/2) (h-40))     0 $ RandPS randFirstWeapon
            ,sPS   (V2 20 20) (pi/2) randC1
            ,sPS (V2 (w-20) 20) (pi/2) randC1
            --,sPS (V2 (w/2) (h/2))      0 putLamp
            ,mntLightLnkCond unusedLnkToPS
            ]
        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)
    return $ treeFromTrunk [PassDown corridor] (singleUseAll rm )
     
weaponUnderCrits :: RandomGen g => State g (SubCompTree Room)
weaponUnderCrits = do
    let plmnts = 
            [--sPS (V2 20 0)   0 $ RandPS randFirstWeapon
            sPS (V2 20 0)  (negate $ pi/2) randC1
            ,sPS (V2 20 20) (negate $ pi/2) randC1
            ]
        addwpat p = rmPmnts %~ ((PickOnePlacement 0 $ sPS p 0 $ RandPS randFirstWeapon) :)
    let continuationRoom = treeFromTrunk 
            [PassDown $ addwpat (V2 20 0) corridorN,PassDown $ addwpat (V2 20 0) corridorN] 
            (singleUseAll (set rmPmnts plmnts corridorN))
    rcp <- roomCenterPillar
    deadEndRoom' <- takeOne 
        [ addwpat (V2 120 20) roomPillars
        , addwpat (V2 120 20) rcp]
    junctionRoom <- takeOne [PassDown tEast,PassDown tWest]
    return $ treeFromTrunk [PassDown corridorN,PassDown corridorN] 
                       $ Node junctionRoom
                              [continuationRoom
                              ,singleUseNone deadEndRoom'
                              ]

weaponBehindPillar :: RandomGen g => State g (SubCompTree Room)
weaponBehindPillar  = do
    wpa  <- state $ randomR (0,pi)
    wpos <- takeOne [V2 120 160,V2 80 40,V2 160 40,V2 220 200,V2 40 200,V2 120 35]
    cpos <- takeOne $ [V2 x y | x <- [20,220], y <- [20,40]] ++ [V2 120 160,V2 120 200]
    let d p = argV $ V2 120 80 -.- p
    let plmnts1 = 
          [sPS wpos wpa $ RandPS randFirstWeapon
          ,sPS cpos (d cpos) randC1
          ]
    rcp <- roomCenterPillar
    return $ treeFromTrunk 
      [PassDown corridor
      --,PassDown $ over rmOutLinks tail $ over rmPmnts (++ plmnts1) rcp
      ,PassDown $ over rmPmnts (++ plmnts1) rcp
      ]
      (singleUseAll $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)

weaponBetweenPillars :: RandomGen g => State g (SubCompTree Room)
weaponBetweenPillars = do
    wpPos <- takeOne [V2 x y | x <- [20,120,220], y <- [20,120,220]]
    critPlacementSpots <- replicateM 2 $ randDirPS $ unusedSpotAwayFromInLink 100
    let plmnts = 
            sPS wpPos 0 (RandPS randFirstWeapon) :
            map (`sps` randC1) critPlacementSpots
        theRoom = roomPillars & rmPmnts %~ (++ plmnts)
    (fmap singleUseAll . randomiseOutLinks) =<< filterLinks f theRoom
  where 
    f (_,a) = a == 0

weaponLongCorridor :: RandomGen g => State g (SubCompTree Room)
weaponLongCorridor = do
    root <- takeOne [tEast, tWest]
    connectingRoom <- takeOne 
        [tEast  & rmPmnts .~ [spanLightI (V2 (-30) 40) (V2 (-30) 80)]
        ]
    i1 <- state $ randomR (2,5)
    i2 <- state $ randomR (2,5)
    let branch1 = treeFromTrunk (replicate i1 $ PassDown corridorN) (singleUseAll $ putCrs connectingRoom)
    let branch2 = treeFromTrunk (replicate i2 $ PassDown corridorN) (singleUseNone $ putWp corridor)
    return $ Node (PassDown root) [branch1,branch2]
      where 
        putCrs = over rmPmnts (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
        putWp = set rmPmnts [sPS (V2 20 60) 0 $ RandPS randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)]

critInDeadEnd :: Room
critInDeadEnd = set rmPmnts [sPS (V2 0 0) 0 randC1] deadEndRoom

deadEndRoom :: Room
deadEndRoom = defaultRoom
    { _rmPolys = [rectNSWE 40 (-20) (-20) 20
                 ]
    , _rmLinks = muout (init lnks) ++ muin [last lnks]
    , _rmPath  = []
    , _rmPmnts    = [sPS (V2 0 (-10)) 0 putLamp]
    , _rmBound = [rectNSWE 20 (-20) (-30) 30]
    }
  where 
    lnks = [(V2 0 30  ,0) ]
{- A random Either tree with a weapon and melee monster challenge.  -}
weaponRoom :: RandomGen g => State g (SubCompTree Room)
weaponRoom = join $ takeOne 
    [-- weaponEmptyRoom
     weaponUnderCrits
    -- weaponBehindPillar
    -- weaponBetweenPillars
    --, weaponLongCorridor
    ]

roomCCrits :: RandomGen g => State g Room
roomCCrits = roomC 200 200
    <&> rmPmnts %~ (replicate 20 (spNoID (PSRoomRand 0 (uncurry PS)) randC1) ++ )

longRoom :: RandomGen g => State g Room
longRoom = do
    h <- state $ randomR (1500,1500)
    let w = 75
    let cond x = (sndV2 . fst) x < h - 40
    let ws = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall)
                    [rectNSWE (h-35) (h-135) (-10) 10
                    ,rectNSWE (h-35) (h-135) 15 35
                    ,rectNSWE (h-35) (h-135) 40 60
                    ,rectNSWE (h-35) (h-135) 65 85
                    ]
    let wsDefense = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall)
                    [rectNSWE 95 70  0 25
                    ,rectNSWE 95 70 50 75
                    ]
    brls <- fmap (map (\p -> sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel) )
                            $ replicateM 5 $ randInRect (w-20) 900
    let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
    changeLinkTo cond $ rm & rmPmnts .~ ws ++ brls ++ wsDefense ++
        [sPS (V2 12.5 (h-25)) 0 $ PutCrit longCrit
        ,sPS (V2 37.5 (h-25)) 0 $ PutCrit longCrit
        ,sPS (V2 62.5 (h-25)) 0 $ PutCrit longCrit
        ,sPS (V2   25    20 ) 0 putLamp
        ,sPS (V2   25 (h-10)) 0 putLamp
        ]

doubleCorridorBarrels :: RandomGen g => State g Room
doubleCorridorBarrels = do
    h <- state $ randomR (200,300)
    let cond x = (sndV2 . fst) x < h - 40
    changeLinkTo 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 75 (h-80)) 0 putLamp
        ]

shootersRoom' :: RandomGen g => State g Room
shootersRoom' = do
    w <- state $ randomR (200,300)
    x1 <- state $ randomR (20,w/3-20)
    x2 <- state $ randomR (w/3+20,2*w/3-20)
    x3 <- state $ randomR (2*w/3+20,w-20)
    y1 <- state $ randomR (280,550)
    y2 <- state $ randomR (280,550)
    y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (280,560)
    x4 <- state $ randomR (60,w-60)
    y4 <- state $ randomR (40,150)
    let bln x y = putBlockN (x+25) (x-25) (y+20) (y+10)
        blv x y = putBlockV (x+25) (x-25) (y+20) (y+10)
        plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
                  ++ [spanLightI (V2 (-10) 200) (V2 (w/2) 200)
                    ,spanLightI (V2 (w/2) 200) (V2 (w+10) 200)
                     ]
        toPS x y = return (V2 x y,-0.5*pi)
    return $ set rmPmnts plmnts $ roomRectAutoLinks w 600
        & rmPmnts .~ plmnts
        & rmRandPSs .~ [toPS x1 y1,toPS x2 y2,toPS x3 y3]

shootersRoom1 :: RandomGen g => State g Room
shootersRoom1 = shootersRoom' <&> rmPmnts %~ 
    ( (
    RandomPlacement $ takeOne $ map (\i -> spNoID (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
                    [0,1,2]
    ) :)

shootersRoom :: RandomGen g => State g Room
shootersRoom = shootersRoom' <&> rmPmnts %~
    ( map (\i -> spNoID (PSRoomRand i (uncurry PS)) (PutCrit autoCrit))
                    [0,1,2]
    ++ )

pillarGrid :: RandomGen g => State g Room
pillarGrid = do
    let f2 x y = singleBlock (V2 x y)
    f <- takeOne [f2]
    h <- state $ randomR (400,800)
    let w = h
    i <- takeOne [3,4,5]
    let j = fromIntegral i
    -- the 20+etc here is to correct for the pathfinding grid, which matches up to
    -- edges based on the size of doors (i.e. the line next to the wall is 20
    -- away from it)
        xs = take i [20+0.5*(w-40)/j,20+1.5*(w-40)/j..]
        ys = take i [20+0.5*(h-40)/j,20+1.5*(h-40)/j..]
        gap = 0.5 * h / (j+1)
        rps = do
            x <- takeOne xs
            y <- takeOne ys
            a <- state $ randomR (0,2*pi)
            return (V2 (x+gap) y,a)
-- the following was used to stop lights from being mounted in corners and
-- potentially overlapping, might want to redo
--        cornerRestrict (V2 x y,_)
--             = (x > 40 && x < h - 40)
--            || (y > 40 && y < h - 40)
    let plmnts = replicate 8 (mntLightLnkCond unusedLnkToPS)
                  ++ 
                 concat [f x y | x<-xs,y<-ys]
    return $ roomRect w h (max i 2) (max i 2)
        & rmPmnts .~ plmnts
        & rmRandPSs .~ [rps]

-- TODO remove possible identical draws on random PSs
pistolerRoom :: RandomGen g => State g Room
pistolerRoom = pillarGrid
    <&> rmPmnts %~ (
        [spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit pistolCrit)
        ,spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit pistolCrit)
        ,spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit pistolCrit)
        ]
            ++)

shootingRange :: RandomGen g => State g (SubCompTree Room)
shootingRange = do
    rm1 <- shootersRoom1 >>= changeLinkTo (\(V2 _ y,_) -> y < 40)
                        >>= changeLinkFrom  (\(V2 _ y,r) -> y > 200 && r /= 0)
    rm2 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
                        >>= changeLinkFrom  (\(V2 _ y,r) -> y > 200 && r /= 0)
    rm3 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
                        >>= changeLinkFrom  (\(_,r) -> r == 0)
    return $ treeFromPost 
        [PassDown rm1
        ,PassDown $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
            & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
        ,PassDown rm2
        ,PassDown $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
            & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
        ] 
        (UseAll rm3)

spawnerRoom :: RandomGen g => State g (SubCompTree Room)
spawnerRoom = do
    x <- state $ randomR (250,300)
    y <- state $ randomR (300,400)
    roomWithSpawner <- roomC x y <&> 
        rmPmnts %~ (spNoID (PSRoomRand 0 (uncurry PS)) (PutCrit spawnerCrit) :)
    aRoom <- airlock
    return $ treeFromTrunk [PassDown aRoom,PassDown corridor] $ singleUseAll roomWithSpawner
