Add automatic girder light placement for rectangular rooms
This commit is contained in:
@@ -29,4 +29,5 @@ defaultRoom = Room
|
||||
, _rmMID = Nothing
|
||||
, _rmMParent = Nothing
|
||||
, _rmChildren = []
|
||||
, _rmType = DefaultRoomType
|
||||
}
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -111,13 +111,12 @@ girderV h d w x y = mconcat $
|
||||
evenDouble (a:_:xs) = a:a:evenDouble xs
|
||||
evenDouble xs = xs
|
||||
|
||||
girderCol
|
||||
:: Color
|
||||
-> Float -- ^ height
|
||||
girder
|
||||
:: 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
|
||||
|
||||
|
||||
+30
-17
@@ -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
|
||||
crossPillar w' h' = ps0jPushPS (aline (V2 (-w) 0) (V2 w 0))
|
||||
$ sps0 (aline (V2 0 (-h)) (V2 0 h))
|
||||
where
|
||||
w = w' - 9
|
||||
h = h' - 9
|
||||
aline = PutLineBlock baseBlockPane StoneBlock 9 9
|
||||
|
||||
roomPillars :: Float -> Float -> Float -> Int -> Int -> Room
|
||||
roomPillars pillarsize w h wn hn = r
|
||||
& rmPmnts .~ plmnts
|
||||
& rmName .~ "rectPillars"
|
||||
|
||||
roomPillars :: RandomGen g => Float -> Float -> Float -> Int -> Int -> State g Room
|
||||
roomPillars pillarsize w h wn hn = do
|
||||
let rm = roomRect w h wn hn
|
||||
npillars = length $ filter (S.member RoomPosOffPath . _rpType) $ _rmPos rm
|
||||
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
|
||||
r = roomRect w h wn hn
|
||||
pilw = (( w - 40 * (fromIntegral wn +1) ) / fromIntegral wn) - pillarsize
|
||||
pilh = (( h - 40 * (fromIntegral hn +1) ) / fromIntegral hn) - pillarsize
|
||||
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)
|
||||
: mntLS vShape (V2 228 228) (V3 215 215 70)
|
||||
: sps0 (PutShape $ thinHighBar 75 (V2 26 25) (V2 120 25))
|
||||
: sps0 (PutShape $ thinHighBar 75 (V2 214 215) (V2 120 215))
|
||||
: replicate npillars (blockPillar (0.5*pilw) (0.5*pilh) & plSpot .~ rprBool
|
||||
(\rp _ -> and [RoomPosOffPath `S.member` _rpType rp
|
||||
, _rpPlacementUse rp == 0
|
||||
, _rpLinkStatus rp == NotLink ] )
|
||||
)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
deadEndRoom' <- takeOne
|
||||
[ addwpat (V2 120 20) (roomPillars 0 240 240 2 2)
|
||||
rmpils <- roomPillars 30 240 240 2 2
|
||||
deadEndRoom' <- takeOne
|
||||
[ 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)
|
||||
h <- state $ randomR (240,360)
|
||||
(w,wn) <- takeOne [(240,2),(340,3)]
|
||||
(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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user