94 lines
3.5 KiB
Haskell
94 lines
3.5 KiB
Haskell
module Dodge.LevelGen.PlacementHelper where
|
|
|
|
import Control.Lens
|
|
import Data.Maybe
|
|
import Dodge.Data.GenWorld
|
|
import Geometry
|
|
|
|
--spNoID
|
|
psPtPl :: PlacementSpot -> PSType -> Placement
|
|
psPtPl ps pst = Placement ps pst Nothing (const . const Nothing)
|
|
|
|
psPtJpl :: PlacementSpot -> PSType -> Maybe Placement
|
|
psPtJpl ps = Just . psPtPl ps
|
|
|
|
pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement
|
|
pContID ps pt = Placement ps pt Nothing . contToIDCont
|
|
|
|
psPtCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
|
|
psPtCont ps pt = Placement ps pt Nothing . const
|
|
|
|
ptCont :: PSType -> (Placement -> Maybe Placement) -> Placement
|
|
ptCont = psPtCont (PS 0 0)
|
|
|
|
psPt :: PlacementSpot -> PSType -> Placement
|
|
psPt ps pt = Placement ps pt Nothing (const . const Nothing)
|
|
|
|
sPS :: Point2 -> Float -> PSType -> Placement
|
|
sPS p a pt = Placement (PS p a) pt Nothing (const . const Nothing)
|
|
|
|
sps :: PlacementSpot -> PSType -> Placement
|
|
sps ps pt = Placement ps pt Nothing (const . const Nothing)
|
|
|
|
plRRpt :: Int -> PSType -> Placement
|
|
plRRpt i pt = Placement (PSRoomRand i (uncurry PS)) pt Nothing (const . const Nothing)
|
|
|
|
jsps :: Point2 -> Float -> PSType -> Maybe Placement
|
|
jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const . const Nothing
|
|
|
|
jsps0 :: PSType -> Maybe Placement
|
|
jsps0 = Just . sPS (V2 0 0) 0
|
|
|
|
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
|
|
|
|
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 . contToIDCont
|
|
|
|
pt0 :: PSType -> (Placement -> Maybe Placement) -> Placement
|
|
pt0 pst = Placement (PS (V2 0 0) 0) pst Nothing . const
|
|
|
|
contToIDCont :: (Int -> Maybe Placement) -> World -> 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 . const
|
|
|
|
jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
|
|
jps0PushPS pst f = Just . Placement (PSNoShiftCont (V2 0 0) 0) pst 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)
|
|
|
|
psj :: PlacementSpot -> PSType -> Placement -> Placement
|
|
psj ps pst plmnt = Placement ps pst 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 $
|
|
\_ 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 $
|
|
\_ pl -> f pl & _Just . plSpot %~ const (_plSpot pl)
|
|
|
|
ps0PushPSw :: PSType -> (World -> Placement -> Maybe Placement) -> Placement
|
|
ps0PushPSw pst f = Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing $
|
|
\w pl -> f w pl & _Just . plSpot %~ const (_plSpot pl)
|
|
|
|
addPlmnt :: Placement -> Placement -> Placement
|
|
addPlmnt pl pl2 = case pl2 of
|
|
-- (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
|
|
(Placement ps pt mi f) -> Placement ps pt mi (fmap (fmap g) f)
|
|
where
|
|
g Nothing = Just pl
|
|
g (Just pl') = Just $ addPlmnt pl pl'
|