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

Thread a more complex structure through the placement process

Browse Source
This commit is contained in:
justin
2021-11-25 01:32:25 +00:00
parent 0e87f340b4
commit aad79bdf25
5 changed files with 63 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Layout.hs
+10 -8
View File
@@ -8,6 +8,7 @@ import Dodge.ShiftPoint
import Dodge.Placement.PlaceSpot
import Dodge.LevelGen.Data
import Dodge.LevelGen.StaticWalls
import Dodge.LevelGen.LevelStructure
import Dodge.Room.Foreground
import Dodge.Wall.Zone
import Dodge.GameRoom
@@ -42,6 +43,7 @@ generateLevelFromRoomList gr' w
. doPartialPlacements
. doExtendedPlacements
. flip (mapAccumR doRoomPlacements) rs'
. worldToGenWorld
$ w { _walls = wallsFromRooms rs
, _floorTiles = floorsFromRooms rs
, _gameRooms = gameRoomsFromRooms rs'
@@ -60,8 +62,8 @@ shuffleRoomPos rm = do
newPos <- shuffle $ _rmPos rm
return $ rm & rmPos .~ newPos
placeWires :: (World,[Room])-> World
placeWires (w,rms) = foldr placeRoomWires w rms
placeWires :: (GenWorld,[Room])-> World
placeWires (w,rms) = foldr placeRoomWires (_gWorld w) rms
placeRoomWires :: Room -> World -> World
placeRoomWires rm w = IM.foldr ($) w
@@ -89,21 +91,21 @@ placeWire rm (WallWire p _ h1) (WallWire q _ h2) = foregroundShape
rightpleftq x = isRHS rmcen p x && isLHS rmcen q x
rs = _rmShift rm
doPartialPlacements :: ( (IM.IntMap [Placement],World) , [Room] ) -> (World,[Room])
doPartialPlacements :: ( (IM.IntMap [Placement],GenWorld) , [Room] ) -> (GenWorld,[Room])
doPartialPlacements ((im,w),rms) = mapAccumR (doPartialPlacement im) w rms
doPartialPlacement :: IM.IntMap [Placement] -> World -> Room -> (World, Room)
doPartialPlacement :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room)
doPartialPlacement im w rm = case _rmPartPmnt rm of
Nothing -> (w, rm)
Just fi -> case _rmTakeFrom rm of
Nothing -> (w, rm)
Just i -> fst $ placeSpot (w,rm) (fi (im IM.! i))
doExtendedPlacements :: (World,[Room]) -> ( (IM.IntMap [Placement], World) , [Room] )
doExtendedPlacements :: (GenWorld,[Room]) -> ( (IM.IntMap [Placement], GenWorld) , [Room] )
doExtendedPlacements (w,rms) = mapAccumR doExtendedPlacement (IM.empty,w) rms
doExtendedPlacement :: (IM.IntMap [Placement], World) -> Room
-> ( (IM.IntMap [Placement], World) , Room )
doExtendedPlacement :: (IM.IntMap [Placement], GenWorld) -> Room
-> ( (IM.IntMap [Placement], GenWorld) , Room )
doExtendedPlacement (im,w) rm = case _rmExtPmnt rm of
Nothing -> ( (im,w) , rm )
Just plmnt -> case _rmLabel rm of
@@ -111,7 +113,7 @@ doExtendedPlacement (im,w) rm = case _rmExtPmnt rm of
Just i -> let ((neww,newrm),plmnts) = placeSpot (w,rm) plmnt
in ( (IM.insert i plmnts im, neww) , newrm )
doRoomPlacements :: World -> Room -> (World, Room)
doRoomPlacements :: GenWorld -> Room -> (GenWorld, Room)
doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm
setupWorldBounds :: World -> World