Nest fields in CWorld
This commit is contained in:
@@ -184,15 +184,11 @@ data CWorld = CWorld
|
|||||||
, _seenLocations :: IM.IntMap (WdP2, String)
|
, _seenLocations :: IM.IntMap (WdP2, String)
|
||||||
, _selLocation :: Int
|
, _selLocation :: Int
|
||||||
, _distortions :: [Distortion]
|
, _distortions :: [Distortion]
|
||||||
, _worldBounds :: Bounds
|
|
||||||
, _gameRooms :: [GameRoom] -- consider using an IntMap
|
|
||||||
, _roomClipping :: [ConvexPoly]
|
|
||||||
, _maybeWorld :: Maybe' CWorld
|
, _maybeWorld :: Maybe' CWorld
|
||||||
, _rewindWorlds :: [CWorld]
|
, _rewindWorlds :: [CWorld]
|
||||||
, _worldClock :: Int
|
, _worldClock :: Int
|
||||||
, _genParams :: GenParams
|
|
||||||
, _deathDelay :: Maybe Int
|
, _deathDelay :: Maybe Int
|
||||||
, _cwSeed :: Int
|
, _cwGen :: CWGen
|
||||||
}
|
}
|
||||||
|
|
||||||
data CWGen = CWGen
|
data CWGen = CWGen
|
||||||
@@ -200,6 +196,7 @@ data CWGen = CWGen
|
|||||||
, _cwgWorldBounds :: Bounds
|
, _cwgWorldBounds :: Bounds
|
||||||
, _cwgGameRooms :: [GameRoom] -- consider using an IntMap
|
, _cwgGameRooms :: [GameRoom] -- consider using an IntMap
|
||||||
, _cwgRoomClipping :: [ConvexPoly]
|
, _cwgRoomClipping :: [ConvexPoly]
|
||||||
|
, _cwgSeed :: Int
|
||||||
}
|
}
|
||||||
|
|
||||||
data WorldBeams = WorldBeams
|
data WorldBeams = WorldBeams
|
||||||
@@ -213,9 +210,11 @@ data WorldBeams = WorldBeams
|
|||||||
deriveJSON defaultOptions ''CWorld
|
deriveJSON defaultOptions ''CWorld
|
||||||
deriveJSON defaultOptions ''WorldBeams
|
deriveJSON defaultOptions ''WorldBeams
|
||||||
deriveJSON defaultOptions ''CWCam
|
deriveJSON defaultOptions ''CWCam
|
||||||
|
deriveJSON defaultOptions ''CWGen
|
||||||
makeLenses ''CWorld
|
makeLenses ''CWorld
|
||||||
makeLenses ''WorldBeams
|
makeLenses ''WorldBeams
|
||||||
makeLenses ''CWCam
|
makeLenses ''CWCam
|
||||||
|
makeLenses ''CWGen
|
||||||
-- $($(derive [d|
|
-- $($(derive [d|
|
||||||
-- instance Deriving (Store CWorld)
|
-- instance Deriving (Store CWorld)
|
||||||
-- |]))
|
-- |]))
|
||||||
|
|||||||
@@ -1,6 +1,5 @@
|
|||||||
module Dodge.Default.World where
|
module Dodge.Default.World where
|
||||||
|
|
||||||
import MaybeHelp
|
|
||||||
import Data.Graph.Inductive.Graph hiding ((&))
|
import Data.Graph.Inductive.Graph hiding ((&))
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
@@ -8,6 +7,7 @@ import Dodge.Data.World
|
|||||||
import Geometry.Data
|
import Geometry.Data
|
||||||
import Geometry.Polygon
|
import Geometry.Polygon
|
||||||
import qualified IntMapHelp as IM
|
import qualified IntMapHelp as IM
|
||||||
|
import MaybeHelp
|
||||||
import System.Random
|
import System.Random
|
||||||
|
|
||||||
--import Data.Graph.Inductive.NodeMap
|
--import Data.Graph.Inductive.NodeMap
|
||||||
@@ -33,8 +33,19 @@ defaultWorld =
|
|||||||
, _rbOptions = NoRightButtonOptions
|
, _rbOptions = NoRightButtonOptions
|
||||||
}
|
}
|
||||||
|
|
||||||
|
defaultCWGen :: CWGen
|
||||||
|
defaultCWGen =
|
||||||
|
CWGen
|
||||||
|
{ _cwgParams = GenParams M.empty
|
||||||
|
, _cwgSeed = 0
|
||||||
|
, _cwgWorldBounds = defaultBounds
|
||||||
|
, _cwgGameRooms = []
|
||||||
|
, _cwgRoomClipping = []
|
||||||
|
}
|
||||||
|
|
||||||
defaultCWCam :: CWCam
|
defaultCWCam :: CWCam
|
||||||
defaultCWCam = CWCam
|
defaultCWCam =
|
||||||
|
CWCam
|
||||||
{ _cwcCenter = V2 0 0
|
{ _cwcCenter = V2 0 0
|
||||||
, _cwcRot = 0
|
, _cwcRot = 0
|
||||||
, _cwcZoom = 1
|
, _cwcZoom = 1
|
||||||
@@ -46,11 +57,11 @@ defaultCWCam = CWCam
|
|||||||
, _cwcBoundDist = (100, -100, 100, -100)
|
, _cwcBoundDist = (100, -100, 100, -100)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
defaultCWorld :: CWorld
|
defaultCWorld :: CWorld
|
||||||
defaultCWorld =
|
defaultCWorld =
|
||||||
CWorld
|
CWorld
|
||||||
{ _cwCam = defaultCWCam
|
{ _cwCam = defaultCWCam
|
||||||
|
, _cwGen = defaultCWGen
|
||||||
, _magnets = IM.empty
|
, _magnets = IM.empty
|
||||||
, _modifications = IM.empty
|
, _modifications = IM.empty
|
||||||
, _creatures = IM.empty
|
, _creatures = IM.empty
|
||||||
@@ -120,15 +131,10 @@ defaultCWorld =
|
|||||||
, _selLocation = 0
|
, _selLocation = 0
|
||||||
, _foregroundShapes = mempty
|
, _foregroundShapes = mempty
|
||||||
, _distortions = []
|
, _distortions = []
|
||||||
, _gameRooms = []
|
|
||||||
, _roomClipping = []
|
|
||||||
, _worldClock = 0
|
, _worldClock = 0
|
||||||
, _worldBounds = defaultBounds
|
|
||||||
, _maybeWorld = Nothing'
|
, _maybeWorld = Nothing'
|
||||||
, _rewindWorlds = []
|
, _rewindWorlds = []
|
||||||
, _genParams = GenParams M.empty
|
|
||||||
, _deathDelay = Nothing
|
, _deathDelay = Nothing
|
||||||
, _cwSeed = 0
|
|
||||||
}
|
}
|
||||||
|
|
||||||
defaultWorldHammers :: M.Map WorldHammer HammerPosition
|
defaultWorldHammers :: M.Map WorldHammer HammerPosition
|
||||||
|
|||||||
+2
-2
@@ -43,7 +43,7 @@ generateLevelFromRoomList gr' w =
|
|||||||
. setFloors
|
. setFloors
|
||||||
. worldToGenWorld rs'
|
. worldToGenWorld rs'
|
||||||
$ w & cWorld . walls .~ wallsFromRooms rs
|
$ w & cWorld . walls .~ wallsFromRooms rs
|
||||||
& cWorld . gameRooms .~ gameRoomsFromRooms (IM.elems rs')
|
& cWorld . cwGen . cwgGameRooms .~ gameRoomsFromRooms (IM.elems rs')
|
||||||
& cWorld . pathGraph .~ path
|
& cWorld . pathGraph .~ path
|
||||||
& cWorld . pnZoning .~ foldl' (flip zonePn) mempty (labNodes path)
|
& cWorld . pnZoning .~ foldl' (flip zonePn) mempty (labNodes path)
|
||||||
& cWorld . peZoning .~ foldl' (flip zonePe) mempty (labEdges path)
|
& cWorld . peZoning .~ foldl' (flip zonePe) mempty (labEdges path)
|
||||||
@@ -129,7 +129,7 @@ doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w, rm) $ _rmPmnts rm
|
|||||||
|
|
||||||
setupWorldBounds :: World -> World
|
setupWorldBounds :: World -> World
|
||||||
setupWorldBounds w =
|
setupWorldBounds w =
|
||||||
w & cWorld . worldBounds
|
w & cWorld . cwGen . cwgWorldBounds
|
||||||
%~ ( (bdMinX .~ f minx)
|
%~ ( (bdMinX .~ f minx)
|
||||||
. (bdMaxX .~ f maxx)
|
. (bdMaxX .~ f maxx)
|
||||||
. (bdMinY .~ f miny)
|
. (bdMinY .~ f miny)
|
||||||
|
|||||||
@@ -27,8 +27,8 @@ generateWorldFromSeed i = do
|
|||||||
return $
|
return $
|
||||||
postGenerationProcessing $
|
postGenerationProcessing $
|
||||||
_gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen = mkStdGen i})
|
_gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen = mkStdGen i})
|
||||||
& cWorld . roomClipping .~ bounds
|
& cWorld . cwGen . cwgRoomClipping .~ bounds
|
||||||
& cWorld . cwSeed .~ i
|
& cWorld . cwGen . cwgSeed .~ i
|
||||||
|
|
||||||
postGenerationProcessing :: World -> World
|
postGenerationProcessing :: World -> World
|
||||||
postGenerationProcessing w = foldl' assignPushDoors w (_doors (_cWorld w))
|
postGenerationProcessing w = foldl' assignPushDoors w (_doors (_cWorld w))
|
||||||
|
|||||||
@@ -14,7 +14,7 @@ import RandomHelp
|
|||||||
worldToGenWorld :: IM.IntMap Room -> World -> GenWorld
|
worldToGenWorld :: IM.IntMap Room -> World -> GenWorld
|
||||||
worldToGenWorld rms w =
|
worldToGenWorld rms w =
|
||||||
GenWorld
|
GenWorld
|
||||||
{ _gwWorld = w & cWorld . genParams .~ evalState generateGenParams (_randGen w)
|
{ _gwWorld = w & cWorld . cwGen . cwgParams .~ evalState generateGenParams (_randGen w)
|
||||||
, _genRooms = rms
|
, _genRooms = rms
|
||||||
, _genPlacements = mempty
|
, _genPlacements = mempty
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -83,4 +83,4 @@ absClamp ::
|
|||||||
Float ->
|
Float ->
|
||||||
Float ->
|
Float ->
|
||||||
Float
|
Float
|
||||||
absClamp maxVal x = max (negate maxVal) $ min maxVal x
|
absClamp maxVal = max (negate maxVal) . min maxVal
|
||||||
|
|||||||
@@ -35,7 +35,7 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
|
|||||||
False
|
False
|
||||||
0
|
0
|
||||||
dt
|
dt
|
||||||
(_sensorCoding (_genParams (_cWorld gw)) M.! dt)
|
(_sensorCoding (_cwgParams $ _cwGen (_cWorld gw)) M.! dt)
|
||||||
(damageTypeThreshold dt)
|
(damageTypeThreshold dt)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -449,14 +449,14 @@ viewBoundaries w =
|
|||||||
<> color yellow (foldMap (\q -> line [p, q]) $ farWallPoints p w)
|
<> color yellow (foldMap (\q -> line [p, q]) $ farWallPoints p w)
|
||||||
where
|
where
|
||||||
p = _crPos $ you w
|
p = _crPos $ you w
|
||||||
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms (_cWorld w))
|
grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen (_cWorld w))
|
||||||
|
|
||||||
viewClipBounds :: Configuration -> World -> Picture
|
viewClipBounds :: Configuration -> World -> Picture
|
||||||
viewClipBounds cfig w
|
viewClipBounds cfig w
|
||||||
| _debug_view_clip_bounds cfig == AllRoomClipBoundaries =
|
| _debug_view_clip_bounds cfig == AllRoomClipBoundaries =
|
||||||
setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_roomClipping (_cWorld w))
|
setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_cwgRoomClipping $ _cwGen (_cWorld w))
|
||||||
| _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries =
|
| _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries =
|
||||||
setLayer DebugLayer $ f (_roomClipping (_cWorld w))
|
setLayer DebugLayer $ f (_cwgRoomClipping $ _cwGen (_cWorld w))
|
||||||
| otherwise = mempty
|
| otherwise = mempty
|
||||||
where
|
where
|
||||||
f (x : xs) = g x xs <> f xs
|
f (x : xs) = g x xs <> f xs
|
||||||
|
|||||||
@@ -170,7 +170,7 @@ guardDisconnected tm w w' = case _tmStatus tm of
|
|||||||
TerminalReady -> w'
|
TerminalReady -> w'
|
||||||
|
|
||||||
getDamageCoding :: World -> M.Map String [TerminalLine]
|
getDamageCoding :: World -> M.Map String [TerminalLine]
|
||||||
getDamageCoding = decodedtmap . _sensorCoding . _genParams . _cWorld
|
getDamageCoding = decodedtmap . _sensorCoding . _cwgParams . _cwGen . _cWorld
|
||||||
|
|
||||||
sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine]
|
sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine]
|
||||||
sensorInfoMap tm w =
|
sensorInfoMap tm w =
|
||||||
|
|||||||
@@ -230,7 +230,7 @@ streamViewpoints :: Monad m => Point2 -> World -> Stream (Of Point2) m ()
|
|||||||
{-# INLINE streamViewpoints #-}
|
{-# INLINE streamViewpoints #-}
|
||||||
streamViewpoints p w =
|
streamViewpoints p w =
|
||||||
flip S.for (gameRoomViewpoints p) $
|
flip S.for (gameRoomViewpoints p) $
|
||||||
S.filter (pointInOrOnPolygon p . _grBound) $ S.each (_gameRooms (_cWorld w))
|
S.filter (pointInOrOnPolygon p . _grBound) $ S.each (_cwgGameRooms $ _cwGen (_cWorld w))
|
||||||
|
|
||||||
gameRoomViewpoints :: Monad m => Point2 -> GameRoom -> Stream (Of Point2) m ()
|
gameRoomViewpoints :: Monad m => Point2 -> GameRoom -> Stream (Of Point2) m ()
|
||||||
gameRoomViewpoints p gr =
|
gameRoomViewpoints p gr =
|
||||||
@@ -264,7 +264,7 @@ extendedViewPoints p grs =
|
|||||||
farWallPoints :: Point2 -> World -> [Point2]
|
farWallPoints :: Point2 -> World -> [Point2]
|
||||||
farWallPoints p w = concatMap _grViewpoints grs ++ extendedViewPoints p grs
|
farWallPoints p w = concatMap _grViewpoints grs ++ extendedViewPoints p grs
|
||||||
where
|
where
|
||||||
grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms (_cWorld w))
|
grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen (_cWorld w))
|
||||||
|
|
||||||
maxViewDistance :: Float
|
maxViewDistance :: Float
|
||||||
maxViewDistance = 800
|
maxViewDistance = 800
|
||||||
|
|||||||
Reference in New Issue
Block a user