Remove PickOnePlacements

This commit is contained in:
2025-09-02 12:02:44 +01:00
parent f279494a02
commit 7b28ec15d1
7 changed files with 8 additions and 23 deletions
-2
View File
@@ -86,9 +86,7 @@ data Placement
, _plMID :: Maybe Int , _plMID :: Maybe Int
, _plIDCont :: World -> Placement -> Maybe Placement , _plIDCont :: World -> Placement -> Maybe Placement
} }
| PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position
| RandomPlacement {_unRandomPlacement :: State StdGen Placement} | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
| PickOnePlacement Int Placement
{- The '_rmPolys' lists which polygons should be cut out to form the indestructible walls of the room. {- The '_rmPolys' lists which polygons should be cut out to form the indestructible walls of the room.
Link pairs contain a position and rotation to attach to another room; Link pairs contain a position and rotation to attach to another room;
-2
View File
@@ -86,10 +86,8 @@ ps0PushPSw pst f = Placement 10 (PSNoShiftCont (V2 0 0) 0) pst Nothing $
addPlmnt :: Placement -> Placement -> Placement addPlmnt :: Placement -> Placement -> Placement
addPlmnt pl pl2 = case pl2 of addPlmnt pl pl2 = case pl2 of
(PlacementUsingPos p f) -> PlacementUsingPos p (fmap (addPlmnt pl) f)
(RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp (RandomPlacement rp) -> RandomPlacement $ fmap (addPlmnt pl) rp
(Placement i ps pt mi f) -> Placement i ps pt mi (fmap (fmap g) f) (Placement i ps pt mi f) -> Placement i ps pt mi (fmap (fmap g) f)
PickOnePlacement{} -> error "not written how to combine PickOnePlacement with others yet"
where where
g Nothing = Just pl g Nothing = Just pl
g (Just pl') = Just $ addPlmnt pl pl' g (Just pl') = Just $ addPlmnt pl pl'
-6
View File
@@ -11,7 +11,6 @@ import Control.Monad.State
import Data.Bifunctor import Data.Bifunctor
import Data.Foldable import Data.Foldable
import qualified Data.IntSet as IS import qualified Data.IntSet as IS
import Data.Maybe
import Dodge.Base.NewID import Dodge.Base.NewID
import Dodge.Data.GenWorld import Dodge.Data.GenWorld
import Dodge.Path import Dodge.Path
@@ -34,15 +33,10 @@ placeSpot (w, rm) plmnt = case plmnt of
Placement{_plSpot = PSPos extract eff fallback} -> Placement{_plSpot = PSPos extract eff fallback} ->
placeSpotUsingLink w rm plmnt extract eff fallback placeSpotUsingLink w rm plmnt extract eff fallback
Placement{} -> placePlainPSSpot w rm plmnt shift Placement{} -> placePlainPSSpot w rm plmnt shift
PlacementUsingPos p subpl -> placeSpot (w, rm) (subpl (shiftPoint3By shift p))
RandomPlacement rplmnt -> placeRandomPlacement rplmnt w rm RandomPlacement rplmnt -> placeRandomPlacement rplmnt w rm
PickOnePlacement i pl -> ((placePickOne i pl rm w, rm), [])
where where
shift = _rmShift rm shift = _rmShift rm
placePickOne :: Int -> Placement -> Room -> GenWorld -> GenWorld
placePickOne i pl rm = genPlacements %~ IM.insertWith (++) i [(pl, fromJust (_rmMID rm))]
placeRandomPlacement :: placeRandomPlacement ::
State StdGen Placement -> State StdGen Placement ->
GenWorld -> GenWorld ->
+1 -1
View File
@@ -5,7 +5,7 @@ import Dodge.Item
import RandomHelp import RandomHelp
{- Probabilites of the type of the first floor weapon. -} {- Probabilites of the type of the first floor weapon. -}
randFirstWeapon :: State StdGen Item randFirstWeapon :: RandomGen g => State g Item
randFirstWeapon = randFirstWeapon =
takeOne $ takeOne $
replicate 10 pistol replicate 10 pistol
-5
View File
@@ -25,9 +25,4 @@ shiftPlacement shift plmnt = case plmnt of
Placement{} -> Placement{} ->
plmnt & plSpot %~ shiftPSBy shift plmnt & plSpot %~ shiftPSBy shift
& plIDCont %~ fmap (fmap (fmap $ shiftPlacement shift)) & plIDCont %~ fmap (fmap (fmap $ shiftPlacement shift))
PlacementUsingPos p f ->
PlacementUsingPos
(shiftPoint3By shift p)
(fmap (shiftPlacement shift) f)
RandomPlacement rpl -> RandomPlacement $ fmap (shiftPlacement shift) rpl RandomPlacement rpl -> RandomPlacement $ fmap (shiftPlacement shift) rpl
PickOnePlacement i pl -> PickOnePlacement i (shiftPlacement shift pl)
+6 -6
View File
@@ -151,9 +151,9 @@ weaponEmptyRoom = do
restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts) restrictRMInLinksPD f (roomRect w h 2 2 & rmPmnts .~ plmnts)
return $ treePost [corridor, cleatSide $ cleatOnward rm] return $ treePost [corridor, cleatSide $ cleatOnward rm]
weaponUnderCrits :: RandomGen g => Int -> State g (MetaTree Room String) weaponUnderCrits :: RandomGen g => State g (MetaTree Room String)
weaponUnderCrits i = do weaponUnderCrits = do
let addwpat p = rmPmnts .:~ PickOnePlacement i (sPS p 0 $ RandPS $ fmap PutFlIt randFirstWeapon) let addwpat p = rmPmnts .:~(sPS p 0 $ RandPS $ fmap PutFlIt randFirstWeapon)
continuationRoom = continuationRoom =
treePost treePost
[ addwpat (V2 20 0) corridorN [ addwpat (V2 20 0) corridorN
@@ -246,12 +246,12 @@ deadEndRoom =
lnks = [(V2 0 30, 0)] lnks = [(V2 0 30, 0)]
{- A random Either tree with a weapon and melee monster challenge. -} {- A random Either tree with a weapon and melee monster challenge. -}
weaponRoom :: Int -> State StdGen (MetaTree Room String) weaponRoom :: State StdGen (MetaTree Room String)
weaponRoom i = weaponRoom =
join $ join $
takeOne takeOne
[ weaponEmptyRoom >>= rToOnward "weaponEmptyRoom" [ weaponEmptyRoom >>= rToOnward "weaponEmptyRoom"
, weaponUnderCrits i -- this int is used for PickOnePlacement , weaponUnderCrits
, weaponBehindPillar >>= rToOnward "weaponBehindPillar" , weaponBehindPillar >>= rToOnward "weaponBehindPillar"
, weaponBetweenPillars -- >>= rToOnward "weaponBetweenPillars" , weaponBetweenPillars -- >>= rToOnward "weaponBetweenPillars"
, weaponLongCorridor >>= rToOnward "weaponLongCorridor" , weaponLongCorridor >>= rToOnward "weaponLongCorridor"
+1 -1
View File
@@ -54,7 +54,7 @@ startRoom :: Int -> State StdGen (MetaTree Room String)
startRoom i = startRoom i =
join $ join $
takeOne takeOne
[ attachOnward "startThenWeaponRoom" <$> preCritStart <*> weaponRoom i [ attachOnward "startThenWeaponRoom" <$> preCritStart <*> weaponRoom
, rezBoxesWpCrit >>= rToOnward "rezBoxesWpCrit" , rezBoxesWpCrit >>= rToOnward "rezBoxesWpCrit"
, runPastStart i >>= rToOnward ("runPastStart " ++ show i) , runPastStart i >>= rToOnward ("runPastStart " ++ show i)
, attachOnward "startThenCraft" <$> preCritStart <*> (startCrafts >>= roomsContaining []) , attachOnward "startThenCraft" <$> preCritStart <*> (startCrafts >>= roomsContaining [])