Add automatic girder light placement for rectangular rooms

src/Dodge/Default/Room.hs

@@ -29,4 +29,5 @@ defaultRoom = Room
     , _rmMID        = Nothing
     , _rmMParent    = Nothing
     , _rmChildren   = []
+    , _rmType       = DefaultRoomType
     }

src/Dodge/LevelGen/Data.hs

@@ -96,12 +96,23 @@ data Room = Room
     , _rmMID        :: Maybe Int
     , _rmMParent    :: Maybe Int
     , _rmChildren   :: [Int]
+    , _rmType       :: RoomType
     }
 data RoomLink = RoomLink
     { _rlType   :: S.Set RoomLinkType
     , _rlPos    :: Point2
     , _rlDir    :: Float
     } deriving (Eq,Ord)
+data RoomType = DefaultRoomType
+    | RectRoomType
+        { _numLinkEW :: Int
+        , _numLinkNS :: Int
+        , _linkGapEW :: Float
+        , _linkGapNS :: Float
+        , _rmWidth :: Float
+        , _rmHeight :: Float
+        }
+  deriving (Eq,Ord)
 data RoomLinkType
     = OutLink
     | InLink
@@ -174,6 +185,7 @@ data GenWorld = GenWorld
     }
 
 makeLenses ''Room
+makeLenses ''RoomType
 makeLenses ''PSType
 makeLenses ''PlacementSpot
 makeLenses ''Placement

src/Dodge/Room/Foreground.hs

@@ -111,13 +111,12 @@ girderV h d w x y = mconcat $
     evenDouble (a:_:xs) = a:a:evenDouble xs
     evenDouble xs = xs
 
-girderCol
+girder
-    :: Color
+    :: Float -- ^ height
-    -> Float -- ^ height
     -> Float -- ^ distance between cross bars
     -> Float -- ^ width
     -> Point2 -> Point2 -> Shape
-girderCol col h d w x y = colorSH col $ mconcat $
+girder h d w x y = mconcat $
     [ thinHighBar h xt yt
     , thinHighBar h xb yb
     ]
@@ -131,13 +130,6 @@ girderCol col h d w x y = colorSH col $ mconcat $
     ps = divideLineExact d xb yb
     qs = divideLineExact d xt yt
 
-girder 
-    :: Float -- ^ height
-    -> Float -- ^ distance between cross bars
-    -> Float -- ^ width
-    -> Point2 -> Point2 -> Shape
-girder = girderCol orange
-
 robotArm :: Shape
 robotArm = undefined
 

src/Dodge/Room/Pillar.hs

@@ -1,7 +1,7 @@
 module Dodge.Room.Pillar where
 import Dodge.Data
 import Dodge.PlacementSpot
-import Dodge.Room.Foreground
+import Dodge.Room.Modify.Girder
 import Dodge.LevelGen.Data
 import Dodge.Placement.Instance
 --import Dodge.LevelGen.Data
@@ -9,6 +9,8 @@ import Dodge.Room.Procedural
 import Geometry
 import LensHelp
 
+import Control.Monad.State
+import System.Random
 import qualified Data.Set as S
 
 blockPillar :: Float -> Float -> Placement
@@ -25,23 +27,34 @@ blockPillar w' h' = ps0jPushPS (aline tl tr)
     bl = V2 (-w) (-h)
     aline = PutLineBlock baseBlockPane StoneBlock 9 9
 
-
+crossPillar :: Float -> Float -> Placement
-roomPillars :: Float -> Float -> Float -> Int -> Int -> Room
+crossPillar w' h' = ps0jPushPS (aline (V2 (-w) 0) (V2 w 0))
-roomPillars pillarsize w h wn hn = r 
+    $ sps0 (aline (V2 0 (-h)) (V2 0 h))
-    & rmPmnts .~ plmnts
-    & rmName .~ "rectPillars"
   where
-    r = roomRect w h wn hn
+    w = w' - 9
-    pilw = (( w - 40 * (fromIntegral wn +1) ) / fromIntegral wn) - pillarsize
+    h = h' - 9
-    pilh = (( h - 40 * (fromIntegral hn +1) ) / fromIntegral hn) - pillarsize
+    aline = PutLineBlock baseBlockPane StoneBlock 9 9
-    npillars = length $ filter (S.member RoomPosOffPath . _rpType) $ _rmPos r
+
-    plmnts = spanLightI (V2 120 24) (V2 120 216) 
+
-        : mntLS vShape (V2 12 12) (V3 25 25 70)
+roomPillars :: RandomGen g => Float -> Float -> Float -> Int -> Int -> State g Room
-        : mntLS vShape (V2 228 228) (V3 215 215 70)
+roomPillars pillarsize w h wn hn = do
-        : sps0 (PutShape $ thinHighBar 75 (V2 26 25) (V2 120 25))
+    let rm = roomRect w h wn hn
-        : sps0 (PutShape $ thinHighBar 75 (V2 214 215) (V2 120 215))
+        npillars = length $ filter (S.member RoomPosOffPath . _rpType) $ _rmPos rm
-        : replicate npillars (blockPillar (0.5*pilw) (0.5*pilh) & plSpot .~ rprBool
+    let plmnts = -- sps0 (PutShape $ colorSH black $ girderV 96 20 10 (V2 0 120) (V2 w 120))
+--            : sps0 (PutShape $ colorSH black $ girderV 96 20 10 (V2 220 h) (V2 220 (h/2 + 10)))
+--            : sps0 (PutShape $ colorSH black $ girderV 96 20 10 (V2 120 0) (V2 120 (h/2 - 10)))
+--            : sps (PS (V2 20 120) 0) (PutLS $ lsColPos 0.75 (V3 0 0 90))
+--            : sps (PS (V2 (w - 20) 120) 0) (PutLS $ lsColPos 0.75 (V3 0 0 90))
+--            : sps (PS (V2 220 (h-20)) 0) (PutLS $ lsColPos 0.75 (V3 0 0 90))
+--            : sps (PS (V2 120 20) 0) (PutLS $ lsColPos 0.75 (V3 0 0 90))
+            replicate npillars (blockPillar (0.5*pilw) (0.5*pilh) & plSpot .~ rprBool
                     (\rp _ -> and [RoomPosOffPath `S.member` _rpType rp
                                 , _rpPlacementUse rp == 0
                                 , _rpLinkStatus rp == NotLink ] )
                 )
+    addGirderLights $ rm 
+        & rmPmnts .~ plmnts
+        & rmName .~ "rectPillars"
+  where 
+    pilw = (( w - 40 * (fromIntegral wn +1) ) / fromIntegral wn) - pillarsize
+    pilh = (( h - 40 * (fromIntegral hn +1) ) / fromIntegral hn) - pillarsize

src/Dodge/Room/Procedural.hs

@@ -63,6 +63,14 @@ roomRect x y xn yn = defaultRoom
             , _tileZ    = 16
             } ]
     , _rmRandPSs = [psRandRanges (10,x-10) (10,y-10) (0,2*pi)]
+    , _rmType = RectRoomType
+        { _numLinkEW = xn
+        , _numLinkNS = yn
+        , _linkGapEW = xd
+        , _linkGapNS = yd
+        , _rmWidth = x
+        , _rmHeight = y
+        }
     }
   where 
     roomposat onoffpath p = RoomPos p 0 (S.singleton onoffpath) NotLink 0

src/Dodge/Room/Room.hs

@@ -212,8 +212,9 @@ weaponUnderCrits = do
             [PassDown $ addwpat (V2 20 0) corridorN,PassDown $ addwpat (V2 20 0) corridorN] 
             (singleUseAll (set rmPmnts plmnts corridorN))
     rcp <- roomCenterPillar
+    rmpils <- roomPillars 30 240 240 2 2
     deadEndRoom' <- takeOne
-        [ addwpat (V2 120 20) (roomPillars 0 240 240 2 2)
+        [ addwpat (V2 120 20) rmpils
         , addwpat (V2 120 20) rcp]
     junctionRoom <- takeOne [PassDown tEast,PassDown tWest]
     return $ treeFromTrunk [PassDown corridorN,PassDown corridorN] 
@@ -242,8 +243,8 @@ weaponBehindPillar  = do
 
 weaponBetweenPillars :: RandomGen g => State g (SubCompTree Room)
 weaponBetweenPillars = do
-    w <- state $ randomR (240,360)
+    (w,wn) <- takeOne [(240,2),(340,3)]
-    h <- state $ randomR (240,360)
+    (h,hn) <- takeOne [(240,2),(340,3)]
     let wpPos = rprBool $ \rp r -> and 
             [ RoomPosOnPath `S.member` _rpType rp
             , _rpPlacementUse rp == 0
@@ -256,7 +257,7 @@ weaponBetweenPillars = do
             , _rpPlacementUse rp == 0
             , all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
             ]
-    let theRoom = roomPillars 0 w h 1 1 & rmPmnts .++~
+    theRoom <- roomPillars 30 w h wn hn <&> rmPmnts .++~
             sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots
     return $ singleUseAll theRoom