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

Move GenWorld fields into World

Browse Source
This commit is contained in:
justin
2022-06-02 18:48:20 +01:00
parent 66d098cfef
commit 35cd213bcf
35 changed files with 247 additions and 219 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Layout.hs
+15 -15
View File
@@ -7,7 +7,7 @@ import Dodge.Data
import Dodge.Path
import Dodge.ShiftPoint
import Dodge.Placement.PlaceSpot
import Dodge.LevelGen.Data
--import Dodge.LevelGen.Data
import Dodge.LevelGen.StaticWalls
import Dodge.LevelGen.LevelStructure
import Dodge.Room.Foreground
@@ -71,16 +71,16 @@ setFloors = putFloorTiles . setTiles
-- hence the reverse
-- this is not ideal: should do this in some more sensible way
setTiles :: GenWorld -> GenWorld
setTiles gw = foldr setTile gw . reverse . IM.elems $ _gRooms gw
setTiles gw = foldr setTile gw . reverse . IM.elems $ _genRooms $ _gWorld gw
setTile :: Room -> GenWorld -> GenWorld
setTile r gw = case _rmFloor r of
Tiled {} -> gw
InheritFloor -> gw & gRooms . ix (fromJust (_rmMID r)) . rmFloor .~ Tiled [t & tilePoly .~ poly]
InheritFloor -> gw & gWorld . genRooms . ix (fromJust (_rmMID r)) . rmFloor .~ Tiled [t & tilePoly .~ poly]
where
t = case _rmMParent r of
Nothing -> Tile poly (V2 0 0) (V2 1 0) 16
Just pid -> head $ _tiles $ _rmFloor $ _gRooms gw IM.! pid
Just pid -> head $ _tiles $ _rmFloor $ _genRooms (_gWorld gw) IM.! pid
poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat $ _rmPolys r
shuffleRoomPos :: RandomGen g => Room -> State g Room
@@ -90,7 +90,7 @@ shuffleRoomPos rm = do
placeWires :: GenWorld -> GenWorld
placeWires w = w
& gWorld .~ foldr placeRoomWires (_gWorld w) (_gRooms w)
& gWorld .~ foldr placeRoomWires (_gWorld w) (_genRooms $ _gWorld w)
placeRoomWires :: Room -> World -> World
placeRoomWires rm w = IM.foldr ($) w
@@ -119,18 +119,18 @@ placeWire rm (WallWire p _ h1) (WallWire q _ h2) = foregroundShape
rs = _rmShift rm
doAfterPlacements :: GenWorld -> GenWorld
doAfterPlacements gw = foldr doAfterPlacement gw (_gPlacements gw)
doAfterPlacements gw = foldr doAfterPlacement gw (_genPlacements $ _gWorld gw)
doAfterPlacement :: [(Placement,Int)] -> GenWorld -> GenWorld
doAfterPlacement pmntis gw = gRandify gw $ do
(pmnt,i) <- takeOne pmntis
let (newgw,rm) = fst $ placeSpot (gw,_gRooms gw IM.! i) pmnt
return $ newgw & gRooms . ix i .~ rm
let (newgw,rm) = fst $ placeSpot (gw,_genRooms (_gWorld gw) IM.! i) pmnt
return $ newgw & gWorld . genRooms . ix i .~ rm
doInPlacements :: ( IM.IntMap [Placement],GenWorld) -> GenWorld
doInPlacements (im,w) =
let (gw,rms) = mapAccumR (doRoomInPlacements im) w (_gRooms w)
in gw {_gRooms = rms}
let (gw,rms) = mapAccumR (doRoomInPlacements im) w (_genRooms $ _gWorld w)
in gw & gWorld . genRooms .~ rms
doRoomInPlacements :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room)
doRoomInPlacements im w rm = foldr f (w,rm) $ _rmInPmnt rm
@@ -138,8 +138,8 @@ doRoomInPlacements im w rm = foldr f (w,rm) $ _rmInPmnt rm
f (InPlacement plf i) (w',r') = fst $ placeSpot (w',r') (plf $ im IM.! i)
doOutPlacements :: GenWorld -> ( IM.IntMap [Placement], GenWorld)
doOutPlacements w = let ((pmnts,gw),rms) = mapAccumR doRoomOutPlacements (IM.empty,w) (_gRooms w)
in (pmnts,gw{_gRooms = rms})
doOutPlacements w = let ((pmnts,gw),rms) = mapAccumR doRoomOutPlacements (IM.empty,w) (_genRooms $ _gWorld w)
in (pmnts,gw & gWorld . genRooms .~ rms)
doRoomOutPlacements :: (IM.IntMap [Placement], GenWorld)
-> Room
@@ -151,8 +151,8 @@ doRoomOutPlacements imw r = foldr f ( imw, r ) $ _rmOutPmnt r
in ((IM.insert i plmnts im, neww) , newrm )
doIndividualPlacements :: GenWorld -> GenWorld
doIndividualPlacements gw = let (gw', rms) = mapAccumR doRoomPlacements gw (_gRooms gw)
in gw' {_gRooms = rms}
doIndividualPlacements gw = let (gw', rms) = mapAccumR doRoomPlacements gw (_genRooms $ _gWorld gw)
in gw' & gWorld . genRooms .~ rms
doRoomPlacements :: GenWorld -> Room -> (GenWorld, Room)
doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm
@@ -237,7 +237,7 @@ floorsFromRooms :: [Room] -> [(Point3,Point3)]
floorsFromRooms = concatMap (concatMap tileToRenderList . getTiles . _rmFloor . doRoomShift)
floorsFromGenWorld :: GenWorld -> [(Point3,Point3)]
floorsFromGenWorld = floorsFromRooms . IM.elems . _gRooms
floorsFromGenWorld = floorsFromRooms . IM.elems . _genRooms . _gWorld
getTiles :: Floor -> [Tile]
getTiles fl = case fl of