module Dodge.Room.Room where import Dodge.Data import Dodge.RoomLink import Dodge.Default.Room import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Weapon.Launcher import Dodge.Creature import Dodge.Room.Foreground import Dodge.LevelGen.Data import Dodge.RandomHelp import Dodge.Default.Wall import Dodge.Tree import Dodge.Placement.Instance --import Dodge.LevelGen.Data import Dodge.Room.Procedural import Dodge.Room.Corridor import Dodge.Room.Link import Dodge.Room.Door import Dodge.Room.Airlock import Geometry import Tile import Control.Lens import Control.Monad.State import Control.Monad.Loops import System.Random import Data.Maybe import Data.Tree import Data.Bifunctor import Data.List roomC :: RandomGen g => Float -> Float -> State g Room roomC w h = do wl <- takeOne [ sPS (V2 0 0) 0 $ PutWall (rectNSWE (h-60) 0 (w/2-10) (w/2+10)) defaultCrystalWall , windowLine (V2 (w/2) 0) (V2 (w/2) (h-60)) ] changeLinkFrom fromCond $ roomRectAutoLinks w h & rmPmnts %~ (wl : ) & rmRandPSs .~ [farside] where fromCond (V2 x _,_) = x < w / 2 - 10 farside = do x <- state $ randomR (5, w/2 - 20) y <- state $ randomR (5, h - 70) a <- state $ randomR (0, 2*pi) return (V2 x y,a) roomPadCut :: [Point2] -> Point2 -> Room roomPadCut ps p = defaultRoom { _rmPolys = [ps] , _rmOutLinks = muout [(p,0)] , _rmInLinks = muin [(V2 0 0,pi)] , _rmPath = [(V2 0 0,p)] } roomPillars :: Room roomPillars = --over rmLinks init $ -- it is unclear to me the purpose of this: perhaps to get the in link in the center? set rmPmnts plmnts $ roomRect 240 240 2 2 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 (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] -> SubCompTree Room branchWith r ts = Node (PassDown r) $ return (UseAll door) : fmap (fmap PassDown) ts manyDoors :: Int -> SubCompTree Room manyDoors i = treeFromPost (replicate i (PassDown door)) $ UseAll door -- TODO: partially combine a room tree into a room glassLesson :: RandomGen g => State g (SubCompTree Room) glassLesson = do i <- takeOne [1,2,3] corridors <- replicateM i $ PassDown <$> randomiseOutLinks corridor return $ Node (PassDown botRoom) [singleUseNone door,uppers, treeFromPost (PassDown door : corridors) $ UseAll door] where uppers = Node (PassDown door) [singleUseNone topRoom] botRoom = set rmPmnts botplmnts $ roomRect 200 200 1 1 topRoom = set rmPmnts topplmnts $ roomRect 200 200 1 1 botplmnts = [sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall ,sPS (V2 50 100) 0 $ PutCrit miniGunCrit ,RandomPlacement $ takeOne [ spanLightI (V2 160 0) (V2 160 220) , mntLS vShape (V2 180 200) (V3 160 180 50) ] ] topplmnts = [windowLine (V2 100 200) (V2 100 0) ,sPS (V2 50 100) 0 $ PutCrit miniGunCrit --,sPS (V2 50 50) 0 putLamp ,RandomPlacement $ takeOne [ spanLightI (V2 160 (-20)) (V2 160 220) , mntLS vShape (V2 180 200) (V3 160 180 50) ] ] glassSwitchBack :: RandomGen g => State g Room glassSwitchBack = do wth <- state $ randomR (200,400) hgt <- state $ randomR (400,600) wllen <- state $ randomR (60,wth/2-40) let hf = hgt/5 con1 cond (UnusedLink (V2 x y) a) | cond y = Just (PS (V2 x y) a , PosPl (V2 x y) a) con1 _ _ = Nothing plmnts = [ mntLightLnkCond $ con1 (< 0.5 * hgt) , mntLightLnkCond $ con1 (> 0.5 * hgt) ,windowLine (V2 (wth-60 ) hf ) (V2 wllen hf ) ,windowLine (V2 (wth-wllen) (2*hf)) (V2 60 (2*hf)) ,windowLine (V2 (wth-60 ) (3*hf)) (V2 wllen (3*hf)) ,windowLine (V2 (wth-wllen) (4*hf)) (V2 60 (4*hf)) ,blockLine (V2 0 (1*hf)) (V2 wllen (1*hf)) ,blockLine (V2 (wth-wllen) (2*hf)) (V2 wth (2*hf)) ,blockLine (V2 0 (3*hf)) (V2 wllen (3*hf)) ,blockLine (V2 (wth-wllen) (4*hf)) (V2 wth (4*hf)) , sPS (V2 (wth/2) (hgt/2)) 0 putLamp ] let northPSs = do cry <- randomRanges [3*hf+10,4*hf-10 ,4*hf+10,5*hf-10 ] crx <- state $ randomR (wllen,wth-(wllen+40)) return (V2 crx cry,1.5*pi) midPS = return (V2 (wth-20) (hgt/2+40), pi) return $ roomRect wth hgt 2 4 & rmPmnts .~ plmnts & rmRandPSs .~ [northPSs,midPS] glassSwitchBackCrits :: RandomGen g => State g Room glassSwitchBackCrits = glassSwitchBack <&> rmPmnts %~ ([spNoID (PSRoomRand 0) (PutCrit miniGunCrit) , spNoID (PSRoomRand 1) randC1 ] ++) miniTree2 :: RandomGen g => State g (SubCompTree Room) miniTree2 = glassSwitchBackCrits >>= randomiseOutLinks >>= changeLinkTo (\p -> (sndV2 . fst) p < 70) <&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd) miniRoom3 :: RandomGen g => State g (SubCompTree Room) miniRoom3 = do w <- state $ randomR (300,400) h <- state $ randomR (300,400) let cp = V2 0 (h/2+40) let b = PutBlock StoneBlock [5,20,20] baseBlockPane $ map toV2 [(-10,-60) ,( 10,-60) ,( 10,-80) ,(-10,-80) ] let plmnts = [sPS cp 0 $ PutCrit miniGunCrit ,sPS cp 0 $ windowLineType (V2 0 (-40)) (V2 0 (-80)) ,sPS cp (1*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) ,sPS cp (2*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) ,sPS cp (3*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) ,sPS cp (4*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) ,sPS cp (5*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) ,sPS cp (6*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) ,sPS cp (7*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80)) ,sPS cp (pi/8) b ,sPS cp (pi/8+1*pi/4) b ,sPS cp (pi/8+2*pi/4) b ,sPS cp (pi/8+3*pi/4) b ,sPS cp (pi/8+4*pi/4) b ,sPS cp (pi/8+5*pi/4) b ,sPS cp (pi/8+6*pi/4) b ,sPS cp (pi/8+7*pi/4) b ,sPS (V2 (w/2) (h/2)) 0 putLamp ] fmap singleUseAll $ randomiseOutLinks $ set rmPmnts plmnts $ roomRectAutoLinks w h rot90Around :: Point2 -> Point2 -> Point2 rot90Around cen p = cen +.+ vNormal (p -.- cen) -- So, the idea is to attach outer children to the bottommost right nodes -- inside an inner tree roomMiniIntro :: RandomGen g => State g (SubCompTree Room) roomMiniIntro = do midroom <- join $ takeOne [miniTree2,glassLesson] return $ chainUses [return $ UseAll door, midroom,return $ UseAll corridor] roomCenterPillar :: RandomGen g => State g Room roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst) $ set rmPmnts plmnts $ roomRect 240 240 2 2 where plmnts = [ blockLine (V2 115 115) (V2 115 125) , blockLine (V2 125 115) (V2 125 125) --, sPS (V2 40 120) 0 putLamp --, sPS (V2 200 120) 0 putLamp , mntLightLnkCond unusedLnkToPS , mntLightLnkCond unusedLnkToPS ] roomOctogon :: Room roomOctogon = defaultRoom { _rmPolys = [poly ] , _rmOutLinks = muout $ init lnks , _rmInLinks = muin [last lnks] , _rmPath = allPairs $ map fst lnks -- this is too much , _rmPmnts = [] , _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ] , _rmFloor = [makeTileFromPoly poly 7] } where poly = map toV2 [(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)] lnks = map (first toV2) [((0,140),0) ,((35,125),negate $ pi/4) ,((-35,125),pi/4) ,( (50,90),negate $ pi/2) ,( (-50,90),pi/2) ,((35,55),negate $ 3*pi/4) ,((-35,55),3*pi/4) ,( (0,40),pi) ] roomNgon :: Int -> Float -> Room roomNgon n x = defaultRoom { _rmPolys = [poly] , _rmOutLinks = muout $init lnks , _rmInLinks = muin[last lnks] , _rmPath = [] -- TODO , _rmPmnts = [] , _rmBound = [poly] , _rmFloor = [makeTileFromPoly poly 9] , _rmName = show n ++ "gon" } where rot = 2*pi / fromIntegral n rots = map ((rot *) . fromIntegral) [0..n-1] poly = mapMaybe (\(ra,rb) -> intersectLineLine' (rotateV ra bl) (rotateV ra br) (rotateV rb bl) (rotateV rb br)) $ loopPairs rots bl = V2 x x br = V2 (-x) x lnks = sortOn ((\(V2 a b) -> (negate b,a)) . fst) $ map (\r -> (rotateV r (V2 0 x),r)) rots allPairs :: Eq a => [a] -> [(a,a)] allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y] {- Probabilites of the type of the first floor weapon. -} randFirstWeapon :: State StdGen PSType randFirstWeapon = do takeOne $ map PutFlIt $ replicate 10 pistol ++ replicate 5 ltAutoGun ++ replicate 5 spreadGun ++ replicate 5 multGun ++ replicate 2 autoGun ++ [launcher] weaponEmptyRoom :: RandomGen g => State g (SubCompTree Room) weaponEmptyRoom = do w <- state $ randomR (220,300) h <- state $ randomR (220,300) let plmnts = [sPS (V2 (w/2) (h-40)) 0 $ RandPS randFirstWeapon ,sPS (V2 20 20) (pi/2) randC1 ,sPS (V2 (w-20) 20) (pi/2) randC1 --,sPS (V2 (w/2) (h/2)) 0 putLamp ,mntLightLnkCond unusedLnkToPS ] treeFromTrunk [PassDown corridor] <$> ((fmap singleUseAll . randomiseOutLinks) =<< changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts plmnts $ roomRect w h 2 2) ) 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 ] let continuationRoom = treeFromTrunk [PassDown corridorN,PassDown corridorN] (singleUseAll (set rmPmnts plmnts corridorN)) rcp <- roomCenterPillar deadEndRoom' <- takeOne [roomPillars,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 ] (singleUseAll $ set rmPmnts [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN) weaponBetweenPillars :: RandomGen g => State g (SubCompTree Room) weaponBetweenPillars = do wpPos <- takeOne [V2 x y | x <- [20,120,220], y <- [20,120,220]] (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 singleUseAll . randomiseOutLinks) =<< filterLinks f theRoom where f (_,a) = a == 0 weaponLongCorridor :: RandomGen g => State g (SubCompTree Room) weaponLongCorridor = do root <- takeOne [tEast, tWest] connectingRoom <- takeOne [tEast & rmPmnts .~ [spanLightI (V2 (-40) 40) (V2 (-40) 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 ] , _rmOutLinks = muout $init lnks , _rmInLinks = 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) 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) -- the following was used to stop lights from being mounted in corners and -- potentially overlapping, might want to redo -- cornerRestrict (V2 x y,_) -- = (x > 40 && x < h - 40) -- || (y > 40 && y < h - 40) let plmnts = replicate 8 (mntLightLnkCond unusedLnkToPS) ++ concat [f x y | x<-xs,y<-ys] return $ roomRect w h (max i 2) (max i 2) & rmPmnts .~ plmnts & rmRandPSs .~ [rps] -- TODO remove possible identical draws on random PSs pistolerRoom :: RandomGen g => State g Room pistolerRoom = pillarGrid <&> rmPmnts %~ ( [spNoID (PSRoomRand 0) (PutCrit pistolCrit) ,spNoID (PSRoomRand 0) (PutCrit pistolCrit) ,spNoID (PSRoomRand 0) (PutCrit pistolCrit) ] ++) shootingRange :: RandomGen g => State g (SubCompTree Room) shootingRange = do rm1 <- shootersRoom1 >>= changeLinkTo (\(V2 _ y,_) -> y < 40) >>= changeLinkFrom (\(V2 _ y,r) -> y > 200 && r /= 0) rm2 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180) >>= changeLinkFrom (\(V2 _ y,r) -> y > 200 && r /= 0) rm3 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180) >>= changeLinkFrom (\(_,r) -> r == 0) return $ treeFromPost [PassDown rm1 ,PassDown $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20) & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :) ,PassDown rm2 ,PassDown $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20) & rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :) ] (UseAll rm3) spawnerRoom :: RandomGen g => State g (SubCompTree Room) spawnerRoom = do x <- state $ randomR (250,300) y <- state $ randomR (300,400) roomWithSpawner <- roomC x y <&> rmPmnts %~ (spNoID (PSRoomRand 0) (PutCrit spawnerCrit) :) aRoom <- airlock return $ treeFromTrunk [PassDown aRoom,PassDown corridor] $ singleUseAll roomWithSpawner