module Dodge.Room.Room where import Data.Tile 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 MonadHelp import LensHelp --import qualified Data.Set as S 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)) ] randomiseAllLinks $ restrictOutLinks 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 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 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 ] 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 >>= randomiseAllLinks . restrictInLinks (\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 (fromIntegral i*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) | i <- [0..7::Int] ] ++ [ sPS cp (pi/8+fromIntegral i*pi/4) b | i <- [0..7::Int] ] ++ [ sPS cp 0 $ PutCrit miniGunCrit , sPS (V2 (w/2) (h/2)) 0 putLamp ] fmap singleUseAll $ shuffleLinks $ 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 = randomiseAllLinks . restrictInLinks ((\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 useUnusedLnk , mntLightLnkCond useUnusedLnk ] roomOctogon :: Room roomOctogon = defaultRoom { _rmPolys = [poly ] , _rmLinks = muout (init lnks) ++ muin [last lnks] , _rmPath = allPairs $ map fst lnks -- this is too much , _rmPmnts = [] , _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ] , _rmFloor = Tiled [makeTileFromPoly poly 7] } where poly = map toV2 [(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)] lnks = map (first toV2) [((0,140),0) ,((35,125),negate $ pi/4) ,((-35,125),pi/4) ,( (50,90),negate $ pi/2) ,( (-50,90),pi/2) ,((35,55),negate $ 3*pi/4) ,((-35,55),3*pi/4) ,( (0,40),pi) ] roomNgon :: Int -> Float -> Room roomNgon n x = defaultRoom { _rmPolys = [poly] , _rmLinks = map toBothLnk lnks -- muout (init lnks) ++ muin[last lnks] , _rmPath = [] -- TODO , _rmPmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ const . isInLnk] , _rmBound = [poly] , _rmFloor = Tiled [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 useUnusedLnk ] 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 let wpPos = unusedSpotNearInLink 100 ncrits <- state $ randomR (1,3) critPlacementSpots <- replicateM ncrits $ randDirPS $ unusedSpotAwayFromInLink 100 let theRoom = roomPillars & rmPmnts .++~ sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots return $ singleUseAll theRoom 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) ++ ) doubleCorridorBarrels :: RandomGen g => State g Room doubleCorridorBarrels = do h <- state $ randomR (200,300) let cond x = (sndV2 . fst) x < h - 40 return $ restrictInLinks cond $ roomRect 100 h 1 1 & rmPmnts .~ [blockLine (V2 50 50) (V2 50 h) ,sPS (V2 25 (h-25)) 0 $ PutCrit $ addArmour autoCrit ,sPS (V2 75 (h-30)) 0 $ PutCrit explosiveBarrel ,sPS (V2 75 (h-60)) 0 $ PutCrit explosiveBarrel ,sPS (V2 85 (h-10)) 0 $ PutCrit explosiveBarrel ,sPS (V2 85 (h-45)) 0 $ PutCrit explosiveBarrel ,sPS (V2 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 useUnusedLnk) ++ 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 >>= randomiseAllLinks . restrictInLinks (\(V2 _ y,_) -> y < 40) . restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0) rm2 <- shootersRoom >>= randomiseAllLinks . restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180) . restrictOutLinks (\(V2 _ y,r) -> y > 200 && r /= 0) rm3 <- shootersRoom >>= randomiseAllLinks . restrictInLinks (\(V2 x y,_) -> y < 10 && x > 20 && x < 180) . restrictOutLinks (\(_,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