Move GenWorld update of placements into product type
This commit is contained in:
+20
-24
@@ -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'
|
||||
|
||||
Reference in New Issue
Block a user