Fix bug in the placement of mounted lightsources when shifted
This commit is contained in:
@@ -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" }
|
||||
|
||||
@@ -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]
|
||||
)
|
||||
|
||||
Reference in New Issue
Block a user