Work toward adding wiring

src/Dodge/Debug/LinkDecoration.hs

@@ -4,7 +4,7 @@ module Dodge.Debug.LinkDecoration
     ) where
 import Dodge.Data
 --import Dodge.Base
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.Picture.Layer
 import Picture
 import qualified IntMapHelp as IM

src/Dodge/Default/Room.hs

@@ -1,7 +1,7 @@
 module Dodge.Default.Room
     where
 import Geometry.Data
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 
 defaultRoom :: Room
 defaultRoom = Room
@@ -10,8 +10,8 @@ defaultRoom = Room
     , _rmPos    = []
     , _rmPath   = []
     , _rmPmnts  = []
-    , _rmPartialPmnt    = Nothing
+    , _rmPartPmnt   = Nothing
-    , _rmExtendedPmnt   = Nothing
+    , _rmExtPmnt    = Nothing
     , _rmBound      = []
     , _rmFloor      = []
     , _rmName       = "defaultRoom"
@@ -20,4 +20,5 @@ defaultRoom = Room
     , _rmRandPSs    = []
     , _rmLabel      = Nothing
     , _rmTakeFrom   = Nothing
+    , _rmWires      = []
     }

src/Dodge/Floor.hs

@@ -6,16 +6,7 @@ module Dodge.Floor
 import Geometry.Data
 import Dodge.Data
 import Dodge.Creature.State.Data
-import Dodge.Room.Procedural
-import Dodge.Room.RoadBlock
-import Dodge.Room.Data
 import Dodge.Room
-import Dodge.Room.Door
-import Dodge.Room.Branch
-import Dodge.Room.Boss
-import Dodge.Room.LongDoor
-import Dodge.Room.NoNeedWeapon
-import Dodge.Room.Link
 import Dodge.Placements.Button
 import Dodge.Layout.Tree.Polymorphic
 import Dodge.Layout.Tree.Either
@@ -38,10 +29,11 @@ import Data.Maybe
 initialAnoTree :: RandomGen g => Tree [Annotation g]
 initialAnoTree = padSucWithCorridors $ treeFromTrunk 
     [[StartRoom]
-    ,[SetLabel 0 $ return $ roomRectAutoLinks 100 100 
+    ,[ChainAnos [[SetLabel 0 $ return $ roomRectAutoLinks 100 100 
-        & rmExtendedPmnt ?~ externalButton red (anyLnkInPS 5)
+                    & rmExtPmnt ?~ externalButton red (anyLnkInPS 5) ]
-     ]
         ,[UseLabel 0 $ return switchDoorRoom]
+        ]
+     ]
     ,[SpecificRoom $ return $ connectRoom lasTunnel ]
     ,[SpecificRoom $ fmap connectRoom slowDoorRoom ]
     ,[Corridor]
@@ -113,12 +105,6 @@ layoutLevelFromSeed i seed = do
             putStr $ "Level generation with seed " ++ show seed ++ " failed: "
             let (seed',_) = random g
             layoutLevelFromSeed i' seed'
- -- where
- --   setLastLinkToUsed rm = case _rmLinks rm of
- --       (_:_) -> rm
- --           & rmLinks %~ init
- --           & rmUsedLinks %~ (last (_rmLinks rm) :)
- --       _ -> rm
 
 compactDrawTree :: Tree String -> String
 compactDrawTree = unlines . compactDraw
@@ -132,5 +118,4 @@ compactDraw (Node x ts0) = lines x ++ drawSubTrees ts0
         "|" : compactDraw t
     drawSubTrees (t:ts) =
         "|" : shift "+- " "|  " (compactDraw t) ++ drawSubTrees ts
-
     shift first other = zipWith (++) (first : repeat other)

src/Dodge/Layout.hs

@@ -1,8 +1,6 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Layout 
     ( generateLevelFromRoomList
---    , doPartialPlacements
---    , doExtendedPlacements
     ) where
 import Dodge.Data
 import Dodge.LevelGen
@@ -12,30 +10,30 @@ import Dodge.LevelGen.Pathing
 import Dodge.Wall.Zone
 import Dodge.GameRoom
 import Dodge.Bounds
-import Dodge.Room.Data
+--import Dodge.LevelGen.Data
-import Dodge.Room.AddTile
+import Dodge.Room.Foreground
 import Dodge.Default.Wall
 import Geometry
---import Geometry.Data
 import qualified IntMapHelp as IM
---import Dodge.Debug.LinkDecoration
 import Tile
 
 import Data.List (nubBy)
---import Control.Monad.State
+import Data.Traversable
 import Control.Lens
 import System.Random
 import Data.Foldable
 import qualified Control.Foldl as L
 import Data.Maybe
+import Data.Function
 
 generateLevelFromRoomList :: [Room] -> World -> World
 generateLevelFromRoomList gr w 
     = initWallZoning 
     . setupWorldBounds
-    . doPartialPlacements rs
+    . placeWires
-    . doExtendedPlacements rs
+    . doPartialPlacements
-    . flip (foldl' doRoomPlacements) rs
+    . doExtendedPlacements
+    . flip (mapAccumR doRoomPlacements) rs
     $ w { _walls        = wallsFromRooms rs
         , _floorTiles   = floorsFromRooms rs
         , _gameRooms    = gameRoomsFromRooms rs
@@ -48,29 +46,40 @@ generateLevelFromRoomList gr w
     rs = zipWith addTile zs gr
     zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
 
-doPartialPlacements :: [Room] -> (IM.IntMap [Placement],World) -> World
+placeWires :: (World,[Room])-> World
-doPartialPlacements rms (im,w) = foldr (doPartialPlacement im) w rms
+placeWires (w,rms) = foldr placeRoomWires w rms
 
-doPartialPlacement :: IM.IntMap [Placement] -> Room -> World -> World
+placeRoomWires :: Room -> World -> World
-doPartialPlacement im rm w = case _rmPartialPmnt rm of
+placeRoomWires rm w = foldr placeWire w (_rmWires rm)
-    Nothing -> w
+
+placeWire :: RoomWire -> World -> World
+placeWire rw w = case rw of
+    RoomWire (p,_) (q,_) -> w & foregroundShape %~ (thinHighBar 40 p q <>)
+
+doPartialPlacements :: ( (IM.IntMap [Placement],World) , [Room] ) -> (World,[Room])
+doPartialPlacements ((im,w),rms) = mapAccumR (doPartialPlacement im) w rms
+
+doPartialPlacement :: IM.IntMap [Placement] -> World -> Room -> (World, Room)
+doPartialPlacement im w rm = case _rmPartPmnt rm of
+    Nothing -> (w, rm)
     Just fi -> case _rmTakeFrom rm of
-        Nothing -> w
+        Nothing -> (w, rm)
-        Just i  -> fst $ fst $ placeSpot (w,rm) (fi (im IM.! i))
+        Just i  -> fst $ placeSpot (w,rm) (fi (im IM.! i))
 
-doExtendedPlacements :: [Room] -> World -> (IM.IntMap [Placement], World)
+doExtendedPlacements :: (World,[Room]) -> ( (IM.IntMap [Placement], World) , [Room] )
-doExtendedPlacements rms w = foldr doExtendedPlacement (IM.empty,w) rms
+doExtendedPlacements (w,rms) = mapAccumR doExtendedPlacement (IM.empty,w) rms
 
-doExtendedPlacement :: Room -> (IM.IntMap [Placement], World) -> (IM.IntMap [Placement], World)
+doExtendedPlacement :: (IM.IntMap [Placement], World) -> Room 
-doExtendedPlacement rm (im,w) = case _rmExtendedPmnt rm of
+    -> ( (IM.IntMap [Placement], World) , Room )
-    Nothing -> (im,w)
+doExtendedPlacement (im,w) rm = case _rmExtPmnt rm of
+    Nothing -> ( (im,w) , rm )
     Just plmnt -> case _rmLabel rm of
-        Nothing -> (im,w)
+        Nothing -> ( (im,w) , rm )
-        Just i  -> let ((neww,_),plmnts) = placeSpot (w,rm) plmnt
+        Just i  -> let ((neww,newrm),plmnts) = placeSpot (w,rm) plmnt
-            in (IM.insert i plmnts im, neww)
+            in ( (IM.insert i plmnts im, neww) , newrm )
 
-doRoomPlacements :: World -> Room -> World
+doRoomPlacements :: World -> Room -> (World, Room)
-doRoomPlacements w rm = fst $ foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm
+doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm
 
 setupWorldBounds :: World -> World
 setupWorldBounds w = w
@@ -93,9 +102,6 @@ setupWorldBounds w = w
 
 initWallZoning :: World -> World
 initWallZoning w = foldl' (flip insertWallInZones) (w & wallsZone . znObjects .~ IM.empty) (_walls w)
---initWallZoning w = set (wallsZone . znObjects) (foldl' (flip wallInZone) IM.empty (_walls w)) w
---  where
---    wallInZone wl = flip (foldl' (flip $ \(a,b) -> insertIMInZone a b (_wlID wl) wl)) (zoneOfWall wl)
 
 --makePath :: Tree Room -> [(Point2,Point2)]
 --makePath = concatMap _rmPath . flatten
@@ -168,3 +174,11 @@ floorsFromRooms = concatMap (concatMap tToRender . _rmFloor)
 --    f r = shiftRoomBy ( V2 0 0 -.- rotateV (pi-a) p , 0) $ shiftRoomBy (V2 0 0,pi-a)  r
 --      where 
 --        (p,a) = last $ _rmLinks r
+
+addTile :: Float -> Room -> Room
+addTile z r
+    | not (null (_rmFloor r)) || null rp = r
+    | otherwise = r & rmFloor .~ [makeTileFromPoly poly z]
+  where
+    rp = _rmPolys r
+    poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat rp

src/Dodge/Layout/Tree/Annotate.hs

@@ -15,9 +15,6 @@ data Annotation g
     = Lock Int
     | Key  Int
     | Corridor
-    | CorridorDebug
-    | SwitchDoorAno
-    | DoorNumAno Int
     | AirlockAno
     | FirstWeapon
     | StartRoom
@@ -28,6 +25,7 @@ data Annotation g
     | TreasureAno [Creature] [Item]
     | SetLabel Int (State g Room)
     | UseLabel Int (State g Room)
+    | ChainAnos [[Annotation g]]
 
 addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g])
 addLock i t = do
@@ -59,12 +57,13 @@ anoToRoomTree anos = case anos of
     [UseLabel i randrm] -> do
         rm <- randrm
         return $ connectRoom $ rm & rmTakeFrom ?~ i
+    [ChainAnos ass] -> do
+        rms <- mapM anoToRoomTree ass
+        return $ linkEitherTrees rms
     [OrAno as] -> do
         a <- takeOne as
         anoToRoomTree a
     [Corridor] -> pure . Right <$> randomiseOutLinks corridor
-    [CorridorDebug] -> pure . Right <$> randomiseOutLinks corridorDebug
---    [DoorAno] -> roomThenCorridor door
     [AirlockAno] -> airlock >>=  roomThenCorridor
     [FirstWeapon] -> do
         branchWP <- branchRectWith weaponRoom

src/Dodge/Layout/Tree/Either.hs

@@ -7,6 +7,7 @@ module Dodge.Layout.Tree.Either
     , connectRoom
     , connectTrunk
     , deadRoom
+    , linkEitherTrees
     ) where
 import Data.Tree
 
@@ -32,6 +33,11 @@ appendEitherTree
 appendEitherTree (Node (Left x) ts) ts'  = Node (Left x) $ map (`appendEitherTree` ts') ts
 appendEitherTree (Node (Right x) _) ts' = Node (Left x) ts'
 
+linkEitherTrees :: [Tree (Either a a)] -> Tree (Either a a)
+linkEitherTrees (t:s:ts) = linkEitherTrees (appendEitherTree t [s]:ts)
+linkEitherTrees [t] = t
+linkEitherTrees [] = error "tried to concatenate an empty list of either trees"
+
 removeEither :: Either p p -> p
 removeEither (Left y)  = y
 removeEither (Right y) = y

src/Dodge/Layout/Tree/Shift.hs

@@ -4,7 +4,7 @@ Creates a list of rooms; after this step the structure is determined by the actu
 module Dodge.Layout.Tree.Shift
     ( positionRooms
     ) where
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.Room.Link
 import Dodge.Layout.Tree.Polymorphic
 import Geometry.ConvexPoly

src/Dodge/LevelGen.hs

@@ -15,7 +15,6 @@ import Dodge.LevelGen.TriggerDoor
 import Dodge.LevelGen.Data
 import Dodge.Default.Wall
 import Dodge.RandomHelp
-import Dodge.Room.Data
 import Dodge.Placements.Spot
 import Geometry
 import Geometry.Vector3D
@@ -30,7 +29,7 @@ import qualified Data.IntSet as IS
 
 -- when placing a placement, we update the world and the room and assign an id
 -- to the placement
-placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement])
+placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement] )
 placeSpot (w,rm) plmnt = case plmnt of
     Placement{_plSpot = PSRoomRand i} -> placeSpotRoomRand rm i plmnt w
     Placement{_plSpot = PSLnk{}}      -> placeSpotUsingLink w rm plmnt
@@ -58,11 +57,11 @@ placeSpotUsingLink w rm plmnt = case lnks of
   where
     uselnk lnki = rm & rmLinks %~ deletei lnki
     rps = _plSpot plmnt
-    fallback = _psFallback rps
+    fallback = _psLnkFallback rps
-    test = _psLinkTest rps
+    test = _psLnkTest rps
     (lnks,g) = runState (shuffle $ filter (test . snd) $ zip [0..] 
         $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) $ _randGen w
-    f x (PSLnk t s _)
+    f x (PSLnk t s _ _)
         | t x = uncurry PS $ s x
     f _ ps = ps
     invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)

src/Dodge/LevelGen/Data.hs

@@ -5,6 +5,7 @@ import Dodge.Data
 import Picture
 import Geometry
 import Shape.Data
+import Data.Tile
 
 import Control.Lens
 import Control.Monad.State
@@ -33,9 +34,11 @@ data PSType = PutCrit {_unPutCrit :: Creature}
 -- maybe there is a monadic implementation of this?
 data PlacementSpot 
     = PS { _psPos :: Point2 , _psRot :: Float }
-    | PSLnk { _psLinkTest :: (Point2,Float) -> Bool
+    | PSLnk 
-            , _psLinkShift :: (Point2,Float) -> (Point2,Float)
+        { _psLnkTest        :: (Point2,Float) -> Bool
-            , _psFallback :: Maybe Placement
+        , _psLnkShift       :: (Point2,Float) -> (Point2,Float)
+        , _psLnkRoomEff     :: (Point2,Float) -> Room -> Room
+        , _psLnkFallback    :: Maybe Placement
         }
     | PSRoomRand { _psRoomRandPointNum :: Int }
 data Placement = Placement 
@@ -48,11 +51,11 @@ data Placement = Placement
   | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
 
 anyLnkOutPS :: PlacementSpot
-anyLnkOutPS = PSLnk (const True) id Nothing
+anyLnkOutPS = PSLnk (const True) id (const id) Nothing
 
 anyLnkInPS :: Float -- ^ amount to shift inward
     -> PlacementSpot
-anyLnkInPS x = PSLnk (const True) f Nothing
+anyLnkInPS x = PSLnk (const True) f (const id) Nothing
   where
     f (v,a) = (v -.- x *.* unitVectorAtAngle (a + 0.5 * pi), a+ pi)
 
@@ -104,6 +107,42 @@ addPlmnt pl pl2 = case pl2 of
     g Nothing = Just pl
     g (Just pl') = Just $ addPlmnt pl pl'
 
+{- 
+The '_rmPolys' list states which polygons should be cut out to form the indestructible walls of the room.
+Link pairs contain a position and rotation to attach to another room;
+0 is for links going to another room to the north, pi/2 for links going to a room to the west, etc.
+TODO : Explain path, does it need both directions?
+Placement spots allow things to be put in the room during level generation.
+Room bounds between a new room and previously placed rooms are checked during level generation,
+assigning no bounds will allow rooms to overlap.
+ -}
+data Room = Room
+    { _rmPolys  :: [ [Point2] ]
+    , _rmLinks  :: [(Point2,Float)]
+    , _rmPos    :: [RoomPos]
+    , _rmPath   :: [(Point2, Point2)]
+    , _rmPmnts  :: [Placement]
+    , _rmPartPmnt   :: Maybe ([Placement] -> Placement)
+    , _rmExtPmnt    :: Maybe Placement
+    , _rmBound  :: [ [Point2] ]
+    , _rmFloor  :: [Tile]
+    , _rmName   :: String
+    , _rmShift  :: (Point2, Float)
+    , _rmViewpoints :: [Point2]
+    , _rmRandPSs :: [State StdGen (Point2,Float)]
+    , _rmLabel      :: Maybe Int
+    , _rmTakeFrom   :: Maybe Int
+    , _rmWires      :: [RoomWire]
+    }
+data RoomWire
+    = RoomWire (Point2,Float) (Point2,Float)
+data RoomPos 
+    = OutLink Int    Point2  Float
+    | InLink  Point2 Float
+    | PosPl   Point2 Float
+    | LabPos  Int    RoomPos
+  deriving (Eq,Ord,Show)
+makeLenses ''Room
 makeLenses ''PSType
 makeLenses ''PlacementSpot
 makeLenses ''Placement

src/Dodge/Placements/Button.hs

@@ -38,5 +38,5 @@ putLitButtonID' col f subpl
   where
     changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
     ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
-    thePS = PSLnk f id Nothing
+    thePS = PSLnk f id (const id) Nothing
 

src/Dodge/Placements/LightSource.hs

@@ -27,9 +27,6 @@ mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _)
     V2 x y = rotateV 1 . (0.1 *.*) . normalizeV $ wallp -.- V2 lx ly
     setCol = maybe id colorSH mcol
 
-redMID :: (Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement)
-    -> Point2 -> Point3 -> Placement
-redMID f wallp lampp = f Nothing defaultLS wallp lampp (const Nothing)
 
 iShape :: Point2 -> Point3 -> Shape
 iShape wp (V3 x y z) = thinHighBar z wp (V2 x y)
@@ -80,17 +77,17 @@ vShape wallpos (V3 x y z) =
     wallposDown = wallpos -.- n
 
 mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement
-mntLS shp = redMID $ mntLSOn shp
+mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing)
 
 mntLSCond :: (Point2 -> Point3 -> Shape) -> ((Point2,Float) -> Bool) -> Placement
-mntLSCond shp cond = updatePSToLevel 2 (const $ PSLnk cond id Nothing) 
+mntLSCond shp cond = updatePSToLevel 2 (const $ PSLnk cond id (const id) Nothing) 
-    $ redMID (mntLSOn shp) 0 (V3 0 (-40) 40)
+    $ mntLS shp 0 (V3 0 (-40) 40)
     -- note that this perhaps pushes the vshape light out too far
 
 mntLight :: Point2 -> Point2 -> Placement
 mntLight a b = RandomPlacement $ do
     shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
-    return $ redMID (mntLSOn shp) a (addZ 50 b)
+    return $ mntLS shp a (addZ 50 b)
 
 mntLightLnkCond :: ((Point2,Float) -> Bool) -> Placement
 mntLightLnkCond f = RandomPlacement $ do

src/Dodge/Placements/Wall.hs

@@ -5,7 +5,6 @@ import Color
 import Geometry
 import Dodge.LevelGen.Data
 import Dodge.Default.Wall
-import Dodge.Room.Data
 
 import Data.List
 import Control.Lens

src/Dodge/Room.hs

@@ -4,7 +4,7 @@ Specification of individual rooms.
 module Dodge.Room
     ( module Dodge.Room.Room
     , module Dodge.Room.Foreground
-    , module Dodge.Room.Data
+    , module Dodge.LevelGen.Data
     , module Dodge.Room.Procedural
     , module Dodge.Room.Corridor
     , module Dodge.Room.Link
@@ -26,7 +26,7 @@ import Dodge.Room.RoadBlock
 import Dodge.Room.Teleport
 import Dodge.Room.Branch
 import Dodge.Room.Foreground
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.Room.Procedural
 import Dodge.Room.Corridor
 import Dodge.Room.Link

src/Dodge/Room/AddTile.hs

@@ -1,17 +0,0 @@
-module Dodge.Room.AddTile
-    where
-import Dodge.Room.Data
-import Tile
-import Geometry
-
-import Control.Lens
-import Data.List
-import Data.Function
-
-addTile :: Float -> Room -> Room
-addTile z r
-    | not (null (_rmFloor r)) || null rp = r
-    | otherwise = r & rmFloor .~ [makeTileFromPoly poly z]
-  where
-    rp = _rmPolys r
-    poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat rp

src/Dodge/Room/Airlock.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE TupleSections #-}
 {- Rooms that contain two doors and a switch alternating both.  -}
 module Dodge.Room.Airlock where
-import Dodge.Room.Data
 import Dodge.Placements
 import Dodge.Room.Foreground
 import Dodge.Default.Room

src/Dodge/Room/Boss.hs

@@ -4,12 +4,12 @@ module Dodge.Room.Boss
 import Dodge.Data
 import Dodge.Default.Room
 import Dodge.Placements
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.Room.Procedural
 import Dodge.Room.Link
 import Dodge.Room.Corridor
 import Dodge.Room.Path
-import Dodge.LevelGen.Data
+--import Dodge.LevelGen.Data
 import Dodge.Creature
 import Dodge.Creature.State.Data
 import Dodge.RandomHelp

src/Dodge/Room/Branch.hs

@@ -4,7 +4,7 @@ Collections of rooms that branch into multiple paths.
 module Dodge.Room.Branch
     where
 --import Geometry
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.Room.Door
 import Dodge.Room.Link
 import Dodge.Room.Procedural

src/Dodge/Room/CheckConsistency.hs

@@ -1,6 +1,6 @@
 module Dodge.Room.CheckConsistency
   where
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.Graph
 
 linksOnPath :: Room -> Bool

src/Dodge/Room/Corridor.hs

@@ -1,6 +1,6 @@
 module Dodge.Room.Corridor
     where
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 --import Dodge.Room.Foreground
 import Dodge.Default.Room
 --import Dodge.LevelGen.Data
@@ -29,26 +29,6 @@ corridor = defaultRoom
         ,((20,70), negate $ pi/6)
         ,((20,10)    ,pi)
         ]
-{- | Debug drop-in copy of corridor  -}
-corridorDebug :: Room
-corridorDebug = defaultRoom
-    { _rmPolys = 
-        [   rectNSWE 80 0 0 40
-        --,   [ (0,0), (0,200) , (200,100)]
-        --,   [ (0,0), (0,20) , (20,10)]
-        ]
-    , _rmLinks = lnks
-    , _rmPath  = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
-    , _rmPmnts    = []
-    , _rmBound = [ rectNSWE 50 30 0 40 ]
-    }
-  where 
-    lnks = map (first toV2)
-        [((20,70)  ,0)
-        ,((20,70), pi/6)
-        ,((20,70), negate $ pi/6)
-        ,((20,10)    ,pi)
-        ]
 corridorN :: Room
 corridorN = defaultRoom
     { _rmPolys = [rectNSWE 80 0 0 40

src/Dodge/Room/Data.hs

@@ -1,45 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Room.Data
-    where
-import Dodge.LevelGen.Data
-import Geometry.Data
-import Data.Tile
-
-import Control.Monad.State
-import System.Random
-import Control.Lens
---import qualified Data.IntMap.Strict as IM
-{- 
-The '_rmPolys' list states which polygons should be cut out to form the indestructible walls of the room.
-Link pairs contain a position and rotation to attach to another room;
-0 is for links going to another room to the north, pi/2 for links going to a room to the west, etc.
-TODO : Explain path, does it need both directions?
-Placement spots allow things to be put in the room during level generation.
-Room bounds between a new room and previously placed rooms are checked during level generation,
-assigning no bounds will allow rooms to overlap.
- -}
-data Room = Room
-    { _rmPolys  :: [ [Point2] ]
-    , _rmLinks  :: [(Point2,Float)]
-    , _rmPos    :: [RoomPos]
-    , _rmPath   :: [(Point2, Point2)]
-    , _rmPmnts  :: [Placement]
-    , _rmPartialPmnt    :: Maybe ([Placement] -> Placement)
-    , _rmExtendedPmnt   :: Maybe Placement
-    , _rmBound  :: [ [Point2] ]
-    , _rmFloor  :: [Tile]
-    , _rmName   :: String
-    , _rmShift  :: (Point2, Float)
-    , _rmViewpoints :: [Point2]
-    , _rmRandPSs :: [State StdGen (Point2,Float)]
-    , _rmLabel      :: Maybe Int
-    , _rmTakeFrom   :: Maybe Int
-    }
-data RoomPos 
-    = OutLink Int Point2 Float
-    | InLink  Point2 Float
-    | PosInt Int Point2 Float
-    | PosPl  Point2 Float
-  deriving (Eq,Ord,Show)
-makeLenses ''Room

src/Dodge/Room/Door.hs

@@ -3,7 +3,6 @@ module Dodge.Room.Door
     where
 import Geometry
 import Dodge.Data
-import Dodge.Room.Data
 import Dodge.Default.Room
 import Dodge.Placements
 import Color
@@ -32,7 +31,7 @@ switchDoorRoom = defaultRoom
     { _rmPolys = [rectNSWE 40 0 0 40]
     , _rmLinks = lnks
     , _rmPath  = [(V2 20 35,V2 20 5)]
-    , _rmPartialPmnt = Just f
+    , _rmPartPmnt = Just f
 -- door extends into side walls (for shadows as rendered 12/03)
 -- note no bounds
     }

src/Dodge/Room/Foreground.hs

@@ -1,11 +1,8 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Room.Foreground
     where
---import Dodge.Picture
---import Dodge.Base
 import Picture
 import Geometry
---import Geometry.Data
 import Geometry.Vector3D
 import Shape
 import Quaternion

src/Dodge/Room/Link.hs

@@ -16,7 +16,7 @@ module Dodge.Room.Link
     , setLastLinkToUsed
     ) where
 import Dodge.LevelGen
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.RandomHelp
 import Geometry
 import Data.Tile

src/Dodge/Room/Listed.hs

@@ -1,7 +0,0 @@
-module Dodge.Room.Listed
-    ( roomList
-    ) where
-import Dodge.Room.Data
-
-roomList :: [Room]
-roomList = []

src/Dodge/Room/LockAndKeyList.hs

@@ -1,6 +1,6 @@
 module Dodge.Room.LockAndKeyList
     where
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.Room.RoadBlock
 import Dodge.Room.Boss
 

src/Dodge/Room/LongDoor.hs

@@ -5,12 +5,12 @@ module Dodge.Room.LongDoor
     where
 import Dodge.Data
 import Dodge.Default.Room
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.Placements
 import Dodge.Room.Link
 import Dodge.Room.Procedural
 --import Dodge.Layout.Tree.Either
-import Dodge.LevelGen.Data
+--import Dodge.LevelGen.Data
 import Dodge.LevelGen.Switch
 import Dodge.RandomHelp
 import Dodge.Creature.Inanimate

src/Dodge/Room/NoNeedWeapon.hs

@@ -6,11 +6,11 @@ import Dodge.Data
 import Dodge.Creature
 import Dodge.Creature.State.Data
 --import Dodge.Creature.Inanimate
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.Room.Procedural
 import Dodge.Room.Link
 import Dodge.RandomHelp
-import Dodge.LevelGen.Data
+--import Dodge.LevelGen.Data
 import Geometry.Data
 
 import Control.Lens

src/Dodge/Room/Path.hs

@@ -5,7 +5,7 @@ module Dodge.Room.Path
     , createPathGrid
     )
     where
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.LevelGen.StaticWalls
 import Geometry
 

src/Dodge/Room/Procedural.hs

@@ -11,7 +11,6 @@ module Dodge.Room.Procedural
     ) where
 import Dodge.Data
 import Dodge.Default.Wall
-import Dodge.Room.Data
 import Dodge.Placements
 import Dodge.Room.Link
 import Dodge.Room.Path

src/Dodge/Room/RoadBlock.hs

@@ -2,14 +2,13 @@
 module Dodge.Room.RoadBlock
     where
 import Geometry
---import Dodge.Data
 import Dodge.Default.Room
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.Room.Link
 import Dodge.Placements
 import Dodge.Room.Corridor
 import Dodge.Room.Furniture
-import Dodge.LevelGen.Data
+--import Dodge.LevelGen.Data
 --import Dodge.Default.Wall
 --import Dodge.RandomHelp
 import Dodge.Creature

src/Dodge/Room/Room.hs

@@ -10,7 +10,7 @@ import Dodge.Default.Wall
 import Dodge.Layout.Tree.Polymorphic
 import Dodge.Layout.Tree.Either
 import Dodge.Placements
-import Dodge.Room.Data
+--import Dodge.LevelGen.Data
 import Dodge.Room.Procedural
 import Dodge.Room.Corridor
 import Dodge.Room.Link

src/Dodge/Room/Start.hs

@@ -1,5 +1,5 @@
 module Dodge.Room.Start where
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.Room.Door
 import Dodge.Room.Link
 import Dodge.Room.Procedural
@@ -7,7 +7,7 @@ import Dodge.Room.Foreground
 import Dodge.Room.Furniture
 import Dodge.Placements
 import Dodge.Layout.Tree.Polymorphic
-import Dodge.LevelGen.Data
+--import Dodge.LevelGen.Data
 import Geometry.Data
 import Color
 import Shape
@@ -25,13 +25,8 @@ startRoom :: RandomGen g => State g (Tree (Either Room Room))
 startRoom = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (200,400)
-    let fground = sPS (V2 0 0) 0 $ PutForeground $ 
+    let plmnts = 
-            girderV 40 20 10 (V2  0    (h/2)) (V2  w    (h/2))
+            [ sPS (V2 0 0) 0 $ PutForeground $ girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2))
-    treeFromPost [Left rezBox, Left door] . Right 
-        <$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0) 
-            $ roomRectAutoLinks w h & rmPmnts %~ 
-            (
-            [ fground
             , mntLS jShape (V2 0 (h/3)) (V3 40 (h/3) 70)
             , tankSquareEmboss4 (dim orange) 50 (h-60)
             , tankSquare (dim orange) 50 50
@@ -39,6 +34,9 @@ startRoom = do
             , lightSensor (V2 (0.8*w) (0.25*h)) 0
             , putLasTurret & plSpot .~ PS (V2 (0.8*w) (0.8*h)) 0
             , sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
-            ] ++
+            ]
-            ) 
+    treeFromPost [Left rezBox, Left door] . Right 
+        <$> randomiseOutLinks 
+            (shiftRoomBy (V2 (-20) (-20),0) 
+            $ roomRectAutoLinks w h & rmPmnts %~ (plmnts ++) 
             )

src/Dodge/Room/Teleport.hs

@@ -3,10 +3,10 @@ module Dodge.Room.Teleport
     where
 import Dodge.Data
 import Dodge.Base
-import Dodge.Room.Data
+import Dodge.LevelGen.Data
 import Dodge.Room.Procedural
 import Dodge.Placements
-import Dodge.LevelGen.Data
+--import Dodge.LevelGen.Data
 import Geometry
 import Picture
 import Dodge.WorldEvent.Explosion

src/Dodge/Room/Treasure.hs

@@ -5,7 +5,6 @@ Typically dead ends.
 module Dodge.Room.Treasure
     where
 import Dodge.Data
-import Dodge.Room.Data
 import Dodge.Placements
 import Dodge.Default.Room
 import Dodge.LevelGen.Data