Move GenWorld update of placements into product type

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'

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)

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

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

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
 

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)

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
+twoRoomPoss cond1 cond2 f = Placement (rprBool cond1) PutNothing Nothing Nothing
-    $ \pl1 -> Just $ Placement (rprBool cond2) PutNothing Nothing
+    $ \pl1 -> Just $ Placement (rprBool cond2) PutNothing Nothing Nothing
     $ \pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
 
 --isUnusedLnk :: RoomPos -> Bool

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