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

Remove _plGenUpdate field, instead allow Placements to take World arg

Browse Source
This commit is contained in:
justin
2022-06-02 20:00:03 +01:00
parent 7c4a853d70
commit 024f72da20
13 changed files with 54 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LevelGen/Data.hs
+29 -25
View File
@@ -1,4 +1,4 @@
{-# LANGUAGE TemplateHaskell #-}
--{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.LevelGen.Data where
import Dodge.Data
@@ -20,28 +20,28 @@ import Data.Maybe
spNoID :: PlacementSpot -> PSType -> Placement
spNoID ps pst = Placement ps pst Nothing Nothing (const Nothing)
spNoID ps pst = Placement ps pst Nothing (const . const Nothing)
pContID :: PlacementSpot -> PSType -> (Int -> Maybe Placement) -> Placement
pContID ps pt = Placement ps pt Nothing Nothing . contToIDCont
pContID ps pt = Placement ps pt Nothing . contToIDCont
psPtCont :: PlacementSpot -> PSType -> (Placement -> Maybe Placement) -> Placement
psPtCont ps pt = Placement ps pt Nothing Nothing
psPtCont ps pt = Placement ps pt Nothing . const
psPt :: PlacementSpot -> PSType -> Placement
psPt ps pt = Placement ps pt Nothing Nothing (const Nothing)
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 Nothing (const Nothing)
sPS p a pt = Placement (PS p a) pt Nothing (const . const Nothing)
sps :: PlacementSpot -> PSType -> Placement
sps ps pt = Placement ps pt Nothing Nothing (const Nothing)
sps ps pt = Placement ps pt Nothing (const . const Nothing)
plRRpt :: Int -> PSType -> Placement
plRRpt i pt = Placement (PSRoomRand i (uncurry PS)) pt Nothing Nothing (const Nothing)
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 Nothing $ const Nothing
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
@@ -50,48 +50,52 @@ 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 Nothing $ \_ -> Just plm
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 Nothing $ \_ -> Just plm
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 Nothing . contToIDCont
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 Nothing
pt0 pst = Placement (PS (V2 0 0) 0) pst Nothing . const
contToIDCont :: (Int -> Maybe Placement) -> Placement -> Maybe Placement
contToIDCont f = f . fromJust . _plMID
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 Nothing
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 Nothing
$ \plmnt -> f (fromJust $ _plMID plmnt) <&> plSpot .~ _plSpot plmnt
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 Nothing (const $ Just plmnt)
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 Nothing (const $ Just plmnt)
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 Nothing
$ \p -> Just $ plmnt & plSpot .~ _plSpot p
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 Nothing
$ \pl -> f pl & _Just . plSpot %~ const (_plSpot pl)
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
(PlacementUsingPos p f) -> PlacementUsingPos p (fmap (addPlmnt pl) f)
(RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
(Placement ps pt mi up f) -> Placement ps pt mi up (fmap g f)
(Placement ps pt mi f) -> Placement ps pt mi (fmap (fmap g) f)
PickOnePlacement {} -> error "not written how to combine PickOnePlacement with others yet"
where
g Nothing = Just pl