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

Move GenWorld update of placements into product type

Browse Source
This commit is contained in:
justin
2022-03-16 09:39:07 +00:00
parent 5aeb04ba05
commit 2dc94b85da
8 changed files with 32 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LevelGen/Data.hs
+20 -24
View File
@@ -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
+2 -2
View File
@@ -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
+1 -1
View File
@@ -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
+4 -2
View File
@@ -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
+2 -2
View File
@@ -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
-1
View File
@@ -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
+2 -2
View File
@@ -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
src/Dodge/Room/SensorDoor.hs
+1 -1
View File
@@ -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