Move towards scrapping separate GenWorld, merging into World

This commit is contained in:
2022-06-02 18:17:38 +01:00
parent c4fc044845
commit 66d098cfef
7 changed files with 19 additions and 16 deletions
+8
View File
@@ -139,8 +139,15 @@ data World = World
, _worldClock :: Int , _worldClock :: Int
, _doubleMouseHammer :: HammerPosition , _doubleMouseHammer :: HammerPosition
, _backspaceTimer :: Int , _backspaceTimer :: Int
, _genParams :: GenParams
} }
newtype GenParams = GenParams
{ _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape)
}
data DecorationShape = PlusDecoration | SquareDecoration | CircleDecoration | ThreeLineDecoration
deriving (Eq,Ord,Enum,Show)
data HUDElement data HUDElement
= DisplayInventory {_subInventory :: SubInventory} = DisplayInventory {_subInventory :: SubInventory}
| DisplayCarte | DisplayCarte
@@ -1406,3 +1413,4 @@ makeLenses ''AllocateEquipment
makeLenses ''ActivateEquipment makeLenses ''ActivateEquipment
makeLenses ''EquipParams makeLenses ''EquipParams
makeLenses ''TerminalCommand makeLenses ''TerminalCommand
makeLenses ''GenParams
+1
View File
@@ -98,6 +98,7 @@ defaultWorld = World
, _timeFlow = NormalTimeFlow , _timeFlow = NormalTimeFlow
, _doubleMouseHammer = HammerUp , _doubleMouseHammer = HammerUp
, _backspaceTimer = 0 , _backspaceTimer = 0
, _genParams = GenParams M.empty
} }
youLight :: TempLightSource youLight :: TempLightSource
youLight = TLS youLight = TLS
+1 -10
View File
@@ -9,7 +9,7 @@ import Shape.Data
import Data.Tile import Data.Tile
import qualified Data.Set as S import qualified Data.Set as S
import qualified Data.Map.Strict as M --import qualified Data.Map.Strict as M
import Control.Lens import Control.Lens
import Control.Monad.State import Control.Monad.State
import System.Random import System.Random
@@ -170,19 +170,11 @@ data RoomPosType
| RoomPosExLink | RoomPosExLink
| RoomPosLab Int | RoomPosLab Int
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data DecorationShape = PlusDecoration | SquareDecoration | CircleDecoration
| ThreeLineDecoration
deriving (Eq,Ord,Enum,Show)
newtype GenParams = GenParams
{ _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape)
}
data GenWorld = GenWorld data GenWorld = GenWorld
{ _gWorld :: World { _gWorld :: World
, _gPlacements :: IM.IntMap [(Placement,Int)] , _gPlacements :: IM.IntMap [(Placement,Int)]
, _gRooms :: IM.IntMap Room , _gRooms :: IM.IntMap Room
, _gParams :: GenParams
} }
makeLenses ''Room makeLenses ''Room
@@ -195,7 +187,6 @@ makeLenses ''RoomPos
makeLenses ''RoomPosType makeLenses ''RoomPosType
makeLenses ''RPLinkStatus makeLenses ''RPLinkStatus
makeLenses ''GenWorld makeLenses ''GenWorld
makeLenses ''GenParams
spNoID :: PlacementSpot -> PSType -> Placement spNoID :: PlacementSpot -> PSType -> Placement
spNoID ps pst = Placement ps pst Nothing Nothing (const Nothing) spNoID ps pst = Placement ps pst Nothing Nothing (const Nothing)
+4 -2
View File
@@ -9,6 +9,7 @@ import Dodge.LevelGen.Data
import Dodge.Data import Dodge.Data
import Dodge.RandomHelp import Dodge.RandomHelp
import Color import Color
import LensHelp
--import Data.Tree --import Data.Tree
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
@@ -19,11 +20,12 @@ import System.Random
worldToGenWorld :: IM.IntMap Room -> World -> GenWorld worldToGenWorld :: IM.IntMap Room -> World -> GenWorld
worldToGenWorld rms w = GenWorld worldToGenWorld rms w = GenWorld
{ _gWorld = w { _gWorld = w & genParams .~ gparams
, _gPlacements = IM.empty , _gPlacements = IM.empty
, _gRooms = rms , _gRooms = rms
, _gParams = evalState generateGenParams (_randGen w)
} }
where
gparams = evalState generateGenParams (_randGen w)
generateGenParams :: RandomGen g => State g GenParams generateGenParams :: RandomGen g => State g GenParams
generateGenParams = do generateGenParams = do
+1 -1
View File
@@ -24,7 +24,7 @@ damageSensor
damageSensor dt wdth upf ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) damageSensor dt wdth upf ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1)
$ \lsid -> Just $ spNoID ps $ PutUsingGenParams $ \lsid -> Just $ spNoID ps $ PutUsingGenParams
$ \gw -> (,) gw $ PutMachine yellow (reverse $ square wdth) defaultMachine $ \gw -> (,) gw $ PutMachine yellow (reverse $ square wdth) defaultMachine
{ _mcDraw = sensorSPic wdth $ _sensorCoding (_gParams gw) M.! dt { _mcDraw = sensorSPic wdth $ _sensorCoding (_genParams $ _gWorld gw) M.! dt
, _mcUpdate = \mc -> upf mc . sensorUpdate dt mc , _mcUpdate = \mc -> upf mc . sensorUpdate dt mc
, _mcSensor = SensorToggleAmount False 0 , _mcSensor = SensorToggleAmount False 0
, _mcLSs = [lsid] , _mcLSs = [lsid]
+2 -2
View File
@@ -33,8 +33,8 @@ import Data.Bifunctor
-- to the placement -- to the placement
placeSpot :: (GenWorld,Room) -> Placement -> ( (GenWorld,Room), [Placement] ) placeSpot :: (GenWorld,Room) -> Placement -> ( (GenWorld,Room), [Placement] )
placeSpot (w,rm) plmnt = case plmnt of placeSpot (w,rm) plmnt = case plmnt of
pl@Placement{_plGenUpdate = Just f} -> let (gp,pl') = f (_gParams w) pl pl@Placement{_plGenUpdate = Just f} -> let (gp,pl') = f (_genParams $ _gWorld w) pl
in placeSpot (w & gParams .~ gp,rm) pl' in placeSpot (w & gWorld . genParams .~ gp,rm) pl'
Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rm i f plmnt w Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rm i f plmnt w
Placement{_plSpot = PSPos extract eff fallback} -> placeSpotUsingLink w rm plmnt extract eff fallback Placement{_plSpot = PSPos extract eff fallback} -> placeSpotUsingLink w rm plmnt extract eff fallback
Placement{} -> placePlainPSSpot w rm plmnt shift Placement{} -> placePlainPSSpot w rm plmnt shift
+2 -1
View File
@@ -1,6 +1,7 @@
module Dodge.Placement.TopDecoration where module Dodge.Placement.TopDecoration where
import Dodge.Data
import Dodge.Room.Foreground import Dodge.Room.Foreground
import Dodge.LevelGen.Data --import Dodge.LevelGen.Data
import Shape import Shape
import Geometry import Geometry
import Color import Color