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

Move towards more usable placements

Browse Source
This commit is contained in:
justin
2021-11-13 00:04:50 +00:00
parent 67e164c830
commit b243479759
13 changed files with 167 additions and 208 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/LevelGen/Data.hs
+13 -10
View File
@@ -1,7 +1,6 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.LevelGen.Data
where
module Dodge.LevelGen.Data where
import Dodge.Data
import Picture
import Geometry.Data
@@ -40,16 +39,20 @@ data PlacementSpot
data Placement = Placement
{ _plSpot :: PlacementSpot
, _plType :: PSType
, _plID :: Maybe Int
, _plIDCont :: Int -> Maybe Placement
}
| PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position
| RandomPlacement {_unRandomPlacement :: State StdGen Placement}
spNoID :: PlacementSpot -> PSType -> Placement
spNoID ps pst = Placement ps pst Nothing (const Nothing)
sPS :: Point2 -> Float -> PSType -> Placement
sPS p a pt = Placement (PS p a) pt (const Nothing)
sPS p a pt = Placement (PS p a) pt Nothing (const Nothing)
jsps :: Point2 -> Float -> PSType -> Maybe Placement
jsps p a pst = Just $ Placement (PS p a) pst $ const Nothing
jsps p a pst = Just $ Placement (PS p a) pst Nothing $ const Nothing
jsps0 :: PSType -> Maybe Placement
jsps0 pst = Just $ sPS (V2 0 0) 0 pst
@@ -58,25 +61,25 @@ 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 $ \_ -> 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 $ \_ -> Just plm
jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing $ \_ -> Just plm
ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
ps0 = Placement (PS (V2 0 0) 0)
ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing
jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
jps0 pst = Just . Placement (PS (V2 0 0) 0) pst
jps0 pst = Just . Placement (PS (V2 0 0) 0) pst Nothing
ps0j :: PSType -> Placement -> Placement
ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst (const $ Just plmnt)
ps0j pst plmnt = Placement (PS (V2 0 0) 0) pst Nothing (const $ Just plmnt)
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 f) -> Placement ps pt (fmap g f)
(Placement ps pt mi f) -> Placement ps pt mi (fmap g f)
where
g Nothing = Just pl
g (Just pl') = Just $ addPlmnt pl pl'