{- 
Specification of individual rooms.
-}
module Dodge.Room
    ( module Dodge.Room
    , module Dodge.Room.Corridor
    ) where
import Dodge.Default.Room
import Dodge.Item.Weapon
import Dodge.Item.Weapon.AutoGun
import Dodge.Item.Weapon.Launcher
import Dodge.Creature
--import Dodge.Creature.Inanimate
--import Dodge.LevelGen
import Dodge.LevelGen.Data
--import Dodge.Base
import Dodge.RandomHelp
import Dodge.LevelGen
import Dodge.Default.Wall
--import Dodge.Path
--import Dodge.Layout
import Dodge.Layout.Tree.Polymorphic
import Dodge.Layout.Tree.Either
--import Dodge.LightSources
--import Dodge.SoundLogic
import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.Room.Procedural
import Dodge.Room.Corridor
import Dodge.Room.Link
--import Dodge.Room.Branch
import Dodge.Room.Door
import Dodge.Room.Airlock
import Dodge.Room.LongDoor
import Geometry
--import Geometry.Data
import Picture
import Tile

import Control.Lens
import Control.Monad.State
import Control.Monad.Loops
import System.Random
import Data.Tree
import Data.Bifunctor
--import qualified Data.Map as M
--import qualified Data.IntMap.Strict as IM

roomC :: Float -> Float -> Room
roomC x y = defaultRoom
    { _rmPolys = [rectNSWE y 0 0 x]
    , _rmLinks = lnks
    , _rmPath  = pth
    , _rmPS    = [windowLine (V2 (x/2) 0) (V2 (x/2) (y-60))
                 ]
    , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
    }
  where 
    lnks = map (first toV2)
        [( (x-20,  0),pi)
        ,( (  20,  0),pi)
        ,( (   0, 20),pi/2)
        ]
    xn = 4
    yn = 4
    yd = (y - 40) / fromIntegral yn
    xd = (x - 40) / fromIntegral xn
    pth  = linksAndPath lnks $ translateS (V2 20 20) (makeGrid xd xn yd yn)

roomPadCut :: [Point2] -> Point2 -> Room
roomPadCut ps p = defaultRoom
    { _rmPolys = [ps]
    , _rmLinks = [(p,0),(V2 0 0,pi)]
    , _rmPath  = [(V2 0 0,p)]
    , _rmPS    = []
    , _rmBound = []
    }
roomPillars :: Room
roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
  where 
    plmnts = sPS (V2 120 120) 0 putLamp 
        : sPS (V2 12 12) 0 putLamp 
        : sPS (V2 228 228) 0 putLamp 
        : 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] -> Tree (Either Room Room)
branchWith r ts = Node (Left r) $ return (Right door) : fmap (fmap Left) ts

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
    let plmnts = 
            [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
            ]
    return $ set rmPS plmnts $ roomRect wth hgt 2 6

manyDoors :: Int -> Tree (Either Room Room)
manyDoors i = treeFromPost (replicate i (Left door)) $ Right door

glassLesson :: RandomGen g => State g (Tree (Either Room Room))
glassLesson = do
    corridors <- replicateM 3 $ Left <$> randomiseOutLinks corridor
    return $ Node (Left botRoom) [deadRoom door,uppers, treeFromPost (Left door : corridors) $ Right door]
  where 
    uppers = Node (Left door) [deadRoom topRoom]
    botRoom = set rmPS botplmnts $ roomRect 200 200 1 1
    topRoom = set rmPS 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
        ,sPS  (V2 50 50) 0 putLamp
        ]
    topplmnts = 
        [windowLine (V2 100 200) (V2 100 0) 
        ,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
        ,sPS (V2 50 50) 0 putLamp
        ]

miniRoom1 :: RandomGen g => State g Room
miniRoom1 = do
        wth <- state $ randomR (200,400)
        hgt <- state $ randomR (400,600)
        wllen <- state $ randomR (60,wth/2-40)
        let hf = hgt/5
        cry <- randomRanges [--50+2*hf,30+3*hf
                            50+3*hf,30+4*hf
                            ,50+4*hf,30+5*hf
                            ]
        crx <- state $ randomR (wllen,wth-(wllen+40))
        let plmnts = [windowLine (V2 (wth-60) (     40+hf)) (V2 wllen (40+hf))
                     ,windowLine (V2 (wth-wllen) (40+2*hf)) (V2 60    (40+2*hf))
                     ,windowLine (V2 (wth-60) (   40+3*hf)) (V2 wllen (40+3*hf))
                     ,windowLine (V2 (wth-wllen) (40+4*hf)) (V2 60    (40+4*hf))
                     ,sPS (V2 crx cry) 0 $ PutCrit miniGunCrit
                     ,sPS (V2 (wth-20) (hgt/2+40)) 0 randC1
                     ,sPS (V2 (wth/2) (hgt/2)) 0 putLamp
                     ,blockLine (V2          0  ( 40+1*hf)) (V2 wllen (40+1*hf))
                     ,blockLine (V2 (wth-wllen) ( 40+2*hf)) (V2   wth (40+2*hf))
                     ,blockLine (V2          0  ( 40+3*hf)) (V2 wllen (40+3*hf))
                     ,blockLine (V2 (wth-wllen) ( 40+4*hf)) (V2   wth (40+4*hf))
                     ]
        return $ set rmPS plmnts $ shiftRoomBy (V2 0 40,0) $ roomRect wth hgt 2 4

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

miniRoom3 :: RandomGen g => State g (Tree (Either Room Room))
miniRoom3 = do
        w <- state $ randomR (300,400)
        h <- state $ randomR (300,400)
        let cp = V2 0 (h/2+40)
        let b = PutBlock [5,20,20] (greyN 0.5) $ 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 connectRoom $ randomiseOutLinks $ set rmPS 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 (Tree (Either Room Room))
roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost
    [return $ connectRoom door
    ,join $ takeOne [miniTree2,glassLesson]
    ]
    $ connectRoom <$> randomiseOutLinks corridor
  where 
    f (Node (Right x) xs) = Node (Right (Right x)) $ map f xs
    f (Node (Left x) xs) = Node (Left (Left x)) $ map f xs
    g (Node (Right x) []) = Node (Right x) []
    g (Node (Right x) xs) = Node (Left x) $ map g xs
    g (Node y ys) = Node y $ map g ys

roomCenterPillar :: RandomGen g => State g Room
roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst) 
    $ set rmPS 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
        ]

roomOctogon :: Room
roomOctogon = defaultRoom
    { _rmPolys = [poly ]
    , _rmLinks = lnks
    , _rmPath  = allPairs $ map fst lnks
    , _rmPS    = []
    , _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)
        ]

allPairs :: Eq a => [a] -> [(a,a)]
allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]

randomCorridorFrom :: RandomGen g => [a] -> State g (Tree (Either a a))
randomCorridorFrom xs = do
    rooms <- replicateM 5 $ takeOne xs
    return $ treeFromTrunk (map Left $ init rooms) (Node (Right (last rooms)) [])
{- 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 (Tree (Either Room 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
            ]
    (fmap connectRoom . randomiseOutLinks) =<< 
        changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPS plmnts $ roomRect w h 2 2)
     
weaponUnderCrits :: RandomGen g => State g (Tree (Either Room 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
            ]
    let continuationRoom = treeFromTrunk 
            [Left corridorN,Left corridorN] 
            (connectRoom (set rmPS plmnts corridorN))
    rcp' <- roomCenterPillar
    let rcp = over rmPS ( sPS (V2 120 80) 0 putLamp : ) rcp'
    deadEndRoom' <- takeOne [roomPillars,rcp]
    junctionRoom <- takeOne [Left tEast,Left tWest]
    return $ treeFromTrunk [Left corridorN,Left corridorN] 
                       $ Node junctionRoom
                              [continuationRoom
                              ,deadRoom deadEndRoom'
                              ]

weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
weaponBehindPillar  = do
      cpos <- takeOne $ [V2 x y | x <- [20,220], y <- [20,220]] ++ [V2 120 160,V2 120 200]
      let d p = argV $ V2 120 80 -.- p
      let plmnts1 = 
            [sPS (V2 120 160)  0 $ RandPS randFirstWeapon
            ,sPS cpos (d cpos) randC1
            ]
      rcp <- roomCenterPillar
      return $ treeFromTrunk 
        [Left door
        ,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp
        ]
        (connectRoom $ set rmPS [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)

weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
weaponBetweenPillars = do
    wpPos <- takeOne [V2 x y | x <- [20,120,220], y <- [20,120,220]]
    (ps,_) <- takeNMore 2 ([], [V2 x y | x <- [20,220], y <- [20,120,220]])
    let crPos1:crPos2:_ = ps 
        d p = argV $ V2 120 120 -.- p
        plmnts = 
            [sPS wpPos 0 $ RandPS randFirstWeapon
            ,sPS crPos1 (d crPos1) randC1
            ,sPS crPos2 (d crPos2) randC1
            ]
        theRoom = roomPillars & rmPS %~ (++ plmnts)
--                    & rmPolys %~ (rectNSWE 300 0 0 300 :)
    (fmap connectRoom . randomiseOutLinks) =<< filterLinks f theRoom
  where 
    f (_,a) = a == 0
    --f (_,_) = True -- this is probably preferable...

weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
weaponLongCorridor = do
    root <- takeOne [tEast, tWest]
    connectingRoom <- takeOne 
        [tEast & rmPS .~ [sPS (V2 (-40) 60) 0 putLamp]
        ,tWest & rmPS .~ [sPS (V2  40 60) 0 putLamp]
        ]
    i1 <- state $ randomR (2,5)
    i2 <- state $ randomR (2,5)
    let branch1 = treeFromTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom)
    let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor)
    return $ Node (Left root) [branch1,branch2]
      where 
        putCrs = over rmPS (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
        putWp = set rmPS [sPS (V2 20 40) 0 $ RandPS randFirstWeapon ,sPS (V2 20 60) 0 putLamp ]

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

deadEndRoom :: Room
deadEndRoom = defaultRoom
    { _rmPolys = [rectNSWE 40 (-20) (-20) 20
                 ]
    , _rmLinks = lnks
    , _rmPath  = []
    , _rmPS    = [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 (Tree (Either Room Room))
weaponRoom = join $ takeOne 
    [ weaponEmptyRoom
    , weaponUnderCrits
    , weaponBehindPillar
    , weaponBetweenPillars
    , weaponLongCorridor
    ]

roomCCrits :: RandomGen g => State g (Tree (Either Room Room))
roomCCrits = do
    ps <- replicateM 20 $ randInCirc 9
    let plmnts = map (\p -> sPS p 0 randC1) 
                       $ zipWith (+.+) [V2 x y | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps
        lamps = [sPS (V2 50 100) 0 putLamp , sPS (V2 175 100) 0 putLamp]
    return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200


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 & rmPS .~ 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
        ]

shooterRoom :: RandomGen g => State g Room
shooterRoom = do
    h <- state $ randomR (200,300)
    let cond x = (sndV2 . fst) x < h - 40
    changeLinkTo cond $ roomRect 100 h 1 1 & rmPS .~
        [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
        ]

shootersRoom1 :: RandomGen g => State g Room
shootersRoom1 = 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 (250,560)
    y2 <- state $ randomR (250,560)
    y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (250,560)
    x4 <- state $ randomR (60,w-60)
    y4 <- state $ randomR (40,180)
    p <- takeOne [V2 x1 (y1-10),V2 x2 (y2-10),V2 x3 (y3-10)]
    let bln x y = putBlockN (x+25) (x-25) (y+10) y
    let blv x y = putBlockV (x+25) (x-25) (y+10) y
    let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
                  ++ [sPS p (-pi/2) $ PutCrit autoCrit
                     ,sPS (V2 (w/2)  200) 0 putLamp
                     ]
    return $ set rmPS plmnts $ roomRectAutoLinks w 600

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 (250,560)
    y2 <- state $ randomR (250,560)
    y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (250,560)
    x4 <- state $ randomR (60,w-60)
    y4 <- state $ randomR (40,180)
    let bln x y = putBlockN (x+25) (x-25) (y+10) y
    let blv x y = putBlockV (x+25) (x-25) (y+10) y
    let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
                  ++ [sPS (V2  x1  (y1-10)) (-pi/2) $ PutCrit autoCrit
                     ,sPS (V2  x2  (y2-10)) (-pi/2) $ PutCrit autoCrit
                     ,sPS (V2  x3  (y3-10)) (-pi/2) $ PutCrit autoCrit
                     ,sPS (V2 (w/2)  200 ) 0 putLamp
                     ]
    return $ set rmPS plmnts $ roomRectAutoLinks w 600

pistolerRoom :: RandomGen g => State g Room
pistolerRoom = do
    let f2 x y = singleBlock (V2 x y)
        --f3 x y = [blockLine (x-20,y) (x+20,y)
        --         ,blockLine (x,y-20) (x,y+20) ]
        --f4 x y = [blockLine (x-20,y-20) (x+20,y+20)
        --         ,blockLine  (x+20,y-20) (x-20,y+20) ]
    f <- takeOne [f2]
    h <- state $ randomR (400,800)
    let w = h
    i <- takeOne [3,4,5]
    let j = fromIntegral (i+1)
    -- 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-1),20+1.5*(w-40)/(j-1)..]
        ys = take i [20+0.5*(h-40)/(j-1),20+1.5*(h-40)/(j-1)..]
        gap = 0.5 * h / j
    ps <- takeN 3 $ zipWith V2 (map (+gap) xs) ys
    aa <- state $ randomR (0,2*pi)
    ab <- state $ randomR (0,2*pi)
    ac <- state $ randomR (0,2*pi)
    let plmnts = [sPS (ps !! 0) aa $ PutCrit pistolCrit
                 ,sPS (ps !! 1) ab $ PutCrit pistolCrit
                 ,sPS (ps !! 2) ac $ PutCrit pistolCrit
                 ,sPS (V2 (w/2) (h-50)) 0 putLamp
                 ,sPS (V2 (w/2)  50   ) 0 putLamp
                 ,sPS (V2 (w-5) (h-5) ) 0 putLamp
                 ,sPS (V2    5  (h-5) ) 0 putLamp
                 ,sPS (V2 (w-5)  5    ) 0 putLamp
                 ,sPS (V2    5   5    ) 0 putLamp
                 ,sPS (V2 (w/2) (h/2) ) 0 putLamp
                 ] 
                  ++ 
                 concat [f x y | x<-xs,y<-ys]
    return 
        $ set rmPS plmnts $ roomRect w h (max i 2) (max i 2)

shootingRange :: RandomGen g => State g (Tree (Either Room Room))
shootingRange = do
    rm1 <- shootersRoom1 >>= changeLinkTo (\(V2 _ y,_) -> y < 40)
                        >>= filterLinks  (\(V2 _ y,r) -> y > 200 && r /= 0)
    rm2 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
                        >>= filterLinks  (\(V2 _ y,r) -> y > 200 && r /= 0)
    rm3 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
                        >>= filterLinks  (\(_,r) -> r == 0)
    return $ treeFromPost [Left rm1
                      ,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (V2 0 20)
                      ,Left rm2
                      ,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (V2 0 20)
                      ] 
                      (Right rm3)

spawnerRoom :: RandomGen g => State g (Tree (Either Room Room))
spawnerRoom = do
    x <- state $ randomR (250,300)
    y <- state $ randomR (300,400)
    wl <- takeOne [sPS (V2 0 0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10)) 
                              defaultCrystalWall
                  ,windowLine (V2 (x/2) 0) (V2 (x/2) (y-60))
                  ]
    let plmnts = [sPS (V2 (x/4) ( y/4)) (pi/2) $ PutCrit spawnerCrit
                 ,wl
                 ,sPS (V2 (x/2) ( y-10)) 0 putLamp
                 ]
    let f (V2 lx _,_) = lx < x/2-5 
    roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect x y 2 2) 
    aRoom <- airlock 0
    return $ treeFromTrunk [Left aRoom] roomWithSpawner
