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

Add fallback placement for falled link based placement spots

Browse Source
This commit is contained in:
justin
2021-11-08 11:16:08 +00:00
parent 2d98c74ab3
commit 28f8ac1fbd
7 changed files with 52 additions and 88 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Floor.hs
+1 -4
View File
@@ -35,10 +35,7 @@ initialRoomTree = do
t = treeFromTrunk
[[StartRoom]
,[Corridor]
,[AirlockAno]
,[Corridor]
,[Corridor]
,[SpecificRoom $ fmap connectRoom glassSwitchBack]
,[SpecificRoom $ fmap connectRoom glassSwitchBackCrits]
,[Corridor]
,[SpecificRoom $ return $ connectRoom lasTunnel ]
,[Corridor]
src/Dodge/Layout.hs
+3 -37
View File
@@ -7,8 +7,6 @@ import Dodge.LevelGen.Data
import Dodge.LevelGen.StaticWalls
import Dodge.LevelGen.Pathing
import Dodge.Wall.Zone
import Dodge.Placements.Spot
import Dodge.RandomHelp
import Dodge.Zone
import Dodge.GameRoom
import Dodge.Bounds
@@ -28,7 +26,7 @@ import Tile
import Polyhedra
import Polyhedra.Data
import Data.List (nubBy, partition,mapAccumR)
import Data.List (nubBy)
import Control.Monad.State
import Control.Lens
import System.Random
@@ -43,7 +41,8 @@ generateLevelFromRoomList :: State StdGen [Room] -> World -> World
generateLevelFromRoomList gr w
= initWallZoning
. setupWorldBounds
. flip (foldr $ flip placeSpot) plmnts
-- . flip (foldr $ flip placeSpot) plmnts
. flip (foldl' placeSpot) plmnts
$ w { _walls = wallsFromRooms rs
, _floorTiles = floorsFromRooms rs
, _gameRooms = gameRoomsFromRooms rs
@@ -54,42 +53,9 @@ generateLevelFromRoomList gr w
path = pairsToGraph dist pairPath
pairPath = concatMap _rmPath rs
plmnts = concatMap (\rm -> map (rm,) (_rmPS rm)) rs
--plmnts = concat . snd $ mapAccumR assignPlacementSpots (_randGen w) rs
rs = zipWith addTile zs . evalState gr $ _randGen w
zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
-- the idea is to allow use of link coordinates for placements
-- though the implementation is clunky
-- this should PutNothing if there are no links available
-- first it takes the random placements and derandomises them
-- then it deals with link placement spots
-- TODO use state monad here
assignPlacementSpots :: StdGen -> Room -> (StdGen, [(Room,Placement)])
assignPlacementSpots g rm = (g'
, map (rm,)
$ plmnts ++ updatedLnkPlmnts
)
where
(unrandPlmnts, g'') = runState (mapM (derandPlacement rm) (_rmPS rm)) g
(lnkplmnts, plmnts) = partition islnk unrandPlmnts
islnk Placement{_placementSpot=PSLnk{}} = True
islnk _ = False
(shuffledLnks,g') = runState (shuffle $ _rmLinks rm) g''
(_,updatedLnkPlmnts) = mapAccumR f (map (invShiftLinkBy $ _rmShift rm) shuffledLnks) lnkplmnts
f lnks plmnt =
let (x:xs,ys) = partition (_psLinkTest $ _placementSpot plmnt) lnks
thepair = _psLinkShift (_placementSpot plmnt) x
in (xs++ys, updatePS (updatePSLnkUsing thepair) plmnt)
-- I do not see an obvious way to push randomn placement spots down into recursive placements
-- So these currently only work for the "top" level
derandPlacement :: Room -> Placement -> State StdGen Placement
derandPlacement rm (RandomPlacement x) = derandPlacement rm =<< x
derandPlacement rm (Placement (PSRoomRand i) pstype cont) = do
ps <- _rmRandPSs rm !! i
return (Placement (uncurry PS ps) pstype cont)
derandPlacement _ x = return x
updatePSLnkUsing :: (Point2,Float) -> PlacementSpot -> PlacementSpot
updatePSLnkUsing pf PSLnk{_psLinkShift=f} = uncurry PS $ f pf
updatePSLnkUsing _ ps = ps
src/Dodge/LevelGen.hs
+11 -5
View File
@@ -26,6 +26,8 @@ import Control.Monad.State
import Control.Lens
import qualified Data.IntSet as IS
-- potential failure cases: randomising using an already set link position
-- others?
placeSpot :: World -> (Room , Placement) -> World
placeSpot w (rm, plmnt@Placement{_placementSpot=PSRoomRand i}) =
let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w
@@ -40,20 +42,24 @@ placeSpot w (rm, plmnt@Placement{}) =
placeSpot w (rm, PlacementUsingPos p subpl) = placeSpot w (rm, subpl (shiftPoint3By shift p))
where
shift = _rmShift rm
-- random placements SHOULD be dealt with already (see assignPlacementSpots)
placeSpot w (rm, RandomPlacement rplmnt) = placeSpot (w & randGen .~ g) (rm, plmnt)
where
(plmnt, g) = runState rplmnt (_randGen w)
-- ok, this is unsafe, but whatever
-- this should be woven into placeSpot
assignPSToLnk :: Room -> Placement -> World -> World
assignPSToLnk rm plmnt w = placeSpot (w & randGen .~ g) (rm, updatePS (f lnk) plmnt)
assignPSToLnk rm plmnt w = case lnks of
(lnk:_) -> placeSpot (w & randGen .~ g) (rm, updatePS (f lnk) plmnt)
[] -> case fallback of
Nothing -> w
Just plmnt' -> placeSpot w (rm,plmnt')
where
rps = _placementSpot plmnt
fallback = _psFallback rps
test = _psLinkTest rps
(lnk:_,g) = runState (shuffle $ filter test $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm)
(lnks,g) = runState (shuffle $ filter test $ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm)
$ _randGen w
f x (PSLnk t s)
f x (PSLnk t s _)
| t x = uncurry PS $ s x
f _ ps = ps
invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
src/Dodge/LevelGen/Data.hs
+1
View File
@@ -32,6 +32,7 @@ data PlacementSpot
= PS { _psPos :: Point2 , _psRot :: Float }
| PSLnk { _psLinkTest :: (Point2,Float) -> Bool
, _psLinkShift :: (Point2,Float) -> (Point2,Float)
, _psFallback :: Maybe Placement
}
| PSRoomRand
{ _psRoomRandPointNum :: Int }
src/Dodge/Placements/Button.hs
+1 -1
View File
@@ -30,4 +30,4 @@ putLitButtonID' col f subpl
where
changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
thePS = PSLnk f (\(p,a)->(p,a))
thePS = PSLnk f id Nothing
src/Dodge/Placements/LightSource.hs
+2 -2
View File
@@ -95,12 +95,12 @@ mountLightA = redMID mountLightAID
mountLightACond :: ((Point2,Float) -> Bool) -> Placement
mountLightACond f = updatePSToLevel 2 (const thePS) $ mountLightA 0 (V3 0 (-40) 40)
where
thePS = PSLnk f (\(p,a)->(p,a))
thePS = PSLnk f id Nothing
mountLightVCond :: ((Point2,Float) -> Bool) -> Placement
mountLightVCond f = updatePSToLevel 2 (const thePS) $ mountLightV 0 (V3 0 (-20) 40)
where
thePS = PSLnk f id
thePS = PSLnk f id Nothing
mntLight :: Point2 -> Point2 -> Placement
mntLight a b = RandomPlacement $ takeOne
src/Dodge/Room.hs
+33 -39
View File
@@ -78,24 +78,6 @@ roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
branchWith :: Room -> [Tree Room] -> Tree (Either Room Room)
branchWith r ts = Node (Left r) $ return (Right door) : fmap (fmap Left) ts
glassSwitchBack :: RandomGen g => State g Room
glassSwitchBack = do
wth <- state $ randomR (200,400)
hgt <- state $ randomR (400,600)
wllen <- state $ randomR (60,wth/2-40)
let hf = hgt/5
let plmnts =
[windowLine (V2 (wth-60 ) hf ) (V2 wllen hf )
,windowLine (V2 (wth-wllen) (2*hf)) (V2 60 (2*hf))
,windowLine (V2 (wth-60 ) (3*hf)) (V2 wllen (3*hf))
,windowLine (V2 (wth-wllen) (4*hf)) (V2 60 (4*hf))
,blockLine (V2 0 (1*hf)) (V2 wllen (1*hf))
,blockLine (V2 (wth-wllen) (2*hf)) (V2 wth (2*hf))
,blockLine (V2 0 (3*hf)) (V2 wllen (3*hf))
,blockLine (V2 (wth-wllen) (4*hf)) (V2 wth (4*hf))
, sPS (V2 (wth/2) (hgt/2)) 0 putLamp
]
return $ set rmPS plmnts $ roomRect wth hgt 2 6
manyDoors :: Int -> Tree (Either Room Room)
manyDoors i = treeFromPost (replicate i (Left door)) $ Right door
@@ -128,33 +110,45 @@ glassLesson = do
]
]
glassSwitchback1 :: RandomGen g => State g Room
glassSwitchback1 = do
glassSwitchBack :: RandomGen g => State g Room
glassSwitchBack = do
wth <- state $ randomR (200,400)
hgt <- state $ randomR (400,600)
wllen <- state $ randomR (60,wth/2-40)
let hf = hgt/5
cry <- randomRanges [--50+2*hf,30+3*hf
50+3*hf,30+4*hf
,50+4*hf,30+5*hf
]
crx <- state $ randomR (wllen,wth-(wllen+40))
let plmnts = [windowLine (V2 (wth-60) ( 40+hf)) (V2 wllen (40+hf))
,windowLine (V2 (wth-wllen) (40+2*hf)) (V2 60 (40+2*hf))
,windowLine (V2 (wth-60) ( 40+3*hf)) (V2 wllen (40+3*hf))
,windowLine (V2 (wth-wllen) (40+4*hf)) (V2 60 (40+4*hf))
,sPS (V2 crx cry) 0 $ PutCrit miniGunCrit
,sPS (V2 (wth-20) (hgt/2+40)) 0 randC1
,sPS (V2 (wth/2) (hgt/2)) 0 putLamp
,blockLine (V2 0 ( 40+1*hf)) (V2 wllen (40+1*hf))
,blockLine (V2 (wth-wllen) ( 40+2*hf)) (V2 wth (40+2*hf))
,blockLine (V2 0 ( 40+3*hf)) (V2 wllen (40+3*hf))
,blockLine (V2 (wth-wllen) ( 40+4*hf)) (V2 wth (40+4*hf))
]
return $ set rmPS plmnts $ shiftRoomBy (V2 0 40,0) $ roomRect wth hgt 2 4
con1 (V2 _ y,_) = y < 0.5*hgt
plmnts =
[ mntLightLnkCond con1
, mntLightLnkCond (not . con1)
,windowLine (V2 (wth-60 ) hf ) (V2 wllen hf )
,windowLine (V2 (wth-wllen) (2*hf)) (V2 60 (2*hf))
,windowLine (V2 (wth-60 ) (3*hf)) (V2 wllen (3*hf))
,windowLine (V2 (wth-wllen) (4*hf)) (V2 60 (4*hf))
,blockLine (V2 0 (1*hf)) (V2 wllen (1*hf))
,blockLine (V2 (wth-wllen) (2*hf)) (V2 wth (2*hf))
,blockLine (V2 0 (3*hf)) (V2 wllen (3*hf))
,blockLine (V2 (wth-wllen) (4*hf)) (V2 wth (4*hf))
, sPS (V2 (wth/2) (hgt/2)) 0 putLamp
]
let northPSs = do
cry <- randomRanges [3*hf+10,4*hf-10
,4*hf+10,5*hf-10
]
crx <- state $ randomR (wllen,wth-(wllen+40))
return (V2 crx cry,1.5*pi)
midPS = return (V2 (wth-20) (hgt/2+40), pi)
return $ roomRect wth hgt 2 4
& rmPS .~ plmnts
& rmRandPSs .~ [northPSs,midPS]
glassSwitchBackCrits :: RandomGen g => State g Room
glassSwitchBackCrits = glassSwitchBack
<&> rmPS %~ ([Placement (PSRoomRand 0) (PutCrit miniGunCrit) (const Nothing)
, Placement (PSRoomRand 1) randC1 (const Nothing)
] ++)
miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
miniTree2 = glassSwitchback1
miniTree2 = glassSwitchBackCrits
>>= randomiseOutLinks
>>= changeLinkTo (\p -> (sndV2 . fst) p < 70)
<&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)