From 3b7841677a5d33d2e0c96bd0e31fd694904bad1f Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 19 Aug 2022 11:28:19 +0100 Subject: [PATCH] Nest fields in CWorld --- src/Dodge/Data/CWorld.hs | 9 ++++----- src/Dodge/Default/World.hs | 22 ++++++++++++++-------- src/Dodge/Layout.hs | 4 ++-- src/Dodge/LevelGen.hs | 4 ++-- src/Dodge/LevelGen/LevelStructure.hs | 2 +- src/Dodge/Picture/SizeInvariant.hs | 2 +- src/Dodge/Placement/Instance/Sensor.hs | 2 +- src/Dodge/Render/ShapePicture.hs | 6 +++--- src/Dodge/Terminal.hs | 2 +- src/Dodge/Update/Camera.hs | 4 ++-- 10 files changed, 31 insertions(+), 26 deletions(-) diff --git a/src/Dodge/Data/CWorld.hs b/src/Dodge/Data/CWorld.hs index 8f6d2c380..cc3116f44 100644 --- a/src/Dodge/Data/CWorld.hs +++ b/src/Dodge/Data/CWorld.hs @@ -184,15 +184,11 @@ data CWorld = CWorld , _seenLocations :: IM.IntMap (WdP2, String) , _selLocation :: Int , _distortions :: [Distortion] - , _worldBounds :: Bounds - , _gameRooms :: [GameRoom] -- consider using an IntMap - , _roomClipping :: [ConvexPoly] , _maybeWorld :: Maybe' CWorld , _rewindWorlds :: [CWorld] , _worldClock :: Int - , _genParams :: GenParams , _deathDelay :: Maybe Int - , _cwSeed :: Int + , _cwGen :: CWGen } data CWGen = CWGen @@ -200,6 +196,7 @@ data CWGen = CWGen , _cwgWorldBounds :: Bounds , _cwgGameRooms :: [GameRoom] -- consider using an IntMap , _cwgRoomClipping :: [ConvexPoly] + , _cwgSeed :: Int } data WorldBeams = WorldBeams @@ -213,9 +210,11 @@ data WorldBeams = WorldBeams deriveJSON defaultOptions ''CWorld deriveJSON defaultOptions ''WorldBeams deriveJSON defaultOptions ''CWCam +deriveJSON defaultOptions ''CWGen makeLenses ''CWorld makeLenses ''WorldBeams makeLenses ''CWCam +makeLenses ''CWGen -- $($(derive [d| -- instance Deriving (Store CWorld) -- |])) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 95d9233bd..2abdddee9 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -1,6 +1,5 @@ module Dodge.Default.World where -import MaybeHelp import Data.Graph.Inductive.Graph hiding ((&)) import qualified Data.Map as M import qualified Data.Set as S @@ -8,6 +7,7 @@ import Dodge.Data.World import Geometry.Data import Geometry.Polygon import qualified IntMapHelp as IM +import MaybeHelp import System.Random --import Data.Graph.Inductive.NodeMap @@ -33,8 +33,19 @@ defaultWorld = , _rbOptions = NoRightButtonOptions } +defaultCWGen :: CWGen +defaultCWGen = + CWGen + { _cwgParams = GenParams M.empty + , _cwgSeed = 0 + , _cwgWorldBounds = defaultBounds + , _cwgGameRooms = [] + , _cwgRoomClipping = [] + } + defaultCWCam :: CWCam -defaultCWCam = CWCam +defaultCWCam = + CWCam { _cwcCenter = V2 0 0 , _cwcRot = 0 , _cwcZoom = 1 @@ -45,12 +56,12 @@ defaultCWCam = CWCam , _cwcBoundBox = square 100 , _cwcBoundDist = (100, -100, 100, -100) } - defaultCWorld :: CWorld defaultCWorld = CWorld { _cwCam = defaultCWCam + , _cwGen = defaultCWGen , _magnets = IM.empty , _modifications = IM.empty , _creatures = IM.empty @@ -120,15 +131,10 @@ defaultCWorld = , _selLocation = 0 , _foregroundShapes = mempty , _distortions = [] - , _gameRooms = [] - , _roomClipping = [] , _worldClock = 0 - , _worldBounds = defaultBounds , _maybeWorld = Nothing' , _rewindWorlds = [] - , _genParams = GenParams M.empty , _deathDelay = Nothing - , _cwSeed = 0 } defaultWorldHammers :: M.Map WorldHammer HammerPosition diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index f7f0b3cdd..7bf1020c9 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -43,7 +43,7 @@ generateLevelFromRoomList gr' w = . setFloors . worldToGenWorld rs' $ w & cWorld . walls .~ wallsFromRooms rs - & cWorld . gameRooms .~ gameRoomsFromRooms (IM.elems rs') + & cWorld . cwGen . cwgGameRooms .~ gameRoomsFromRooms (IM.elems rs') & cWorld . pathGraph .~ path & cWorld . pnZoning .~ foldl' (flip zonePn) mempty (labNodes 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 w = - w & cWorld . worldBounds + w & cWorld . cwGen . cwgWorldBounds %~ ( (bdMinX .~ f minx) . (bdMaxX .~ f maxx) . (bdMinY .~ f miny) diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 544875f92..1bca629c6 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -27,8 +27,8 @@ generateWorldFromSeed i = do return $ postGenerationProcessing $ _gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen = mkStdGen i}) - & cWorld . roomClipping .~ bounds - & cWorld . cwSeed .~ i + & cWorld . cwGen . cwgRoomClipping .~ bounds + & cWorld . cwGen . cwgSeed .~ i postGenerationProcessing :: World -> World postGenerationProcessing w = foldl' assignPushDoors w (_doors (_cWorld w)) diff --git a/src/Dodge/LevelGen/LevelStructure.hs b/src/Dodge/LevelGen/LevelStructure.hs index 2d0d91480..18c3340ff 100644 --- a/src/Dodge/LevelGen/LevelStructure.hs +++ b/src/Dodge/LevelGen/LevelStructure.hs @@ -14,7 +14,7 @@ import RandomHelp worldToGenWorld :: IM.IntMap Room -> World -> GenWorld worldToGenWorld rms w = GenWorld - { _gwWorld = w & cWorld . genParams .~ evalState generateGenParams (_randGen w) + { _gwWorld = w & cWorld . cwGen . cwgParams .~ evalState generateGenParams (_randGen w) , _genRooms = rms , _genPlacements = mempty } diff --git a/src/Dodge/Picture/SizeInvariant.hs b/src/Dodge/Picture/SizeInvariant.hs index 1047714e6..3dcda7621 100644 --- a/src/Dodge/Picture/SizeInvariant.hs +++ b/src/Dodge/Picture/SizeInvariant.hs @@ -83,4 +83,4 @@ absClamp :: Float -> Float -> Float -absClamp maxVal x = max (negate maxVal) $ min maxVal x +absClamp maxVal = max (negate maxVal) . min maxVal diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index 91d51d318..1e4d72f54 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/src/Dodge/Placement/Instance/Sensor.hs @@ -35,7 +35,7 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $ False 0 dt - (_sensorCoding (_genParams (_cWorld gw)) M.! dt) + (_sensorCoding (_cwgParams $ _cwGen (_cWorld gw)) M.! dt) (damageTypeThreshold dt) ) ) diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index ac13351f3..fe6a2a76a 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -449,14 +449,14 @@ viewBoundaries w = <> color yellow (foldMap (\q -> line [p, q]) $ farWallPoints p w) where 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 cfig w | _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 = - setLayer DebugLayer $ f (_roomClipping (_cWorld w)) + setLayer DebugLayer $ f (_cwgRoomClipping $ _cwGen (_cWorld w)) | otherwise = mempty where f (x : xs) = g x xs <> f xs diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index dc6e55882..4bfcff120 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -170,7 +170,7 @@ guardDisconnected tm w w' = case _tmStatus tm of TerminalReady -> w' 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 tm w = diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 565e3b426..4dcb704b6 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -230,7 +230,7 @@ streamViewpoints :: Monad m => Point2 -> World -> Stream (Of Point2) m () {-# INLINE streamViewpoints #-} streamViewpoints p w = 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 p gr = @@ -264,7 +264,7 @@ extendedViewPoints p grs = farWallPoints :: Point2 -> World -> [Point2] farWallPoints p w = concatMap _grViewpoints grs ++ extendedViewPoints p grs where - grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms (_cWorld w)) + grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen (_cWorld w)) maxViewDistance :: Float maxViewDistance = 800