From a1c344a342407bc846040ab0686213c0cbe32a55 Mon Sep 17 00:00:00 2001 From: jgk Date: Wed, 21 Apr 2021 13:00:11 +0200 Subject: [PATCH] Implement first weapon into tree structure --- src/Dodge/Floor.hs | 27 ++++++++------- src/Dodge/Layout/Tree/Annotate.hs | 17 ++++++++-- src/Dodge/Layout/Tree/Either.hs | 2 ++ src/Dodge/Layout/Tree/GenerateStructure.hs | 1 - src/Dodge/Room.hs | 39 ++++++++++++---------- src/Dodge/Room/Corridor.hs | 12 ++++--- src/Dodge/Room/Data.hs | 14 ++++++++ src/Dodge/Room/Link.hs | 18 ++++++++-- src/Dodge/Room/Procedural.hs | 3 ++ 9 files changed, 93 insertions(+), 40 deletions(-) diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index ae8d86094..6d7bf749c 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -33,10 +33,13 @@ import System.Random roomTreex :: RandomGen g => State g (Maybe [Room]) roomTreex = do - struct <- aTreeStrut + struct' <- aTreeStrut + let struct = Node () [] -- t <- randomPadCorridors $ fmap (const []) struct - let t = padCorridors $ fmap (const []) struct - fmap shiftExpandTree $ mapM annoToRoom t + let t' = padCorridors $ fmap (const []) struct + t = treeTrunk [[StartRoom],[Corridor],[FirstWeapon],[Corridor]] t' +-- fmap shiftExpandTree $ mapM annoToRoom t + fmap (shiftExpandTree . expandTreeBy id) $ mapM annoToRoomTree t roomTreex' :: RandomGen g => State g (Maybe [Room]) roomTreex' = do @@ -64,7 +67,7 @@ lev1' = do ] ++ [return $ connectRoom corridor ,return $ connectRoom door - ,glassSwitchBack >>= (fmap connectRoom . randLinks)] + ,glassSwitchBack >>= (fmap connectRoom . randomiseOutLinks)] ++ [return $ connectRoom corridor ,return $ connectRoom door] ++ [miniRoom3] @@ -74,25 +77,25 @@ lev1' = do ++ [return $ connectRoom corridor ,return $ connectRoom door] ++[roomMiniIntro] - ++ [longRoom >>= (fmap connectRoom . randLinks)] + ++ [longRoom >>= (fmap connectRoom . randomiseOutLinks)] ++ [return $ connectRoom corridor ,return $ connectRoom door] ++ firstWeapon ++ [return $ connectRoom corridor ,return $ connectRoom door] - ++ [(fmap connectRoom . randLinks) =<< pistolerRoom] + ++ [(fmap connectRoom . randomiseOutLinks) =<< pistolerRoom] ++ [return $ connectRoom door] - ++ [(fmap connectRoom . randLinks) =<< shooterRoom] - ++ (replicate 3 $ (fmap connectRoom . randLinks) corridor) + ++ [(fmap connectRoom . randomiseOutLinks) =<< shooterRoom] + ++ (replicate 3 $ (fmap connectRoom . randomiseOutLinks) corridor) ++ [return $ connectRoom (set rmPS [PS (20,40) 0 basicLS] corridor)] ++ [return $ connectRoom corridor] - ++ (replicate 3 $ (fmap connectRoom . randLinks) corridor) + ++ (replicate 3 $ (fmap connectRoom . randomiseOutLinks) corridor) ++ [return $ connectRoom corridor] ++[return $ connectRoom corridor,return $ connectRoom door] ++ [shootingRange] - ++ (replicate 3 $ (fmap connectRoom . randLinks) corridor) + ++ (replicate 3 $ (fmap connectRoom . randomiseOutLinks) corridor) ++[roomMiniIntro] - ++ (replicate 3 $ (fmap connectRoom . randLinks) corridor) + ++ (replicate 3 $ (fmap connectRoom . randomiseOutLinks) corridor) ++ [return $ connectRoom corridor ,return $ connectRoom door ,slowDoorRoom] @@ -101,7 +104,7 @@ lev1' = do ,return $ connectRoom corridor ] ) - $ (fmap connectRoom . randLinks) corridor + $ (fmap connectRoom . randomiseOutLinks) corridor roomToLevel2 :: RandomGen g => State g (Tree (Either Room Room)) roomToLevel2 = join $ takeOne diff --git a/src/Dodge/Layout/Tree/Annotate.hs b/src/Dodge/Layout/Tree/Annotate.hs index 5d3ddfc15..ea68ee88d 100644 --- a/src/Dodge/Layout/Tree/Annotate.hs +++ b/src/Dodge/Layout/Tree/Annotate.hs @@ -18,6 +18,8 @@ data Annotation = Lock Int | Key Int | Corridor + | FirstWeapon + | StartRoom addLock :: RandomGen g => Int -> Tree [Annotation] -> State g (Tree [Annotation]) addLock i t = do @@ -34,9 +36,20 @@ randomPadCorridors (Node x xs) = do xs' <- mapM randomPadCorridors xs return $ treeTrunk (replicate n [Corridor]) (Node x xs') +annoToRoomTree :: RandomGen g => [Annotation] -> State g (Tree (Either Room Room)) +annoToRoomTree [Corridor] = fmap (pure . Right) $ randomiseOutLinks corridor +annoToRoomTree [FirstWeapon] = weaponRoom +annoToRoomTree _ = do + w <- state $ randomR (100,400) + h <- state $ randomR (200,400) + fmap (pure . Right) $ return (roomRectAutoLinks w h) >>= randomiseOutLinks + annoToRoom :: RandomGen g => [Annotation] -> State g Room -annoToRoom [Corridor] = takeOne [corridor] -annoToRoom _ = randLinks $ roomRectAutoLinks 200 200 +annoToRoom [Corridor] = randomiseOutLinks corridor +annoToRoom _ = do + w <- state $ randomR (100,400) + h <- state $ randomR (200,400) + return (roomRectAutoLinks w h) >>= randomiseOutLinks annoToRoom' :: [Annotation] -> Room annoToRoom' [Corridor] = corridor diff --git a/src/Dodge/Layout/Tree/Either.hs b/src/Dodge/Layout/Tree/Either.hs index ad05f067e..b0a61a7e4 100644 --- a/src/Dodge/Layout/Tree/Either.hs +++ b/src/Dodge/Layout/Tree/Either.hs @@ -34,3 +34,5 @@ Make a singleton dead end of an Either Tree. -} deadRoom :: a -> Tree (Either a a) deadRoom r = Node (Left r) [] + + diff --git a/src/Dodge/Layout/Tree/GenerateStructure.hs b/src/Dodge/Layout/Tree/GenerateStructure.hs index a254e6e38..7a65d7136 100644 --- a/src/Dodge/Layout/Tree/GenerateStructure.hs +++ b/src/Dodge/Layout/Tree/GenerateStructure.hs @@ -53,4 +53,3 @@ aTreeStrut = do let trunk = treePath d return $ foldr (uncurry addBranchAt) trunk $ zip bds bs - diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 43e23879a..6254aa8fa 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -169,7 +169,7 @@ 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 $ randLinks corridor + 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 @@ -212,7 +212,7 @@ miniRoom1 = do return $ set rmPS plmnts $ shiftRoomBy ((0,40),0) $ roomRect' wth hgt 2 4 miniTree2 :: RandomGen g => State g (Tree (Either Room Room)) -miniTree2 = miniRoom1 >>= randLinks >>= changeLinkTo (\p -> (snd . fst) p < 70) +miniTree2 = miniRoom1 >>= randomiseOutLinks >>= changeLinkTo (\p -> (snd . fst) p < 70) >>= return . flip branchWith (replicate 3 $ treePost [door,corridor] critInDeadEnd ) @@ -245,7 +245,7 @@ miniRoom3 = do ,PS cp (pi/8+7*pi/4) b ,PS (w/2,h/2) 0 putLamp ] - fmap connectRoom $ randLinks $ set rmPS plmnts $ roomRectAutoLinks w h + fmap connectRoom $ randomiseOutLinks $ set rmPS plmnts $ roomRectAutoLinks w h rot90Around :: Point2 -> Point2 -> Point2 rot90Around cen p = cen +.+ vNormal (p -.- cen) @@ -258,7 +258,7 @@ roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treePost ,join $ takeOne [miniTree2,glassLesson] -- ,join $ takeOne [miniRoom1] ] - $ fmap connectRoom $ randLinks corridor + $ 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) [] @@ -332,7 +332,7 @@ weaponEmptyRoom = do ,PS (w-20,20) (pi/2) $ randC1 ,PS (w/2,h/2) 0 $ putLamp ] - (fmap connectRoom . randLinks) =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst) + (fmap connectRoom . randomiseOutLinks) =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst) $ set rmPS plmnts $ roomRect' w h 2 2) @@ -377,7 +377,7 @@ weaponBetweenPillars = do ,PS crPos1 (d crPos1) $ randC1 ,PS crPos2 (d crPos2) $ randC1 ] - (fmap connectRoom . randLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars) + (fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars) where f (_,a) = a == 0 blockedCorridor :: RandomGen g => State g (Tree (Either Room Room)) @@ -387,21 +387,24 @@ blockedCorridor = do let plmnts = [PS (20,40) r $ PutBlock [5,5,5] (150/256, 75/256, 0, 250/256) $ reverse $ rectNSWE 10 (-10) (-10) 10 ] - sequence $ treePost (replicate n $ fmap Left $ randLinks corridor) + 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,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 corridor) (connectRoom $ putCrs connectingRoom) - let branch2 = treeTrunk (replicate i2 $ Left corridor) (deadRoom $ putWp corridorN) + 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 = set rmPS [PS (10,40) (-pi/2) $ randC + 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 ] @@ -424,11 +427,11 @@ deadEndRoom = Room weaponRoom :: RandomGen g => State g (Tree (Either Room Room)) weaponRoom = do - x <- takeOne [weaponEmptyRoom + x <- takeOne --[weaponEmptyRoom --, weaponUnderCrits - , weaponBehindPillar - , weaponBetweenPillars - , weaponLongCorridor + --, weaponBehindPillar + --, weaponBetweenPillars + [ weaponLongCorridor ] x @@ -445,7 +448,7 @@ branchRectWith t = do x <- state $ randomR (100,200) y <- state $ randomR (100,200) b <- t - root <- randLinks $ roomRectAutoLinks x y + 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 @@ -648,5 +651,5 @@ spawnerRoom = do ,PS (x/2, y-10) 0 putLamp ] let f ((lx,_),_) = lx < x/2-5 - roomWithSpawner <- (fmap connectRoom . randLinks) =<< (filterLinks f $ set rmPS plmnts $ roomRect' x y 2 2) + roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ set rmPS plmnts $ roomRect' x y 2 2) return $ treeTrunk [Left (airlock 0)] roomWithSpawner diff --git a/src/Dodge/Room/Corridor.hs b/src/Dodge/Room/Corridor.hs index 055717ce1..bbbfb7ff1 100644 --- a/src/Dodge/Room/Corridor.hs +++ b/src/Dodge/Room/Corridor.hs @@ -6,19 +6,21 @@ import Geometry corridor :: Room corridor = Room { _rmPolys = [rectNSWE 80 0 0 40 - ,[(0,80), (0,80) +.+ rotateV (pi/3) (40,0),(40,80)] - ,[(40,0), (0,0) +.+ rotateV (0-pi/3) (40,0),( 0, 0)] +-- ,[(0,80), (0,80) +.+ rotateV (pi/3) (40,0),(40,80)] +-- ,[(40,0), (0,0) +.+ rotateV (0-pi/3) (40,0),( 0, 0)] ] , _rmLinks = lnks , _rmPath = concatMap (doublePair . (,) (20,60)) $ map fst lnks , _rmPS = [] - , _rmBound = [] -- rectNSWE 50 30 0 40 + , _rmBound = rectNSWE 50 30 0 40 } where lnks = [((20,70) ,0) - ,((20,80) +.+ rotateV (0-pi/3) (-10,0), pi/6) - ,((20,80) +.+ rotateV ( pi/3) ( 10,0),0-pi/6) +-- ,((20,80) +.+ rotateV (0-pi/3) (-10,0), pi/6) +-- ,((20,80) +.+ rotateV ( pi/3) ( 10,0),0-pi/6) + ,((20,70), pi/6) + ,((20,70), 0-pi/6) ,((20,10) ,pi) ] corridorN :: Room diff --git a/src/Dodge/Room/Data.hs b/src/Dodge/Room/Data.hs index 49cdcbd76..26b771c99 100644 --- a/src/Dodge/Room/Data.hs +++ b/src/Dodge/Room/Data.hs @@ -18,3 +18,17 @@ data RoomLink = RL {_rlPos :: Point2, _rlRot :: Float} makeLenses ''Room makeLenses ''RoomLink + +-- want to split a room into its dimensions and contents + +data Room' = Room' + { _dimensions :: Dimensions + , _contents :: [PlacementSpot] + } + +data Dimensions = Dimensions + { _dmPolys :: [[Point2]] + , _dmLinks :: [(Point2,Float)] + , _dmPath :: [(Point2, Point2)] + , _dmBound :: [Point2] + } diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index 1fb8de1a3..bd536e34c 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -1,3 +1,10 @@ +{- +Concerns link pairs of rooms. +Link pairs determine where rooms can attach to each other; each pair consists +of a position and a rotation. +The last link in the list is considered the incoming link, the other links are +the outgoing links. +-} module Dodge.Room.Link where import Dodge.LevelGen @@ -11,11 +18,18 @@ import Control.Monad.State import Control.Lens import Data.List (delete) -randLinks :: RandomGen g => Room -> State g Room -randLinks r = do +{- Shuffle the initial links of a room randomly. -} +randomiseOutLinks :: RandomGen g => Room -> State g Room +randomiseOutLinks r = do newLinks <- shuffle $ init $ _rmLinks r return $ r {_rmLinks = newLinks ++ [last $ _rmLinks r]} +{- Shuffle all links of a room randomly. -} +randomiseAllLinks :: RandomGen g => Room -> State g Room +randomiseAllLinks r = do + newLinks <- shuffle $ _rmLinks r + return $ r {_rmLinks = newLinks} + filterLinks :: RandomGen g => ((Point2,Float) -> Bool) -> Room -> State g Room filterLinks cond r = do newLinks <- shuffle $ filter cond $ init $ _rmLinks r diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index 2fdb4a188..64833aa28 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -8,6 +8,8 @@ import Geometry import Data.List (nub,sortBy) import Data.Function (on) +--import Control.Monad.State +--import System.Random {- A simple rectangular room with a light in the center. Creates links and pathfinding graph. @@ -58,3 +60,4 @@ makeRect x y = [((0,0),(x,0)) linksAndPath :: [(Point2,Float)] -> [(Point2,Point2)] -> [(Point2,Point2)] linksAndPath lnks subpth = subpth ++ concatMap linkClosest lnks where linkClosest (p,_) = doublePair (p, head $ sortBy (compare `on` dist p) $ map fst subpth) +