Implement first weapon into tree structure

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
+    let t' = padCorridors $ fmap (const []) struct
-    fmap shiftExpandTree $ mapM annoToRoom t
+        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]
+         ++ [(fmap connectRoom . randomiseOutLinks) =<< shooterRoom]
-         ++ (replicate 3 $ (fmap connectRoom . randLinks) corridor)
+         ++ (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

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 [Corridor] = randomiseOutLinks corridor
-annoToRoom _ = randLinks $ roomRectAutoLinks 200 200
+annoToRoom _ = do
+    w <- state $ randomR (100,400)
+    h <- state $ randomR (200,400)
+    return (roomRectAutoLinks w h) >>= randomiseOutLinks
 
 annoToRoom' :: [Annotation] -> Room
 annoToRoom' [Corridor] = corridor

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) []
+
+

src/Dodge/Layout/Tree/GenerateStructure.hs

@@ -53,4 +53,3 @@ aTreeStrut = do
     let trunk = treePath d
     return $ foldr (uncurry addBranchAt) trunk $ zip bds bs
 
-

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 branch1 = treeTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom)
-    let branch2 = treeTrunk (replicate i2 $ Left corridor) (deadRoom $ putWp corridorN)
+    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
+                 --, weaponBehindPillar
-                 , weaponBetweenPillars
+                 --, weaponBetweenPillars
-                 , weaponLongCorridor
+                 [ 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

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)]
+--                 ,[(0,80), (0,80) +.+ rotateV (pi/3) (40,0),(40,80)]
-                 ,[(40,0), (0,0) +.+ rotateV (0-pi/3) (40,0),( 0, 0)]
+--                 ,[(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 (0-pi/3) (-10,0),  pi/6)
-        ,((20,80) +.+ rotateV (  pi/3) ( 10,0),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

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]
+    }

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
+{- Shuffle the initial links of a room randomly. -}
-randLinks r = do
+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

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)
+