diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index f3633469e..8e20179ee 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -39,7 +39,7 @@ initialAnoTree :: RandomGen g => Tree [Annotation g] initialAnoTree = padSucWithCorridors $ treeFromTrunk [[StartRoom] ,[SetLabel 0 $ return $ roomRectAutoLinks 100 100 - & rmExtendedPmnt .~ Just (externalButton red (PS (V2 50 50) 0)) + & rmExtendedPmnt ?~ externalButton red (anyLnkInPS 5) ] ,[UseLabel 0 $ return switchDoorRoom] ,[SpecificRoom $ return $ connectRoom lasTunnel ] diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index e4417855e..f6f6a28b3 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -25,8 +25,6 @@ import Data.List (nubBy) --import Control.Monad.State import Control.Lens import System.Random ---import Data.Graph.Inductive.Graph (labNodes) ---import qualified Data.Map as M import Data.Foldable import qualified Control.Foldl as L import Data.Maybe diff --git a/src/Dodge/Layout/Tree/Annotate.hs b/src/Dodge/Layout/Tree/Annotate.hs index 604a26473..9cffbf75e 100644 --- a/src/Dodge/Layout/Tree/Annotate.hs +++ b/src/Dodge/Layout/Tree/Annotate.hs @@ -4,18 +4,7 @@ import Dodge.Data import Dodge.RandomHelp import Dodge.Layout.Tree.Polymorphic import Dodge.Layout.Tree.Either -import Dodge.Room.Procedural -import Dodge.Room.Branch -import Dodge.Room.RoadBlock -import Dodge.Room.Door -import Dodge.Room.Boss -import Dodge.Room.Treasure -import Dodge.Room.Link -import Dodge.Room.Data -import Dodge.Room.Airlock -import Dodge.Room.Start import Dodge.Room -import Dodge.Room.Teleport import Data.Tree import Control.Monad.State @@ -27,7 +16,6 @@ data Annotation g | Key Int | Corridor | CorridorDebug - | DoorAno | SwitchDoorAno | DoorNumAno Int | AirlockAno @@ -76,7 +64,7 @@ anoToRoomTree anos = case anos of anoToRoomTree a [Corridor] -> pure . Right <$> randomiseOutLinks corridor [CorridorDebug] -> pure . Right <$> randomiseOutLinks corridorDebug - [DoorAno] -> roomThenCorridor door +-- [DoorAno] -> roomThenCorridor door [AirlockAno] -> airlock >>= roomThenCorridor [FirstWeapon] -> do branchWP <- branchRectWith weaponRoom diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 291013eed..adfd559ae 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -36,7 +36,7 @@ placeSpot (w,rm) plmnt = case plmnt of Placement{_plSpot = PSLnk{}} -> placeSpotUsingLink w rm plmnt Placement{} -> let (i,w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w - newplmnt = plmnt & plMID .~ Just i + newplmnt = plmnt & plMID ?~ i in maybe ((w',rm),[newplmnt]) (recrPlace newplmnt w') (_plIDCont plmnt newplmnt) where recrPlace newplmnt w' pl = let (wr,newplmnts) = placeSpot (w',rm) pl diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 5eaa67e41..c24e40b7b 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -3,13 +3,14 @@ module Dodge.LevelGen.Data where import Dodge.Data import Picture -import Geometry.Data +import Geometry import Shape.Data import Control.Lens import Control.Monad.State import System.Random import Data.Maybe +--import Data.Bifunctor data PSType = PutCrit {_unPutCrit :: Creature} | PutMachine Color [Point2] Machine | PutLS LightSource @@ -46,6 +47,15 @@ data Placement = Placement | PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position | RandomPlacement {_unRandomPlacement :: State StdGen Placement} +anyLnkOutPS :: PlacementSpot +anyLnkOutPS = PSLnk (const True) id Nothing + +anyLnkInPS :: Float -- ^ amount to shift inward + -> PlacementSpot +anyLnkInPS x = PSLnk (const True) f Nothing + where + f (v,a) = (v -.- x *.* unitVectorAtAngle (a + 0.5 * pi), a+ pi) + spNoID :: PlacementSpot -> PSType -> Placement spNoID ps pst = Placement ps pst Nothing (const Nothing) @@ -76,7 +86,7 @@ jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing $ \_ -> Just plm ps0 :: PSType -> (Int -> Maybe Placement) -> Placement ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing . intPlPlPl -intPlPlPl :: (Int -> Maybe Placement) -> Placement -> (Maybe Placement) +intPlPlPl :: (Int -> Maybe Placement) -> Placement -> Maybe Placement intPlPlPl f = f . fromJust . _plMID jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index bff3cb4c4..9d6bef056 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -2,20 +2,30 @@ Specification of individual rooms. -} module Dodge.Room - ( module Dodge.Room + ( module Dodge.Room.Room + , module Dodge.Room.Foreground + , module Dodge.Room.Data + , module Dodge.Room.Procedural , module Dodge.Room.Corridor + , module Dodge.Room.Link + , module Dodge.Room.Door + , module Dodge.Room.Airlock + , module Dodge.Room.LongDoor + , module Dodge.Room.Branch + , module Dodge.Room.RoadBlock + , module Dodge.Room.Teleport + , module Dodge.Room.Start + , module Dodge.Room.Boss + , module Dodge.Room.Treasure ) where -import Dodge.Default.Room -import Dodge.Item.Weapon.BulletGuns -import Dodge.Item.Weapon.Launcher -import Dodge.Creature +import Dodge.Room.Room +import Dodge.Room.Treasure +import Dodge.Room.Boss +import Dodge.Room.Start +import Dodge.Room.RoadBlock +import Dodge.Room.Teleport +import Dodge.Room.Branch import Dodge.Room.Foreground -import Dodge.LevelGen.Data -import Dodge.RandomHelp -import Dodge.Default.Wall -import Dodge.Layout.Tree.Polymorphic -import Dodge.Layout.Tree.Either -import Dodge.Placements import Dodge.Room.Data import Dodge.Room.Procedural import Dodge.Room.Corridor @@ -23,473 +33,3 @@ import Dodge.Room.Link import Dodge.Room.Door import Dodge.Room.Airlock import Dodge.Room.LongDoor -import Geometry -import Picture -import Tile - -import Control.Lens -import Control.Monad.State -import Control.Monad.Loops -import System.Random -import Data.Tree -import Data.Bifunctor - -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 = [(p,0),(V2 0 0,pi)] - , _rmPath = [(V2 0 0,p)] - } -roomPillars :: Room -roomPillars = over rmLinks init $ set rmPmnts plmnts $ roomRect 240 240 2 2 - where - plmnts = spanLightI (V2 120 24) (V2 120 216) - : mountLightV (V2 12 12) (V3 25 25 70) - : mountLightV (V2 228 228) (V3 215 215 70) - : sps0 (PutForeground $ thinHighBar 75 (V2 26 25) (V2 120 25)) - : sps0 (PutForeground $ 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] -> Tree (Either Room Room) -branchWith r ts = Node (Left r) $ return (Right door) : fmap (fmap Left) ts - - -manyDoors :: Int -> Tree (Either Room Room) -manyDoors i = treeFromPost (replicate i (Left door)) $ Right door - --- TODO: partially combine a room tree into a room -glassLesson :: RandomGen g => State g (Tree (Either Room Room)) -glassLesson = do - i <- takeOne [1,2,3] - corridors <- replicateM i $ 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 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) - , mountLightV (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) - , mountLightV (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 (V2 _ y,_) = y < 0.5*hgt - plmnts = - [ mntLightLnkCond con1 - , mntLightLnkCond (not . con1) - ,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) (PutCrit miniGunCrit) - , spNoID (PSRoomRand 1) randC1 - ] ++) - -miniTree2 :: RandomGen g => State g (Tree (Either Room Room)) -miniTree2 = glassSwitchBackCrits - >>= 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 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 (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 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 (const True) - , mntLightLnkCond (const True) - ] - -roomOctogon :: Room -roomOctogon = defaultRoom - { _rmPolys = [poly ] - , _rmLinks = 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) - ] - -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 (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 - ,mntLightLnkCond (const True) - ] - (fmap connectRoom . randomiseOutLinks) =<< - changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts 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 rmPmnts plmnts corridorN)) - rcp <- roomCenterPillar - 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 rmPmnts (++ plmnts1) rcp - ] - (connectRoom $ set rmPmnts [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 & rmPmnts %~ (++ plmnts) - (fmap connectRoom . randomiseOutLinks) =<< filterLinks f theRoom - where - f (_,a) = a == 0 - -weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room)) -weaponLongCorridor = do - root <- takeOne [tEast, tWest] - connectingRoom <- takeOne - [tEast & rmPmnts .~ [spanLightI (V2 (-40) 40) (V2 (-40) 80)] - ] - 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 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 = 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 (Tree (Either Room 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) 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) (PutCrit autoCrit)) - [0,1,2] - ) :) - -shootersRoom :: RandomGen g => State g Room -shootersRoom = shootersRoom' <&> rmPmnts %~ - ( map (\i -> spNoID (PSRoomRand i) (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) - cornerRestrict (V2 x y,_) - = (x > 40 && x < h - 40) - || (y > 40 && y < h - 40) - let plmnts = replicate 8 (mntLightLnkCond cornerRestrict) - ++ - 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) (PutCrit pistolCrit) - ,spNoID (PSRoomRand 0) (PutCrit pistolCrit) - ,spNoID (PSRoomRand 0) (PutCrit pistolCrit) - ] - ++) - -shootingRange :: RandomGen g => State g (Tree (Either Room 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 - [Left rm1 - ,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20) - & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :) - ,Left rm2 - ,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20) - & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :) - ] - (Right rm3) - -spawnerRoom :: RandomGen g => State g (Tree (Either Room Room)) -spawnerRoom = do - x <- state $ randomR (250,300) - y <- state $ randomR (300,400) - roomWithSpawner <- roomC x y <&> - rmPmnts %~ (spNoID (PSRoomRand 0) (PutCrit spawnerCrit) :) - aRoom <- airlock - return $ treeFromTrunk [Left aRoom,Left corridor] $ connectRoom roomWithSpawner diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs new file mode 100644 index 000000000..72276c1d3 --- /dev/null +++ b/src/Dodge/Room/Room.hs @@ -0,0 +1,489 @@ +module Dodge.Room.Room where +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.Layout.Tree.Polymorphic +import Dodge.Layout.Tree.Either +import Dodge.Placements +import Dodge.Room.Data +import Dodge.Room.Procedural +import Dodge.Room.Corridor +import Dodge.Room.Link +import Dodge.Room.Door +import Dodge.Room.Airlock +import Dodge.Room.LongDoor +import Geometry +import Picture +import Tile + +import Control.Lens +import Control.Monad.State +import Control.Monad.Loops +import System.Random +import Data.Tree +import Data.Bifunctor + +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 = [(p,0),(V2 0 0,pi)] + , _rmPath = [(V2 0 0,p)] + } +roomPillars :: Room +roomPillars = over rmLinks init $ set rmPmnts plmnts $ roomRect 240 240 2 2 + where + plmnts = spanLightI (V2 120 24) (V2 120 216) + : mountLightV (V2 12 12) (V3 25 25 70) + : mountLightV (V2 228 228) (V3 215 215 70) + : sps0 (PutForeground $ thinHighBar 75 (V2 26 25) (V2 120 25)) + : sps0 (PutForeground $ 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] -> Tree (Either Room Room) +branchWith r ts = Node (Left r) $ return (Right door) : fmap (fmap Left) ts + + +manyDoors :: Int -> Tree (Either Room Room) +manyDoors i = treeFromPost (replicate i (Left door)) $ Right door + +-- TODO: partially combine a room tree into a room +glassLesson :: RandomGen g => State g (Tree (Either Room Room)) +glassLesson = do + i <- takeOne [1,2,3] + corridors <- replicateM i $ 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 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) + , mountLightV (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) + , mountLightV (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 (V2 _ y,_) = y < 0.5*hgt + plmnts = + [ mntLightLnkCond con1 + , mntLightLnkCond (not . con1) + ,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) (PutCrit miniGunCrit) + , spNoID (PSRoomRand 1) randC1 + ] ++) + +miniTree2 :: RandomGen g => State g (Tree (Either Room Room)) +miniTree2 = glassSwitchBackCrits + >>= 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 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 (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 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 (const True) + , mntLightLnkCond (const True) + ] + +roomOctogon :: Room +roomOctogon = defaultRoom + { _rmPolys = [poly ] + , _rmLinks = 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) + ] + +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 (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 + ,mntLightLnkCond (const True) + ] + (fmap connectRoom . randomiseOutLinks) =<< + changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts 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 rmPmnts plmnts corridorN)) + rcp <- roomCenterPillar + 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 rmPmnts (++ plmnts1) rcp + ] + (connectRoom $ set rmPmnts [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 & rmPmnts %~ (++ plmnts) + (fmap connectRoom . randomiseOutLinks) =<< filterLinks f theRoom + where + f (_,a) = a == 0 + +weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room)) +weaponLongCorridor = do + root <- takeOne [tEast, tWest] + connectingRoom <- takeOne + [tEast & rmPmnts .~ [spanLightI (V2 (-40) 40) (V2 (-40) 80)] + ] + 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 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 = 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 (Tree (Either Room 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) 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) (PutCrit autoCrit)) + [0,1,2] + ) :) + +shootersRoom :: RandomGen g => State g Room +shootersRoom = shootersRoom' <&> rmPmnts %~ + ( map (\i -> spNoID (PSRoomRand i) (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) + cornerRestrict (V2 x y,_) + = (x > 40 && x < h - 40) + || (y > 40 && y < h - 40) + let plmnts = replicate 8 (mntLightLnkCond cornerRestrict) + ++ + 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) (PutCrit pistolCrit) + ,spNoID (PSRoomRand 0) (PutCrit pistolCrit) + ,spNoID (PSRoomRand 0) (PutCrit pistolCrit) + ] + ++) + +shootingRange :: RandomGen g => State g (Tree (Either Room 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 + [Left rm1 + ,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20) + & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :) + ,Left rm2 + ,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20) + & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :) + ] + (Right rm3) + +spawnerRoom :: RandomGen g => State g (Tree (Either Room Room)) +spawnerRoom = do + x <- state $ randomR (250,300) + y <- state $ randomR (300,400) + roomWithSpawner <- roomC x y <&> + rmPmnts %~ (spNoID (PSRoomRand 0) (PutCrit spawnerCrit) :) + aRoom <- airlock + return $ treeFromTrunk [Left aRoom,Left corridor] $ connectRoom roomWithSpawner