{- Specification of individual rooms. -} module Dodge.Room ( module Dodge.Room , module Dodge.Room.Corridor ) where import Dodge.Data import Dodge.Item.Weapon import Dodge.Creature import Dodge.Creature.Inanimate import Dodge.LevelGen import Dodge.LevelGen.Data import Dodge.Base import Dodge.RandomHelp import Dodge.Default 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 Geometry import Picture import qualified SDL.Mixer as Mix import Control.Lens import Control.Monad.State import Control.Monad.Loops import System.Random import Data.List import Data.Maybe import Data.Tree import Data.Either import Data.Function import Data.Graph.Inductive.Graph hiding ((&)) import Data.Graph.Inductive.Basic import Data.Graph.Inductive.PatriciaTree import Data.Graph.Inductive.NodeMap import qualified Data.Map as M import qualified Data.IntMap.Strict as IM airlockOneWay :: Int -> Room airlockOneWay n = Room { _rmPolys = [rectNSWE 90 0 0 40] , _rmLinks = lnks , _rmPath = [] , _rmPS = [PS (0,15) 0 $ PutTriggerDoor col (not . cond) (0,0) (0,40) ,PS (0,75) 0 $ PutTriggerDoor col (cond) (0,0) (0,40) ,PS (35,45) (pi/2) $ PutButton $ makeButton col (over worldState (M.insert (DoorNumOpen n) True)) ] --, _rmBound = rectNSWE 90 30 (-30) 30 , _rmBound = rectNSWE 75 15 0 40 } where lnks = [((0,85),0) ,((0, 5),pi) ] cond w = or $ M.lookup (DoorNumOpen n) (_worldState w) col = dim $ dim $ bright red airlock :: Int -> Room airlock n = Room { _rmPolys = [ rectNSWE 100 0 0 40 , rectNSWE 65 35 (-40) 20 ] , _rmLinks = lnks , _rmPath = [((20,85),(20,45)) ,((20,45),(20, 5)) ] , _rmPS = [PS (0,20) 0 $ PutTriggerDoor col (not . cond) (1,0) (39,0) ,PS (0,80) 0 $ PutTriggerDoor col (cond) (1,0) (39,0) ,PS (35,50) (pi/2) $ PutButton $ makeSwitch col (over worldState (M.insert (DoorNumOpen n) True)) (over worldState (M.insert (DoorNumOpen n) False)) ,PS (-25, 50) 0 putLamp ] , _rmBound = rectNSWE 75 15 0 40 } where lnks = [((20,85),0) ,((20, 5),pi) ] cond w = or $ M.lookup (DoorNumOpen n) (_worldState w) col = dim $ dim $ bright red roomC :: Float -> Float -> Room roomC x y = Room { _rmPolys = [rectNSWE y 0 0 x] , _rmLinks = lnks , _rmPath = [] , _rmPS = [windowLine (x/2,0) (x/2,y-60) ] , _rmBound = rectNSWE (y+5) (-5) (-5) (x+5) } where lnks = [( (x-20, 0),pi) ,( ( 20, 0),pi) ,( ( 0, 20),pi/2) ] roomPadCut :: [Point2] -> Point2 -> Room roomPadCut ps p = Room { _rmPolys = [ps] , _rmLinks = [(p,0),((0,0),pi)] , _rmPath = [((0,0),p)] , _rmPS = [] , _rmBound = [] } door :: Room door = Room { _rmPolys = [rectNSWE 40 0 0 40] , _rmLinks = lnks , _rmPath = [((20,35),(20,5))] -- door extends into side walls (for shadows as rendered 12/03) , _rmPS = [PS (0,20) 0 $ PutAutoDoor (0,0) (40,0)] , _rmBound = [] } where lnks = [((20,35),0) ,((20, 5),pi) ] roomPillars :: Room roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect' 240 240 2 2 where plmnts = PS (120,120) 0 putLamp : PS (10,10) 0 putLamp : PS (230,230) 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 putBlockRect a x b y = [ blockLine (a,b) (a,y) , blockLine (a,y) (x,y) , blockLine (x,y) (x,b) , blockLine (x,b) (a,b) ] putBlockV a x b y = [ blockLine (a,b) (a,y) , blockLine (x,b) (a,b) ] putBlockC a x b y = [ blockLine (a,b) (a,y) , blockLine (x,b) (a,b) , blockLine (a,y) (x,y) ] putBlockN a x b y = [ blockLine (a,b) (a,y) , blockLine (x,b) (a,b) , blockLine (x,y) (x,b) ] 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 (wth-60, hf) (wllen,hf) ,windowLine (wth-wllen,2*hf) (60, 2*hf) ,windowLine (wth-60, 3*hf) (wllen,3*hf) ,windowLine (wth-wllen,4*hf) (60, 4*hf) ,blockLine ( 0, 1*hf) (wllen,1*hf) ,blockLine (wth-wllen, 2*hf) ( wth,2*hf) ,blockLine ( 0, 3*hf) (wllen,3*hf) ,blockLine (wth-wllen, 4*hf) ( wth,4*hf) , PS (wth/2,hgt/2) 0 $ putLamp ] return $ set rmPS plmnts $ roomRect' wth hgt 2 6 manyDoors :: Int -> Tree (Either Room Room) manyDoors i = treePost (replicate i (Left door)) $ Right door glassLesson :: RandomGen g => State g (Tree (Either Room Room)) glassLesson = do corridors <- sequence $ replicate 3 $ fmap Left $ randomiseOutLinks corridor return $ Node (Left $ botRoom) [deadRoom door,uppers, treePost (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 = [PS (0,0) 0 $ PutWindow (rectNSWE (200) 0 (90) (110)) $ withAlpha 0.5 aquamarine ,PS (50,100) 0 $ PutCrit miniGunCrit ,PS (50,50) 0 putLamp ] topplmnts = [windowLine (100,200) (100,0) ,PS (50,100) 0 $ PutCrit miniGunCrit ,PS (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 (wth-60, 40+hf) (wllen,40+hf) ,windowLine (wth-wllen,40+2*hf) (60,40+2*hf) ,windowLine (wth-60, 40+3*hf) (wllen,40+3*hf) ,windowLine (wth-wllen,40+4*hf) (60,40+4*hf) ,PS (crx,cry) 0 $ PutCrit miniGunCrit ,PS (wth-20,hgt/2+40) 0 $ randC ,PS (wth/2,hgt/2) 0 putLamp ,blockLine ( 0, 40+1*hf) (wllen,40+1*hf) ,blockLine (wth-wllen, 40+2*hf) ( wth,40+2*hf) ,blockLine ( 0, 40+3*hf) (wllen,40+3*hf) ,blockLine (wth-wllen, 40+4*hf) ( wth,40+4*hf) ] return $ set rmPS plmnts $ shiftRoomBy ((0,40),0) $ roomRect' wth hgt 2 4 miniTree2 :: RandomGen g => State g (Tree (Either Room Room)) miniTree2 = miniRoom1 >>= randomiseOutLinks >>= changeLinkTo (\p -> (snd . fst) p < 70) >>= return . flip branchWith (replicate 3 $ treePost [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 = (0,h/2+40) let b = PutBlock [5,20,20] (greyN 0.5) [(-10,-60) ,( 10,-60) ,( 10,-80) ,(-10,-80) ] let plmnts = [PS cp 0 $ PutCrit miniGunCrit ,PS cp 0 $ windowLineType (0,-40) (0,-80) ,PS cp (1*pi/4) $ windowLineType (0,-40) (0,-80) ,PS cp (2*pi/4) $ windowLineType (0,-40) (0,-80) ,PS cp (3*pi/4) $ windowLineType (0,-40) (0,-80) ,PS cp (4*pi/4) $ windowLineType (0,-40) (0,-80) ,PS cp (5*pi/4) $ windowLineType (0,-40) (0,-80) ,PS cp (6*pi/4) $ windowLineType (0,-40) (0,-80) ,PS cp (7*pi/4) $ windowLineType (0,-40) (0,-80) ,PS cp (pi/8) b ,PS cp (pi/8+1*pi/4) b ,PS cp (pi/8+2*pi/4) b ,PS cp (pi/8+3*pi/4) b ,PS cp (pi/8+4*pi/4) b ,PS cp (pi/8+5*pi/4) b ,PS cp (pi/8+6*pi/4) b ,PS cp (pi/8+7*pi/4) b ,PS (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 $ treePost [return $ connectRoom door ,join $ takeOne [miniTree2,glassLesson] -- ,join $ takeOne [miniRoom1] ] $ fmap 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 (120,0) < 10) . fst) $ set rmPS plmnts $ roomRect' 240 240 2 2 where plmnts = [ blockLine (115,115) (115,125) , blockLine (125,115) (125,125) , PS (40,120) 0 putLamp , PS (200,120) 0 putLamp ] roomOctogon :: Room roomOctogon = Room { _rmPolys = [[(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)] ] , _rmLinks = lnks , _rmPath = allPairs $ map fst lnks , _rmPS = [] , _rmBound = [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] } where lnks = [((0,140),0) ,((35,125),0-pi/4) ,((-35,125),pi/4) ,( (50,90),0-pi/2) ,( (-50,90),pi/2) ,((35,55),0-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 <- sequence $ replicate 5 $ takeOne xs return $ treeTrunk (map Left $ init rooms) (Node (Right (last rooms)) []) randFirstWeapon :: State StdGen PSType randFirstWeapon = do r <- state $ randomR (-pi,pi) takeOne $ map PutFlIt [ defaultFlIt {_flItRot=r,_flIt = pistol} , defaultFlIt {_flItRot=r,_flIt = ltAutoGun} -- , defaultFlIt {_flItRot=r,_flIt = autoGun} , defaultFlIt {_flItRot=r,_flIt = spreadGun} , defaultFlIt {_flItRot=r,_flIt = multGun} , defaultFlIt {_flItRot=r,_flIt = launcher} -- , defaultFlIt {_flItRot=r,_flIt = lasGun} -- , defaultFlIt {_flItRot=r,_flIt = flamer} ] --randC1 :: State StdGen PSType randC1 = RandPS $ takeOne $ map PutCrit $ (armourChaseCrit : replicate 50 chaseCrit) randC = randC1 -- randSwarmCrit = RandPS $ takeOne $ map PutCrit $ (armouredSwarmCrit : replicate 100 swarmCrit) weaponEmptyRoom :: RandomGen g => State g (Tree (Either Room Room)) weaponEmptyRoom = do w <- state $ randomR (220,300) h <- state $ randomR (220,300) let plmnts = [PS (w/2,h-40) 0 $ RandPS randFirstWeapon ,PS (20,20) (pi/2) $ randC1 ,PS (w-20,20) (pi/2) $ randC1 ,PS (w/2,h/2) 0 $ putLamp ] (fmap connectRoom . randomiseOutLinks) =<< (changeLinkTo ((\p -> dist p (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 = [PS (20,0) 0 $ RandPS randFirstWeapon ,PS (20,0) (0-pi/2) $ randC1 ,PS (20,20) (0-pi/2) $ randC1 ] let continuationRoom = treeTrunk [Left corridorN,Left corridorN] (connectRoom (set rmPS plmnts $ corridorN)) rcp' <- roomCenterPillar let rcp = over rmPS ( PS (120,80) 0 putLamp : ) rcp' deadEndRoom <- takeOne [roomPillars,rcp] junctionRoom <- takeOne [Left tEast,Left tWest] return $ treeTrunk [Left corridorN,Left corridorN] $ Node junctionRoom [continuationRoom ,deadRoom deadEndRoom ] weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room)) weaponBehindPillar = do crPos <- takeOne $ [(x,y) | x <- [20,220], y <- [20,220]] ++ [(120,160),(120,200)] let d p = argV $ (120,80) -.- p let plmnts1 = [PS (120,160) 0 $ RandPS randFirstWeapon ,PS crPos (d crPos) $ randC1 ] rcp <- roomCenterPillar return $ treeTrunk [Left door ,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp] (connectRoom $ set rmPS [PS (20,60) (0-pi/2) $ randC1] $ corridorN) weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room)) weaponBetweenPillars = do wpPos <- takeOne [(x,y) | x <- [20,120,220], y <- [20,120,220]] (ps,_) <- takeNMore 2 ([], [(x,y) | x <- [20,220], y <- [20,120,220]]) let crPos1 = ps !! 0 let crPos2 = ps !! 1 let d p = argV $ (120,120) -.- p let plmnts = [PS wpPos 0 $ RandPS randFirstWeapon ,PS crPos1 (d crPos1) $ randC1 ,PS crPos2 (d crPos2) $ randC1 ] (fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars) where f (_,a) = a == 0 blockedCorridor :: RandomGen g => State g (Tree (Either Room Room)) blockedCorridor = do r <- state $ randomR (0,pi) n <- state $ randomR (0,3) let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256) $ reverse $ rectNSWE 10 (-10) (-10) 10 ,PS (20,15) 0 $ putLamp ] sequence $ treePost (replicate n $ fmap Left $ randomiseOutLinks corridor) $ fmap Right $ return $ set rmPS plmnts corridor weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room)) weaponLongCorridor = do root <- takeOne $ [tEast, tWest] connectingRoom <- takeOne [tEast & rmPS .~ [PS (-40,60) 0 $ putLamp] ,tWest & rmPS .~ [PS ( 40,60) 0 $ putLamp] ] i1 <- state $ randomR (2,5) i2 <- state $ randomR (2,5) let branch1 = treeTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom) let branch2 = treeTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor) return $ Node (Left root) [branch1,branch2] where putCrs = over rmPS (++ [PS (10,40) (-pi/2) $ randC ,PS (-10,40) (-pi/2) $ randC ]) putWp = set rmPS [PS (20,40) 0 $ RandPS randFirstWeapon ,PS (20,60) 0 $ putLamp ] critInDeadEnd :: Room critInDeadEnd = set rmPS [PS (0,0) 0 $ randC] deadEndRoom deadEndRoom :: Room deadEndRoom = Room { _rmPolys = [rectNSWE 40 (-20) (-20) 20 ] , _rmLinks = lnks , _rmPath = [] , _rmPS = [PS (0,-10) 0 putLamp] , _rmBound = rectNSWE 20 (-20) (-30) 30 } where lnks = [((0,30) ,0) ] {- A random Either tree with a weapon and melee monster challenge. -} weaponRoom :: RandomGen g => State g (Tree (Either Room Room)) weaponRoom = do x <- takeOne [ weaponEmptyRoom , weaponUnderCrits , weaponBehindPillar , weaponBetweenPillars , weaponLongCorridor ] x roomCCrits :: RandomGen g => State g (Tree (Either Room Room)) roomCCrits = do ps <- sequence $ replicate 20 $ randInCirc 9 let plmnts = map (\p -> PS p 0 $ randC) $ zipWith (+.+) [(x,y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps lamps = [PS (50,100) 0 putLamp , PS (175,100) 0 putLamp] return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200 branchRectWith :: RandomGen g => State g (Tree (Either Room Room)) -> State g (Tree (Either Room Room)) branchRectWith t = do x <- state $ randomR (100,200) y <- state $ randomR (100,200) b <- t root <- randomiseOutLinks $ roomRectAutoLinks x y return $ Node (Left root) [Node (Right door) [], fmap rToL $ treeTrunk [Left door] b] where rToL :: Either a a -> Either a a rToL (Right r) = Left r rToL (Left r) = Left r slowDoorRoom :: RandomGen g => State g (Tree (Either Room Room)) slowDoorRoom = do x <- state $ randomR (400,800) y <- state $ randomR (400,800) h <- state $ randomR (200,min (y-100) 500) (butPos,butRot) <- takeOne [( (x/2-50,5),0) ,( (x/2+50,5),0) ] let n = 25 xs <- sequence $ replicate n $ state $ randomR (10,x-10) ys <- sequence $ replicate n $ state $ randomR (h+20,y) rs <- sequence $ replicate n $ state $ randomR (0,2*pi) let ps = zip xs ys xs' <- sequence $ replicate 5 $ state $ randomR (10,x-10) ys' <- sequence $ replicate 5 $ state $ randomR (h+20,y) let crits = zipWith (\p r -> PS p r randC1) ps rs lsources = [PS (x/2,30) 0 putLamp, PS (x/2,y-30) 0 putLamp] let barrels = zipWith (\x y -> PS (x,y) 0 $ PutCrit explosiveBarrel) xs' ys' let pillarsa = [] let pillarsb = putBlockRect (x/5-20) (x/5+20) (h/2-20) (h/2+20) ++ putBlockRect (2*x/5-20) (2*x/5+20) (h/2-20) (h/2+20) ++ putBlockRect (3*x/5-20) (3*x/5+20) (h/2-20) (h/2+20) ++ putBlockRect (4*x/5-20) (4*x/5+20) (h/2-20) (h/2+20) let pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20) ++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20) pillars <- takeOne [pillarsa, pillarsb, pillarsc] let cond x = (snd . fst) x > h + 40 let cond2 x = (snd . fst) x < h - 40 but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (0,h) (x,h) -- ,PutSwitchDoor (dim $ light red) butPos butRot (0,h) (x,h) ] fmap connectRoom (filterLinks cond =<< (changeLinkTo cond2 $ set rmPS ([PS (0,0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources) $ roomRectAutoLinks x y )) longRoom :: RandomGen g => State g Room longRoom = do h <- state $ randomR (1500,1500) let w = 75 let cond x = (snd . fst) x < h - 40 let ws = map (\ps -> PS (0,0) 0 $ PutWindow ps $ withAlpha 0.5 aquamarine) [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 -> PS (0,0) 0 $ PutWindow ps $ withAlpha 0.5 aquamarine) [rectNSWE (95) (70) 0 25 ,rectNSWE (95) (70) 50 75 ] brls <- fmap (map (\p -> PS (p +.+ (10,200)) 0 $ PutCrit explosiveBarrel) ) $ sequence $ replicate 5 $ randInRect (w-20) 900 let rm = roomRect' w (h+70) 1 1 & rmPolys %~ ( (++) [rectNSWE h (h-165) (-45) (w+45) ] ) changeLinkTo cond $ set rmPS (ws ++ brls ++ wsDefense ++ [PS ( 12.5,h-25) 0 $ PutCrit longCrit ,PS ( 37.5,h-25) 0 $ PutCrit longCrit ,PS ( 62.5,h-25) 0 $ PutCrit longCrit ,PS ( 25, 20) 0 $ putLamp ,PS ( 25, h-10) 0 $ putLamp ] ) $ rm shooterRoom :: RandomGen g => State g Room shooterRoom = do h <- state $ randomR (200,300) let cond x = (snd . fst) x < h - 40 changeLinkTo cond $ set rmPS ( [blockLine (50,50) (50,h) ,PS ( 25,h-25) 0 $ PutCrit $ addArmour autoCrit ,PS ( 75,h-30) 0 $ PutCrit explosiveBarrel ,PS ( 75,h-60) 0 $ PutCrit explosiveBarrel ,PS ( 85,h-10) 0 $ PutCrit explosiveBarrel ,PS ( 85,h-45) 0 $ PutCrit explosiveBarrel ,PS ( 75,h-80) 0 putLamp ] ) $ roomRect' 100 h 1 1 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 [(x1,y1-10),(x2,y2-10),(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 ++ [PS p (-pi/2) $ PutCrit autoCrit ,PS (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 ++ [PS (x1,y1-10) (-pi/2) $ PutCrit autoCrit ,PS (x2,y2-10) (-pi/2) $ PutCrit autoCrit ,PS (x3,y3-10) (-pi/2) $ PutCrit autoCrit ,PS (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 (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 [4,6,8] 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 $ zip (map (+gap) xs) ys aa <- state $ randomR (0,2*pi) ab <- state $ randomR (0,2*pi) ac <- state $ randomR (0,2*pi) let plmnts = [PS (ps !! 0) aa $ PutCrit pistolCrit ,PS (ps !! 1) ab $ PutCrit pistolCrit ,PS (ps !! 2) ac $ PutCrit pistolCrit -- ,PS (w-5,h/2) 0 $ putLamp -- ,PS (5,h/2) 0 $ putLamp -- ,PS (w/2,h-5) 0 $ putLamp -- ,PS (w/2,5) 0 $ putLamp -- ,PS (w-50,h/2) 0 $ putLamp -- ,PS (50,h/2) 0 $ putLamp ,PS (w/2,h-50) 0 $ putLamp ,PS (w/2,50) 0 $ putLamp ,PS (w-5,h-5) 0 $ putLamp ,PS (5,h-5) 0 $ putLamp ,PS (w-5,5) 0 $ putLamp ,PS (5,5) 0 $ putLamp ,PS (w/2,h/2) 0 $ putLamp ] ++ -- f (w*0.25) (h*0.5) 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 (\((_,y),_) -> y < 40) >>= filterLinks (\((_,y),r) -> y > 200 && r /= 0) rm2 <- shootersRoom >>= changeLinkTo (\((x,y),_) -> y < 10 && x > 20 && x < 180) >>= filterLinks (\((_,y),r) -> y > 200 && r /= 0) rm3 <- shootersRoom >>= changeLinkTo (\((x,y),_) -> y < 10 && x > 20 && x < 180) >>= filterLinks (\(_,r) -> r == 0) return $ treePost [Left rm1 ,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (0,20) ,Left rm2 ,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (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 [PS (0,0) 0 $ PutWindow (rectNSWE (y-60) 0 (x/2-10) (x/2+10)) $ withAlpha 0.5 aquamarine ,windowLine (x/2,0) (x/2,y-60) ] let plmnts = [PS (x/4, y/4) (pi/2) $ PutCrit spawnerCrit ,wl ,PS (x/2, y-10) 0 putLamp ] let f ((lx,_),_) = lx < x/2-5 roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ set rmPS plmnts $ roomRect' x y 2 2) return $ treeTrunk [Left (airlock 0)] roomWithSpawner