Rename ItemAttachments

src/Dodge/Room/Procedural.hs

@@ -91,40 +91,34 @@ roomRect x y xn yn = defaultRoom
 zipCountDown :: [a] -> [(Int,a)]
 zipCountDown xs = zip [length xs - 1, length xs - 2 ..] xs
 
-lnkBothAnd :: RoomLinkType -> (Int -> RoomLinkType) 
-    -> (Int -> RoomLinkType)
+lnkBothAnd :: RoomLinkType -> (Int -> RoomLinkType) -> (Int -> RoomLinkType)
     -> Int -> (Int,(Point2,Float)) -> RoomLink
 lnkBothAnd rlt ltcon ltcon2 i (j,(p,a)) = RoomLink 
-    {_rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j]
-    ,_rlPos = p 
+    { _rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j]
+    , _rlPos = p 
     , _rlDir = a
     }
 {- Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size.  -}
 -- it is not clear to me that this works for very small rooms (but it does seem
 -- to do so)
 roomRectAutoLinks :: Float -> Float -> Room
-roomRectAutoLinks x y = (roomRect x y (f x) (f y)) 
-    {_rmPmnts = plmnts
-    ,_rmName = "autoRect"
-    }
+roomRectAutoLinks x y = roomRect x y (f x) (f y) 
+    & rmName .~ "autoRect"
+    & rmPmnts .~ [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp]
   where
     f z = max 1 $ (ceiling z - 40) `div` 60
-    plmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp]
 {- Combines two rooms into one room.
  - will have to work out exactly what to do with combining links
 Mostly involves concatenation.  -}
 combineRooms :: Room -> Room -> Room
 combineRooms r r' = defaultRoom
-    { _rmPolys = _rmPolys r ++ _rmPolys r'
-    , _rmLinks = _rmLinks r ++ _rmLinks r'
-    , _rmPath  = map clampPath $ _rmPath  r 
-              ++ _rmPath  r'
-    , _rmPmnts = _rmPmnts r ++ _rmPmnts r'
-    --, _rmPmnts    = map (shiftPlacement $ _rmShift r)  (_rmPmnts r) 
-    --          ++ map (shiftPlacement $ _rmShift r') (_rmPmnts r')
-    , _rmBound = _rmBound r ++ _rmBound r'
-    , _rmPos   = _rmPos r ++ _rmPos r'
-    , _rmFloor = combineFloors (_rmFloor r) (_rmFloor r')
+    { _rmPolys  = _rmPolys r ++ _rmPolys r'
+    , _rmLinks  = _rmLinks r ++ _rmLinks r'
+    , _rmPath   = map clampPath $ _rmPath  r ++ _rmPath  r'
+    , _rmPmnts  = _rmPmnts r ++ _rmPmnts r'
+    , _rmBound  = _rmBound r ++ _rmBound r'
+    , _rmPos    = _rmPos r ++ _rmPos r'
+    , _rmFloor  = combineFloors (_rmFloor r) (_rmFloor r')
     , _rmShift  = (V2 0 0 , 0)
     }
 -- not that this assumes that any link paths are integral
@@ -135,7 +129,7 @@ clampPath = bimap f f
     g = (fromIntegral :: Int -> Float) . floor
 
 combineFloors :: Floor -> Floor -> Floor
-combineFloors f _ = f
+combineFloors = const
 {- Randomly generate a top fourth of a room possibly with a wall.
 Add a light and a 'PutNothing' placement.  -}
 quarterRoomTri :: RandomGen g => Float -> State g Room
@@ -210,8 +204,8 @@ quarterRoomSquare w = do
 Tight corridors, random placements. -}
 randomFourCornerRoom :: RandomGen g => [Item] -> State g Room
 randomFourCornerRoom its = do
-    nCrits <- state $ randomR (1,3)
-    crits <- takeN nCrits <=< shuffle $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit]
+    nCrits  <- state $ randomR (1,3)
+    crits   <- takeN nCrits <=< shuffle $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit]
         ++ replicate 20 chaseCrit
     randomFourCornerRoomCrsIts crits its
 {- | A randomly generate room based on four randomly generated corners. 
@@ -231,28 +225,27 @@ centerVaultRoom
     -> Float    -- ^ Height
     -> Float    -- ^ Vault dimensions
     -> State g Room
-centerVaultRoom w h d = do
-    return $ defaultRoom
-        { _rmPolys  = [rectNSWE h (-h) (-w) w]
-        , _rmLinks  = 
-            [outLink (V2 0    h) 0   
-            ,outLink (V2 w    0) (-pi/2)
-            ,outLink (V2 (-w) 0) (pi/2) 
-            , inLink (V2 0   (-h)) pi ]
-        , _rmPath   = []
-        , _rmPmnts     = 
-            [sps0 $ PutWall (rectNSEW   d  (d - 30)   d  (d - 30)) defaultWall
-            ,sps0 $ PutWall (rectNSEW   d  (d - 30) (-d) (30 - d)) defaultWall
-            ,sps0 $ PutWall (rectNSEW (-d) (30 - d)   d  (d - 30)) defaultWall
-            ,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
-            ]
-            ++ map (\a -> mntLS vShape (rotateV a $ V2 0  d) (rotate3z a $ V3 0 (d+30) 70))
-                [0,0.5*pi,pi,1.5*pi]
-            ++ concatMap (\r -> map (shiftPlacement (V2 0 0,r)) theDoor) 
-                        [0,pi/2,pi,3*pi/2]
-        , _rmBound  = [rectNSWE h (-h) (-w) w]
-        , _rmName = "cenVault"
-        }
+centerVaultRoom w h d = return $ defaultRoom
+    { _rmPolys  = [rectNSWE h (-h) (-w) w]
+    , _rmLinks  = 
+        [outLink (V2 0    h) 0   
+        ,outLink (V2 w    0) (-pi/2)
+        ,outLink (V2 (-w) 0) (pi/2) 
+        , inLink (V2 0   (-h)) pi ]
+    , _rmPath   = []
+    , _rmPmnts     = 
+        [sps0 $ PutWall (rectNSEW   d  (d - 30)   d  (d - 30)) defaultWall
+        ,sps0 $ PutWall (rectNSEW   d  (d - 30) (-d) (30 - d)) defaultWall
+        ,sps0 $ PutWall (rectNSEW (-d) (30 - d)   d  (d - 30)) defaultWall
+        ,sps0 $ PutWall (rectNSEW (-d) (30 - d) (-d) (30 - d)) defaultWall
+        ]
+        ++ map (\a -> mntLS vShape (rotateV a $ V2 0  d) (rotate3z a $ V3 0 (d+30) 70))
+            [0,0.5*pi,pi,1.5*pi]
+        ++ concatMap (\r -> map (shiftPlacement (V2 0 0,r)) theDoor) 
+                    [0,pi/2,pi,3*pi/2]
+    , _rmBound  = [rectNSWE h (-h) (-w) w]
+    , _rmName = "cenVault"
+    }
   where
     col = dim $ dim $ bright red
     theDoor =