diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 740985b05..3f9621e4e 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -58,12 +58,9 @@ data Placement { _plSpot :: PlacementSpot , _plType :: PSType , _plMID :: Maybe Int + , _plGenUpdate :: Maybe (GenParams -> Placement -> (GenParams, Placement) ) , _plIDCont :: Placement -> Maybe Placement } - | PlacementGenUpdate - {_plGenUpdate :: GenParams -> Placement -> (GenParams, Placement) - ,_plGenPL :: Placement - } | PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position | RandomPlacement {_unRandomPlacement :: State StdGen Placement} | PickOnePlacement Int Placement @@ -188,28 +185,28 @@ makeLenses ''GenWorld makeLenses ''GenParams spNoID :: PlacementSpot -> PSType -> Placement -spNoID ps pst = Placement ps pst Nothing (const Nothing) +spNoID ps pst = Placement ps pst Nothing Nothing (const Nothing) pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement -pContID ps pt = Placement ps pt Nothing . contToIDCont +pContID ps pt = Placement ps pt Nothing Nothing . contToIDCont psPtCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement -psPtCont ps pt = Placement ps pt Nothing +psPtCont ps pt = Placement ps pt Nothing Nothing psPt :: PlacementSpot -> PSType -> Placement -psPt ps pt = Placement ps pt Nothing (const Nothing) +psPt ps pt = Placement ps pt Nothing Nothing (const Nothing) sPS :: Point2 -> Float -> PSType -> Placement -sPS p a pt = Placement (PS p a) pt Nothing (const Nothing) +sPS p a pt = Placement (PS p a) pt Nothing Nothing (const Nothing) sps :: PlacementSpot -> PSType -> Placement -sps ps pt = Placement ps pt Nothing (const Nothing) +sps ps pt = Placement ps pt Nothing Nothing (const Nothing) plRRpt :: Int -> PSType -> Placement -plRRpt i pt = Placement (PSRoomRand i (uncurry PS)) pt Nothing (const Nothing) +plRRpt i pt = Placement (PSRoomRand i (uncurry PS)) pt Nothing Nothing (const Nothing) jsps :: Point2 -> Float -> PSType -> Maybe Placement -jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const Nothing +jsps p a pst = Just $ Placement (PS p a) pst Nothing Nothing $ const Nothing jsps0 :: PSType -> Maybe Placement jsps0 = Just . sPS (V2 0 0) 0 @@ -218,50 +215,49 @@ sps0 :: PSType -> Placement sps0 = sPS (V2 0 0) 0 jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement -jspsJ p a pst plm = Just $ Placement (PS p a) pst Nothing $ \_ -> Just plm +jspsJ p a pst plm = Just $ Placement (PS p a) pst Nothing Nothing $ \_ -> Just plm jsps0J :: PSType -> Placement -> Maybe Placement -jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing $ \_ -> Just plm +jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing Nothing $ \_ -> Just plm ps0 :: PSType -> (Int -> Maybe Placement) -> Placement -ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing . contToIDCont +ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing Nothing . contToIDCont pt0 :: PSType -> (Placement -> Maybe Placement) -> Placement -pt0 pst = Placement (PS (V2 0 0) 0) pst Nothing +pt0 pst = Placement (PS (V2 0 0) 0) pst Nothing Nothing contToIDCont :: (Int -> Maybe Placement) -> Placement -> Maybe Placement contToIDCont f = f . fromJust . _plMID jps0' :: PSType -> (Placement -> Maybe Placement) -> Maybe Placement -jps0' pst = Just . Placement (PS (V2 0 0) 0) pst Nothing +jps0' pst = Just . Placement (PS (V2 0 0) 0) pst Nothing Nothing jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement -jps0PushPS pst f = Just . Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing +jps0PushPS pst f = Just . Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing Nothing $ \plmnt -> f (fromJust $ _plMID plmnt) <&> plSpot .~ _plSpot plmnt ps0j :: PSType -> Placement -> Placement -ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (const $ Just plmnt) +ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing Nothing (const $ Just plmnt) psj :: PlacementSpot -> PSType -> Placement -> Placement -psj ps pst plmnt = Placement ps pst Nothing (const $ Just plmnt) +psj ps pst plmnt = Placement ps pst Nothing Nothing (const $ Just plmnt) -- the NoShiftCont is necessary when shifting then combining rooms ps0jPushPS :: PSType -> Placement -> Placement -ps0jPushPS pst plmnt = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing +ps0jPushPS pst plmnt = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing Nothing $ \p -> Just $ plmnt & plSpot .~ _plSpot p -- the NoShiftCont is necessary when shifting then combining rooms ps0PushPS :: PSType -> (Placement -> Maybe Placement) -> Placement -ps0PushPS pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing +ps0PushPS pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing Nothing $ \pl -> f pl & _Just . plSpot %~ const (_plSpot pl) addPlmnt :: Placement -> Placement -> Placement addPlmnt pl pl2 = case pl2 of (PlacementUsingPos p f) -> PlacementUsingPos p (fmap (addPlmnt pl) f) (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp - (Placement ps pt mi f) -> Placement ps pt mi (fmap g f) + (Placement ps pt mi up f) -> Placement ps pt mi up (fmap g f) PickOnePlacement {} -> error "not written how to combine PickOnePlacement with others yet" - PlacementGenUpdate {} -> error "not written how to combine PlacementGenUpdate with others yet" where g Nothing = Just pl g (Just pl') = Just $ addPlmnt pl pl' diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index 99f84b28c..e3d3e8fa6 100644 --- a/src/Dodge/LockAndKey.hs +++ b/src/Dodge/LockAndKey.hs @@ -15,10 +15,10 @@ import Control.Monad.State lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g CombineType ) ] lockRoomKeyItems = --[(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] ) - --,(sensorRoomRunPast Electrical, return SPARKGUN ) + [(sensorRoomRunPast Electrical, return SPARKGUN ) --,(sensorRoomRunPast Flaming, return FLAMESPITTER ) --,(sensorRoomRunPast Lasering, return LASGUN ) - [(const slowDoorRoomRunPast, return MINIGUN) + --,(const slowDoorRoomRunPast, return MINIGUN) --,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) --,(const glassLessonRunPast, takeOne [LASGUN]) --,(const $ lasTunnelRunPast 400, return FLATSHIELD) diff --git a/src/Dodge/Placement/Instance/LightSource.hs b/src/Dodge/Placement/Instance/LightSource.hs index b3ccf51fc..e9c7e2328 100644 --- a/src/Dodge/Placement/Instance/LightSource.hs +++ b/src/Dodge/Placement/Instance/LightSource.hs @@ -149,7 +149,7 @@ spanLSLightI ls h a b = ps0j (PutLS $ ls & lsParam . lsPos .~ V3 x y h) V2 x y = 0.5 *.* (a +.+ b) spanLS :: LightSource -> Point2 -> Point2 -> Placement -spanLS ls a b = Placement (PS (V2 x y) 0) (PutLS ls) Nothing +spanLS ls a b = Placement (PS (V2 x y) 0) (PutLS ls) Nothing Nothing $ const $ Just $ sps0 $ PutShape $ thinHighBar h a b where V3 _ _ h = _lsPos (_lsParam ls) + 5 diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 9b73546e5..3b2e497c6 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -17,7 +17,7 @@ import Shape import Data.Maybe putTerminal :: (GenParams -> TerminalParams) -> Placement -putTerminal f = PlacementGenUpdate g $ ps0PushPS (PutButton thebutton) +putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton) $ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine { _mcDraw = drawTerminal , _mcHP = 100 @@ -27,7 +27,9 @@ putTerminal f = PlacementGenUpdate g $ ps0PushPS (PutButton thebutton) }) $ const Nothing where - g gp pl = (gp, pl & plType . pstPutButton . btTerminalParams .~ f gp) + g gp pl = (gp, pl & plType . pstPutButton . btTerminalParams .~ f gp + & plGenUpdate .~ Nothing + ) thebutton = Button { _btPict = const mempty , _btPos = 0 diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index 6be259e71..0cdf03c98 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -33,14 +33,14 @@ import Data.Bifunctor -- to the placement placeSpot :: (GenWorld,Room) -> Placement -> ( (GenWorld,Room), [Placement] ) placeSpot (w,rm) plmnt = case plmnt of + pl@Placement{_plGenUpdate = Just f} -> let (gp,pl') = f (_gParams w) pl + in placeSpot (w & gParams .~ gp,rm) pl' Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rm i f plmnt w Placement{_plSpot = PSPos extract eff fallback} -> placeSpotUsingLink w rm plmnt extract eff fallback Placement{} -> placePlainPSSpot w rm plmnt shift PlacementUsingPos p subpl -> placeSpot (w,rm) (subpl (shiftPoint3By shift p)) RandomPlacement rplmnt -> placeRandomPlacement rplmnt w rm PickOnePlacement i pl -> ((placePickOne i pl rm w, rm), []) - PlacementGenUpdate f pl -> let (gp,pl') = f (_gParams w) pl - in placeSpot (w & gParams .~ gp,rm) pl' where shift = _rmShift rm diff --git a/src/Dodge/Placement/Shift.hs b/src/Dodge/Placement/Shift.hs index 21c8b86b7..098884bf8 100644 --- a/src/Dodge/Placement/Shift.hs +++ b/src/Dodge/Placement/Shift.hs @@ -20,4 +20,3 @@ shiftPlacement shift plmnt = case plmnt of (fmap (shiftPlacement shift) f) RandomPlacement rpl -> RandomPlacement $ fmap (shiftPlacement shift) rpl PickOnePlacement i pl -> PickOnePlacement i (shiftPlacement shift pl) - PlacementGenUpdate f pl -> PlacementGenUpdate f (shiftPlacement shift pl) diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs index f912305e4..cb099e730 100644 --- a/src/Dodge/PlacementSpot.hs +++ b/src/Dodge/PlacementSpot.hs @@ -108,8 +108,8 @@ twoRoomPoss :: (RoomPos -> Room -> Bool) -> (RoomPos -> Room -> Bool) -> (PlacementSpot -> PlacementSpot -> Placement) -> Placement -twoRoomPoss cond1 cond2 f = Placement (rprBool cond1) PutNothing Nothing - $ \pl1 -> Just $ Placement (rprBool cond2) PutNothing Nothing +twoRoomPoss cond1 cond2 f = Placement (rprBool cond1) PutNothing Nothing Nothing + $ \pl1 -> Just $ Placement (rprBool cond2) PutNothing Nothing Nothing $ \pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2) --isUnusedLnk :: RoomPos -> Bool diff --git a/src/Dodge/Room/SensorDoor.hs b/src/Dodge/Room/SensorDoor.hs index 27149d14d..db4d9ef5e 100644 --- a/src/Dodge/Room/SensorDoor.hs +++ b/src/Dodge/Room/SensorDoor.hs @@ -70,7 +70,7 @@ sensInsideDoor senseType outplid rm = rm <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100)) <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)) , putTerminal messagef - & plGenPL . plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10) + & plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10) ] & rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid] where