Fix bug in the placement of mounted lightsources when shifted

This commit is contained in:
2022-03-04 17:59:42 +00:00
parent d219f42640
commit 8fa6bbfe29
4 changed files with 17 additions and 39 deletions
+2 -3
View File
@@ -25,7 +25,6 @@ roomGlassOctogon
:: Float -- ^ Size
-> Room
roomGlassOctogon x = createPathGrid $ defaultRoom
--roomGlassOctogon x = defaultRoom
{ _rmPolys =
[rectNSWE x (-x) (-x) x
,rectNSWE 0 (-(x + 40)) (-20) 20
@@ -126,7 +125,7 @@ roomShuriken x y =
, _rmPmnts = [mntLS iShape (V2 x x) (V3 (x-20) x 70)]
, _rmBound = ps
}
in (foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2])
in (foldr1 combineRooms $ map (\r -> moveRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2])
{_rmName = "shuriken"}
{- | TODO: pathing
Precondition: first float is less than the second by at least 40. -}
@@ -151,5 +150,5 @@ roomTwistCross x y z =
, _rmPmnts = [mntLS iShape (V2 x x) (V3 (x-20) (x-20) 70)]
, _rmBound = map (expandPolyCorners 10) ps
}
in (foldr1 combineRooms $ map (\r -> shiftRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2])
in (foldr1 combineRooms $ map (\r -> moveRoomBy (V2 0 0, r) corner) [0,pi/2,pi,3*pi/2])
{_rmName = "twistCross" }
+7 -28
View File
@@ -12,7 +12,7 @@ module Dodge.Room.Procedural
import Dodge.Data
import Dodge.Placement.Shift
import Dodge.Default.Wall
import Shape.Data
--import Shape.Data
import Dodge.PlacementSpot
import Dodge.Placement.Instance
import Dodge.RoomLink
@@ -109,8 +109,8 @@ combineFloors :: Floor -> Floor -> Floor
combineFloors f _ = f
{- Randomly generate a top fourth of a room possibly with a wall.
Add a light and a 'PutNothing' placement. -}
quarterRoomFlat :: RandomGen g => Float -> State g Room
quarterRoomFlat w = do
quarterRoomTri :: RandomGen g => Float -> State g Room
quarterRoomTri w = do
let commonPlacements =
[ mntLS iShape (V2 (w-20) w) (V3 (w-20) (w-20) 70)
, sPS (V2 (w-20) (w-20)) pi PutNothing
@@ -140,26 +140,8 @@ quarterRoomFlat w = do
, _rmPmnts = b
, _rmBound = [[V2 0 0,V2 w w,V2 (-w) w]]
}
quarterRoomFlat' :: RandomGen g => (Point2 -> Point3 -> Shape) -> Color -> Float -> State g Room
quarterRoomFlat' mntshape col w = do
let b = [ mntLSLampCol mntshape col (V2 (w-20) w) (V3 (w-20) (w-20) 70)
]
pure $ defaultRoom
{ _rmPolys = [ [V2 0 0,V2 w w,V2 (-w) w] ]
, _rmLinks = [toBothLnk (V2 0 w, 0)]
, _rmPath = concatMap doublePair
[(V2 0 w,V2 0 (w-20))
,(V2 0 (w-20),V2 (w-20) (w-20))
,(V2 0 (w-20),V2 (55-w) (w-20))
,(V2 (55-w) (w-20),V2 (20-w) (w-20))
,(V2 0 (w-20),V2 0 0)
,(V2 (55-w) (w-20),V2 0 0)
]
, _rmPmnts = b
, _rmBound = [[V2 0 0,V2 w w,V2 (-w) w]]
}
fourthCornerWall :: RandomGen g => Float -> State g Room
fourthCornerWall w = do
quarterRoomSquare :: RandomGen g => Float -> State g Room
quarterRoomSquare w = do
b <- takeOne
[ [ mntLS vShape (V2 0 (2*w-20)) (V3 0 (2*w-40) 70)
, blockLine (V2 (w/2) (w/2)) (V2 0 w)
@@ -220,17 +202,14 @@ shufflePlacements r = do
Tight corridors, random placements. -}
randomFourCornerRoom :: RandomGen g => [Item] -> State g Room
randomFourCornerRoom its = do
corners <- replicateM 4 . join $ takeOne [quarterRoomFlat 100, fourthCornerWall 100]
-- corners <- sequence $ map (\s -> uncurry quarterRoomFlat' s 100) $ zip
-- [iShape,vShape,lShape,jShape]
-- [red,yellow,green,blue]
corners <- replicateM 4 . join $ takeOne [quarterRoomTri 100, quarterRoomSquare 100]
itms <- shuffle its
nCrits <- state $ randomR (1,3)
crits <- takeN nCrits <=< shuffle $ fmap PutCrit $ [spreadGunCrit,pistolCrit,autoCrit,armourChaseCrit]
++ replicate 20 chaseCrit
randomiseAllLinks . fillNothingPlacements (crits ++ map PutFlIt itms) =<<
( shufflePlacements
-- . over rmPmnts ( sps0 putLamp :)
. over rmPmnts ( sps0 putLamp :)
. foldr1 combineRooms
$ zipWith (\r a -> moveRoomBy (V2 0 0,a) r) corners [0,pi/2,pi,3*pi/2]
)