justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Fix bug in the placement of mounted lightsources when shifted

Browse Source
This commit is contained in:
justin
2022-03-04 17:59:42 +00:00
parent d219f42640
commit 8fa6bbfe29
4 changed files with 17 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LevelGen/Data.hs
+5 -7
View File
@@ -150,7 +150,7 @@ spNoID :: PlacementSpot -> PSType -> Placement
spNoID ps pst = Placement ps pst Nothing (const Nothing)
pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement
pContID ps pt = Placement ps pt Nothing . intPlPlPl
pContID ps pt = Placement ps pt Nothing . contToIDCont
psPtCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
psPtCont ps pt = Placement ps pt Nothing
@@ -183,19 +183,16 @@ jsps0J :: PSType -> Placement -> Maybe Placement
jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing $ \_ -> Just plm
ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing . intPlPlPl
ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing . contToIDCont
pt0 :: PSType -> (Placement -> Maybe Placement) -> Placement
pt0 pst = Placement (PS (V2 0 0) 0) pst Nothing
contToIDCont :: (Int -> Maybe Placement) -> Placement -> Maybe Placement
contToIDCont f plmnt = f $ fromJust (_plMID plmnt)
intPlPlPl :: (Int -> Maybe Placement) -> Placement -> Maybe Placement
intPlPlPl f = f . fromJust . _plMID
contToIDCont f = f . fromJust . _plMID
jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
jps0 pst = Just . Placement (PS (V2 0 0) 0) pst Nothing . intPlPlPl
jps0 pst = Just . Placement (PS (V2 0 0) 0) pst Nothing . contToIDCont
jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
jps0PushPS pst f = Just . Placement (PS (V2 0 0) 0) pst Nothing
@@ -209,6 +206,7 @@ psj ps pst plmnt = Placement ps pst Nothing (const $ Just plmnt)
ps0jPushPS :: PSType -> Placement -> Placement
ps0jPushPS pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (\p -> Just $ plmnt & plSpot .~ _plSpot p)
--ps0jPushPS pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (\p -> Just $ plmnt)
addPlmnt :: Placement -> Placement -> Placement
addPlmnt pl pl2 = case pl2 of
src/Dodge/Placement/Shift.hs
+3 -1
View File
@@ -13,7 +13,9 @@ shiftPSBy (pos,rot) ps = ps
shiftPlacement :: (Point2,Float) -> Placement -> Placement
shiftPlacement shift plmnt = case plmnt of
Placement {} -> plmnt & plSpot %~ shiftPSBy shift
& plIDCont %~ fmap (fmap $ shiftPlacement shift)
-- TODO check whether the following continuation is ever necessary
-- it can interfere with ps0jPushPS
-- & plIDCont %~ fmap (fmap $ shiftPlacement shift)
PlacementUsingPos p f -> PlacementUsingPos (shiftPoint3By shift p)
(fmap (shiftPlacement shift) f)
RandomPlacement rpl -> RandomPlacement $ fmap (shiftPlacement shift) rpl
src/Dodge/Room/Boss.hs
+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" }
src/Dodge/Room/Procedural.hs
+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]
)