Reinstate genworld concept
This commit is contained in:
+19
-19
@@ -31,10 +31,10 @@ import qualified Control.Foldl as L
|
||||
import Data.Maybe
|
||||
import Data.Function
|
||||
|
||||
generateLevelFromRoomList :: IM.IntMap Room -> World -> World
|
||||
generateLevelFromRoomList gr' w = initWallZoning
|
||||
. randomCompass
|
||||
. setupWorldBounds
|
||||
generateLevelFromRoomList :: IM.IntMap Room -> World -> GenWorld
|
||||
generateLevelFromRoomList gr' w = over gwWorld initWallZoning
|
||||
. over gwWorld randomCompass
|
||||
. over gwWorld setupWorldBounds
|
||||
. doAfterPlacements
|
||||
. doInPlacements
|
||||
. doOutPlacements
|
||||
@@ -57,19 +57,19 @@ generateLevelFromRoomList gr' w = initWallZoning
|
||||
randomCompass :: World -> World
|
||||
randomCompass w = w & cameraRot .~ (takeOne [0,0.5*pi,pi,1.5*pi] & evalState $ _randGen w)
|
||||
|
||||
putFloorTiles :: World -> World
|
||||
putFloorTiles gw = gw & floorTiles .~ floorsFromGenWorld gw
|
||||
putFloorTiles :: GenWorld -> GenWorld
|
||||
putFloorTiles gw = gw & gwWorld . floorTiles .~ floorsFromGenWorld gw
|
||||
|
||||
setFloors :: World -> World
|
||||
setFloors :: GenWorld -> GenWorld
|
||||
setFloors = putFloorTiles . setTiles
|
||||
|
||||
-- note the order of traversal of the rooms is important
|
||||
-- hence the reverse
|
||||
-- this is not ideal: should do this in some more sensible way
|
||||
setTiles :: World -> World
|
||||
setTiles :: GenWorld -> GenWorld
|
||||
setTiles gw = foldr setTile gw . reverse . IM.elems $ _genRooms gw
|
||||
|
||||
setTile :: Room -> World -> World
|
||||
setTile :: Room -> GenWorld -> GenWorld
|
||||
setTile r gw = case _rmFloor r of
|
||||
Tiled {} -> gw
|
||||
InheritFloor -> gw & genRooms . ix (fromJust (_rmMID r)) . rmFloor .~ Tiled [t & tilePoly .~ poly]
|
||||
@@ -84,43 +84,43 @@ shuffleRoomPos rm = do
|
||||
newPos <- shuffle $ _rmPos rm
|
||||
return $ rm & rmPos .~ newPos
|
||||
|
||||
doAfterPlacements :: World -> World
|
||||
doAfterPlacements :: GenWorld -> GenWorld
|
||||
doAfterPlacements gw = foldr doAfterPlacement gw (_genPlacements gw)
|
||||
|
||||
doAfterPlacement :: [(Placement,Int)] -> World -> World
|
||||
doAfterPlacement :: [(Placement,Int)] -> GenWorld -> GenWorld
|
||||
doAfterPlacement pmntis gw = gRandify gw $ do
|
||||
(pmnt,i) <- takeOne pmntis
|
||||
let (newgw,rm) = fst $ placeSpot (gw,_genRooms gw IM.! i) pmnt
|
||||
return $ newgw & genRooms . ix i .~ rm
|
||||
|
||||
doInPlacements :: ( IM.IntMap [Placement],World) -> World
|
||||
doInPlacements :: ( IM.IntMap [Placement],GenWorld) -> GenWorld
|
||||
doInPlacements (im,w) =
|
||||
let (gw,rms) = mapAccumR (doRoomInPlacements im) w (_genRooms w)
|
||||
in gw & genRooms .~ rms
|
||||
|
||||
doRoomInPlacements :: IM.IntMap [Placement] -> World -> Room -> (World, Room)
|
||||
doRoomInPlacements :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room)
|
||||
doRoomInPlacements im w rm = foldr f (w,rm) $ _rmInPmnt rm
|
||||
where
|
||||
f (InPlacement plf i) (w',r') = fst $ placeSpot (w',r') (plf $ im IM.! i)
|
||||
|
||||
doOutPlacements :: World -> ( IM.IntMap [Placement], World)
|
||||
doOutPlacements :: GenWorld -> ( IM.IntMap [Placement], GenWorld)
|
||||
doOutPlacements w = let ((pmnts,gw),rms) = mapAccumR doRoomOutPlacements (IM.empty,w) (_genRooms w)
|
||||
in (pmnts,gw & genRooms .~ rms)
|
||||
|
||||
doRoomOutPlacements :: (IM.IntMap [Placement], World)
|
||||
doRoomOutPlacements :: (IM.IntMap [Placement], GenWorld)
|
||||
-> Room
|
||||
-> ( (IM.IntMap [Placement], World) , Room )
|
||||
-> ( (IM.IntMap [Placement], GenWorld) , Room )
|
||||
doRoomOutPlacements imw r = foldr f ( imw, r ) $ _rmOutPmnt r
|
||||
where
|
||||
f (OutPlacement pl i) ( (im,w) , rm ) =
|
||||
let ((neww,newrm),plmnts) = placeSpot (w,rm) pl
|
||||
in ((IM.insert i plmnts im, neww) , newrm )
|
||||
|
||||
doIndividualPlacements :: World -> World
|
||||
doIndividualPlacements :: GenWorld -> GenWorld
|
||||
doIndividualPlacements gw = let (gw', rms) = mapAccumR doRoomPlacements gw (_genRooms gw)
|
||||
in gw' & genRooms .~ rms
|
||||
|
||||
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
|
||||
@@ -202,7 +202,7 @@ gameRoomFromRoom rm = GameRoom
|
||||
floorsFromRooms :: [Room] -> [(Point3,Point3)]
|
||||
floorsFromRooms = concatMap (concatMap tileToRenderList . getTiles . _rmFloor . doRoomShift)
|
||||
|
||||
floorsFromGenWorld :: World -> [(Point3,Point3)]
|
||||
floorsFromGenWorld :: GenWorld -> [(Point3,Point3)]
|
||||
floorsFromGenWorld = floorsFromRooms . IM.elems . _genRooms
|
||||
|
||||
getTiles :: Floor -> [Tile]
|
||||
|
||||
Reference in New Issue
Block a user