diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 94ef42b20..c5ad54baa 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -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 diff --git a/src/Dodge/Placement/Shift.hs b/src/Dodge/Placement/Shift.hs index 7e00e9953..2f368d07e 100644 --- a/src/Dodge/Placement/Shift.hs +++ b/src/Dodge/Placement/Shift.hs @@ -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 diff --git a/src/Dodge/Room/Boss.hs b/src/Dodge/Room/Boss.hs index da9dddfa6..b36e5cd4c 100644 --- a/src/Dodge/Room/Boss.hs +++ b/src/Dodge/Room/Boss.hs @@ -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" } diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index fc688ea5c..0c280ea94 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -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] )