From 35cd213bcf5f48aed2e30a43d0cb0393aa9c6732 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 2 Jun 2022 18:48:20 +0100 Subject: [PATCH] Move GenWorld fields into World --- src/Dodge/Annotation.hs | 1 + src/Dodge/Annotation/Data.hs | 2 +- src/Dodge/Data.hs | 175 ++++++++++++++++++ src/Dodge/Debug/LinkDecoration.hs | 2 +- src/Dodge/Default/Room.hs | 3 +- src/Dodge/Default/World.hs | 2 + src/Dodge/Floor.hs | 1 + src/Dodge/Layout.hs | 30 +-- src/Dodge/LevelGen.hs | 2 +- src/Dodge/LevelGen/Data.hs | 183 +------------------ src/Dodge/LevelGen/LevelStructure.hs | 5 +- src/Dodge/LockAndKey.hs | 2 +- src/Dodge/Placement/Instance/Analyser.hs | 2 +- src/Dodge/Placement/Instance/Creature.hs | 3 +- src/Dodge/Placement/PlaceSpot.hs | 4 +- src/Dodge/Placement/PlaceSpot/Block.hs | 2 +- src/Dodge/Placement/PlaceSpot/TriggerDoor.hs | 2 +- src/Dodge/Placement/Shift.hs | 3 +- src/Dodge/PlacementSpot.hs | 3 +- src/Dodge/Randify.hs | 2 +- src/Dodge/Room/Branch.hs | 3 +- src/Dodge/Room/CheckConsistency.hs | 3 +- src/Dodge/Room/Corridor.hs | 3 +- src/Dodge/Room/Door.hs | 2 +- src/Dodge/Room/GlassLesson.hs | 1 + src/Dodge/Room/Link.hs | 3 +- src/Dodge/Room/LongRoom.hs | 1 + src/Dodge/Room/Modify/Girder.hs | 1 + src/Dodge/Room/Ngon.hs | 3 +- src/Dodge/Room/Path.hs | 3 +- src/Dodge/Room/Warning.hs | 2 +- src/Dodge/RoomLink.hs | 3 +- src/Dodge/RoomPos.hs | 3 +- src/Dodge/Tree/Shift.hs | 3 +- src/Dodge/Wire.hs | 3 +- 35 files changed, 247 insertions(+), 219 deletions(-) diff --git a/src/Dodge/Annotation.hs b/src/Dodge/Annotation.hs index f42646ac6..204429a63 100644 --- a/src/Dodge/Annotation.hs +++ b/src/Dodge/Annotation.hs @@ -7,6 +7,7 @@ module Dodge.Annotation import Dodge.RandomHelp import Dodge.Tree import Dodge.Room +import Dodge.Data import Dodge.Annotation.Data --import LensHelp diff --git a/src/Dodge/Annotation/Data.hs b/src/Dodge/Annotation/Data.hs index 17ca73aeb..419b5b3a3 100644 --- a/src/Dodge/Annotation/Data.hs +++ b/src/Dodge/Annotation/Data.hs @@ -2,7 +2,7 @@ {-# LANGUAGE StrictData #-} module Dodge.Annotation.Data where import Dodge.Data -import Dodge.Room +--import Dodge.Room import Dodge.Tree.Compose.Data import Control.Monad.State diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 432010a0f..8eeef14b9 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -46,6 +46,7 @@ import Sound.Data import Dodge.GameRoom import Color import Shape +import Data.Tile --import qualified Data.Vector as V import GHC.Generics @@ -140,6 +141,8 @@ data World = World , _doubleMouseHammer :: HammerPosition , _backspaceTimer :: Int , _genParams :: GenParams + , _genPlacements :: IM.IntMap [(Placement,Int)] + , _genRooms :: IM.IntMap Room } newtype GenParams = GenParams @@ -1346,6 +1349,166 @@ data TerminalCommand = TerminalCommand , _tcEffect :: [String] -> World -> Either String World } + +---- ROOM DATATYPES +data PSType = PutCrit {_unPutCrit :: Creature} + | PutMachine { _putMachineColor :: Color, _putMachinePoly :: [Point2], _unPutMachine :: Machine } + | PutLS LightSource + | PutButton {_putButton :: Button} + | PutProp Prop + | PutFlIt Item + | PutPPlate PressPlate + | PutBlock BlockMaterial Int [Int] Wall [Point2] + | PutCoord Point2 + | PutMod Modification + | PutTrigger (World -> Bool) + | PutLineBlock {_putWall :: Wall, _putBlockMaterial :: BlockMaterial + , _putWidth :: Float, _putDepth :: Float, _putStartPoint :: Point2, _putEndPoint :: Point2} + | PutWall { _pwPoly :: [Point2] , _pwWall :: Wall } + | PutSlideDr Bool Color (World -> Bool) Float Point2 Point2 Float + | PutDoor Color (World -> Bool) [(Point2,Point2)] + | RandPS (State StdGen PSType) + | PutShape Shape + | PutWorldUpdate (PlacementSpot -> World -> World) + | PutNothing + | PutUsingGenParams (GenWorld -> (GenWorld,PSType)) + | PutID { _putID :: Int} +-- maybe there is a monadic implementation of this? +-- add room effect for any placement spot? +data PlacementSpot + = PS { _psPos :: Point2 , _psRot :: Float } + | PSNoShiftCont { _psPos :: Point2 , _psRot :: Float } + | PSPos + { _psSelect :: RoomPos -> Room -> Maybe (PlacementSpot, RoomPos) + , _psRoomEff :: RoomPos -> Room -> Room + , _psFallback :: Maybe Placement + } + | PSRoomRand + { _psRoomRandPointNum :: Int + , _psRandShift :: (Point2,Float) -> PlacementSpot + } +-- TODO attempt to unify/simplify this union type +data Placement + = Placement + { _plSpot :: PlacementSpot + , _plType :: PSType + , _plMID :: Maybe Int + , _plGenUpdate :: Maybe (GenParams -> Placement -> (GenParams, Placement) ) + , _plIDCont :: Placement -> Maybe Placement + } + | PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position + | RandomPlacement {_unRandomPlacement :: State StdGen Placement} + | PickOnePlacement Int Placement + +{- The '_rmPolys' lists which polygons should be cut out to form the indestructible walls of the room. +Link pairs contain a position and rotation to attach to another room; +0 is for links going to another room to the north, pi/2 for links going to a room to the west, etc. +TODO : Explain path, does it need both directions? +Placement spots allow things to be put in the room during level generation. +Room bounds between a new room and previously placed rooms are checked during level generation, +assigning no bounds will allow rooms to overlap. -} +data Room = Room + { _rmPolys :: [ [Point2] ] + , _rmLinks :: [RoomLink] + --, _rmOutLinks :: [RoomLink] + --, _rmInLinks :: [RoomLink] + -- update the room when assigning the next link to an adjacent room with the head of of this list, return the tail + , _rmLinkEff :: [(Point2,Float) -> Room -> Room] + , _rmPos :: [RoomPos] + , _rmPath :: [(Point2, Point2)] + , _rmPmnts :: [Placement] + , _rmInPmnt :: [InPlacement] + , _rmOutPmnt :: [OutPlacement] + , _rmBound :: [ [Point2] ] + , _rmFloor :: Floor + , _rmName :: String + , _rmShift :: (Point2, Float) + , _rmViewpoints :: [Point2] + , _rmRandPSs :: [State StdGen (Point2,Float)] + , _rmStartWires :: IM.IntMap RoomWire + , _rmEndWires :: IM.IntMap RoomWire + , _rmConnectsTo :: S.Set RoomLinkType -> Bool + , _rmMID :: Maybe Int + , _rmMParent :: Maybe Int + , _rmChildren :: [Int] + , _rmType :: RoomType + } +data RoomLink = RoomLink + { _rlType :: S.Set RoomLinkType + , _rlPos :: Point2 + , _rlDir :: Float + } deriving (Eq,Ord) +data RoomType = DefaultRoomType + | RectRoomType + { _numLinkEW :: Int + , _numLinkNS :: Int + , _linkGapEW :: Float + , _linkGapNS :: Float + , _rmWidth :: Float + , _rmHeight :: Float + } + deriving (Eq,Ord) +data RoomLinkType + = OutLink + | InLink + | LabLink Int + | OnEdge CardinalPoint + | FromSouth Int + | FromNorth Int + | FromWest Int + | FromEast Int + deriving (Eq,Ord,Show) +data CardinalPoint + = North + | East + | South + | West + deriving (Eq,Ord,Show) +data RoomWire + = --RoomWire Point2 Float + WallWire Point2 Float Float + +data RPLinkStatus + = UsedOutLink + { _rplsType :: S.Set RoomLinkType + , _rplsChildNum :: Int + , _rplsOutRoomID :: Int + } + | UsedInLink + { _rplsType :: S.Set RoomLinkType + , _rplsInRoomID :: Int + } + | UnusedLink { _rplsType :: S.Set RoomLinkType } + | NotLink + deriving (Eq,Ord,Show) +data OutPlacement = OutPlacement + { _opPlacement :: Placement + , _opPlacementID :: Int + } +data InPlacement = InPlacement + { _ipPlacement :: [Placement] -> Placement + , _ipPlacementID :: Int + } +data RoomPos = RoomPos + { _rpPos :: Point2 + , _rpDir :: Float + , _rpType :: S.Set RoomPosType + , _rpLinkStatus :: RPLinkStatus + , _rpPlacementUse :: Int + } + deriving (Eq,Ord,Show) + +data RoomPosType + = RoomPosOnPath + | RoomPosOffPath + | RoomPosExLink + | RoomPosLab Int + deriving (Eq,Ord,Show) + +data GenWorld = GenWorld + { _gWorld :: World + } + makeLenses ''CreatureState makeLenses ''Damage makeLenses ''DamageEffect @@ -1414,3 +1577,15 @@ makeLenses ''ActivateEquipment makeLenses ''EquipParams makeLenses ''TerminalCommand makeLenses ''GenParams +----- ROOM LENSES + +makeLenses ''Room +makeLenses ''RoomType +makeLenses ''PSType +makeLenses ''PlacementSpot +makeLenses ''Placement +makeLenses ''RoomLink +makeLenses ''RoomPos +makeLenses ''RoomPosType +makeLenses ''RPLinkStatus +makeLenses ''GenWorld diff --git a/src/Dodge/Debug/LinkDecoration.hs b/src/Dodge/Debug/LinkDecoration.hs index 6d5a08637..2877b4853 100644 --- a/src/Dodge/Debug/LinkDecoration.hs +++ b/src/Dodge/Debug/LinkDecoration.hs @@ -5,7 +5,7 @@ module Dodge.Debug.LinkDecoration import Dodge.Data import Dodge.RoomLink --import Dodge.Base -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data import Picture import qualified IntMapHelp as IM import Geometry.Data diff --git a/src/Dodge/Default/Room.hs b/src/Dodge/Default/Room.hs index eb3286ee0..7178e4235 100644 --- a/src/Dodge/Default/Room.hs +++ b/src/Dodge/Default/Room.hs @@ -1,7 +1,8 @@ module Dodge.Default.Room where import Data.Tile import Geometry.Data -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import qualified Data.IntMap.Strict as IM import qualified Data.Set as S diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index c415e372f..0dc07376e 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -99,6 +99,8 @@ defaultWorld = World , _doubleMouseHammer = HammerUp , _backspaceTimer = 0 , _genParams = GenParams M.empty + , _genPlacements = IM.empty + , _genRooms = IM.empty } youLight :: TempLightSource youLight = TLS diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index e7f123786..e6a11c63d 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -18,6 +18,7 @@ import Dodge.Annotation import Dodge.Creature import Dodge.Room.Warning --import Dodge.LevelGen.Data +import Dodge.Data --import Dodge.LevelGen.Switch --import Dodge.Item.Weapon.Launcher --import Dodge.PlacementSpot diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index b0d4226ad..27601dbb0 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -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 diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 61cacb02f..95ebbf922 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -7,7 +7,7 @@ import Dodge.Save import Dodge.Layout import Dodge.Initialisation --import Dodge.RandomHelp -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data import Dodge.Tree import Geometry.ConvexPoly --import Dodge.LevelGen.LevelStructure diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 1203f180f..a7adaedbd 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -2,191 +2,22 @@ {-# LANGUAGE StrictData #-} module Dodge.LevelGen.Data where import Dodge.Data -import Picture +--import Picture import Geometry --import Color -import Shape.Data -import Data.Tile +--import Shape.Data +--import Data.Tile -import qualified Data.Set as S +--import qualified Data.Set as S --import qualified Data.Map.Strict as M import Control.Lens -import Control.Monad.State -import System.Random +--import Control.Monad.State +--import System.Random import Data.Maybe -import qualified Data.IntMap.Strict as IM +--import qualified Data.IntMap.Strict as IM --import Data.Bifunctor -data PSType = PutCrit {_unPutCrit :: Creature} - | PutMachine { _putMachineColor :: Color, _putMachinePoly :: [Point2], _unPutMachine :: Machine } - | PutLS LightSource - | PutButton {_putButton :: Button} - | PutProp Prop - | PutFlIt Item - | PutPPlate PressPlate - | PutBlock BlockMaterial Int [Int] Wall [Point2] - | PutCoord Point2 - | PutMod Modification - | PutTrigger (World -> Bool) - | PutLineBlock {_putWall :: Wall, _putBlockMaterial :: BlockMaterial - , _putWidth :: Float, _putDepth :: Float, _putStartPoint :: Point2, _putEndPoint :: Point2} - | PutWall { _pwPoly :: [Point2] , _pwWall :: Wall } - | PutSlideDr Bool Color (World -> Bool) Float Point2 Point2 Float - | PutDoor Color (World -> Bool) [(Point2,Point2)] - | RandPS (State StdGen PSType) - | PutShape Shape - | PutWorldUpdate (PlacementSpot -> World -> World) - | PutNothing - | PutUsingGenParams (GenWorld -> (GenWorld,PSType)) - | PutID { _putID :: Int} --- maybe there is a monadic implementation of this? --- add room effect for any placement spot? -data PlacementSpot - = PS { _psPos :: Point2 , _psRot :: Float } - | PSNoShiftCont { _psPos :: Point2 , _psRot :: Float } - | PSPos - { _psSelect :: RoomPos -> Room -> Maybe (PlacementSpot, RoomPos) - , _psRoomEff :: RoomPos -> Room -> Room - , _psFallback :: Maybe Placement - } - | PSRoomRand - { _psRoomRandPointNum :: Int - , _psRandShift :: (Point2,Float) -> PlacementSpot - } --- TODO attempt to unify/simplify this union type -data Placement - = Placement - { _plSpot :: PlacementSpot - , _plType :: PSType - , _plMID :: Maybe Int - , _plGenUpdate :: Maybe (GenParams -> Placement -> (GenParams, Placement) ) - , _plIDCont :: Placement -> Maybe Placement - } - | PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position - | RandomPlacement {_unRandomPlacement :: State StdGen Placement} - | PickOnePlacement Int Placement -{- The '_rmPolys' lists which polygons should be cut out to form the indestructible walls of the room. -Link pairs contain a position and rotation to attach to another room; -0 is for links going to another room to the north, pi/2 for links going to a room to the west, etc. -TODO : Explain path, does it need both directions? -Placement spots allow things to be put in the room during level generation. -Room bounds between a new room and previously placed rooms are checked during level generation, -assigning no bounds will allow rooms to overlap. -} -data Room = Room - { _rmPolys :: [ [Point2] ] - , _rmLinks :: [RoomLink] - --, _rmOutLinks :: [RoomLink] - --, _rmInLinks :: [RoomLink] - -- update the room when assigning the next link to an adjacent room with the head of of this list, return the tail - , _rmLinkEff :: [(Point2,Float) -> Room -> Room] - , _rmPos :: [RoomPos] - , _rmPath :: [(Point2, Point2)] - , _rmPmnts :: [Placement] - , _rmInPmnt :: [InPlacement] - , _rmOutPmnt :: [OutPlacement] - , _rmBound :: [ [Point2] ] - , _rmFloor :: Floor - , _rmName :: String - , _rmShift :: (Point2, Float) - , _rmViewpoints :: [Point2] - , _rmRandPSs :: [State StdGen (Point2,Float)] - , _rmStartWires :: IM.IntMap RoomWire - , _rmEndWires :: IM.IntMap RoomWire - , _rmConnectsTo :: S.Set RoomLinkType -> Bool - , _rmMID :: Maybe Int - , _rmMParent :: Maybe Int - , _rmChildren :: [Int] - , _rmType :: RoomType - } -data RoomLink = RoomLink - { _rlType :: S.Set RoomLinkType - , _rlPos :: Point2 - , _rlDir :: Float - } deriving (Eq,Ord) -data RoomType = DefaultRoomType - | RectRoomType - { _numLinkEW :: Int - , _numLinkNS :: Int - , _linkGapEW :: Float - , _linkGapNS :: Float - , _rmWidth :: Float - , _rmHeight :: Float - } - deriving (Eq,Ord) -data RoomLinkType - = OutLink - | InLink - | LabLink Int - | OnEdge CardinalPoint - | FromSouth Int - | FromNorth Int - | FromWest Int - | FromEast Int - deriving (Eq,Ord,Show) -data CardinalPoint - = North - | East - | South - | West - deriving (Eq,Ord,Show) -data RoomWire - = --RoomWire Point2 Float - WallWire Point2 Float Float - -data RPLinkStatus - = UsedOutLink - { _rplsType :: S.Set RoomLinkType - , _rplsChildNum :: Int - , _rplsOutRoomID :: Int - } - | UsedInLink - { _rplsType :: S.Set RoomLinkType - , _rplsInRoomID :: Int - } - | UnusedLink { _rplsType :: S.Set RoomLinkType } - | NotLink - deriving (Eq,Ord,Show) -data OutPlacement = OutPlacement - { _opPlacement :: Placement - , _opPlacementID :: Int - } -data InPlacement = InPlacement - { _ipPlacement :: [Placement] -> Placement - , _ipPlacementID :: Int - } -data RoomPos = RoomPos - { _rpPos :: Point2 - , _rpDir :: Float - , _rpType :: S.Set RoomPosType - , _rpLinkStatus :: RPLinkStatus - , _rpPlacementUse :: Int - } - deriving (Eq,Ord,Show) - -data RoomPosType - = RoomPosOnPath - | RoomPosOffPath - | RoomPosExLink - | RoomPosLab Int - deriving (Eq,Ord,Show) - -data GenWorld = GenWorld - { _gWorld :: World - , _gPlacements :: IM.IntMap [(Placement,Int)] - , _gRooms :: IM.IntMap Room - } - -makeLenses ''Room -makeLenses ''RoomType -makeLenses ''PSType -makeLenses ''PlacementSpot -makeLenses ''Placement -makeLenses ''RoomLink -makeLenses ''RoomPos -makeLenses ''RoomPosType -makeLenses ''RPLinkStatus -makeLenses ''GenWorld spNoID :: PlacementSpot -> PSType -> Placement spNoID ps pst = Placement ps pst Nothing Nothing (const Nothing) diff --git a/src/Dodge/LevelGen/LevelStructure.hs b/src/Dodge/LevelGen/LevelStructure.hs index 896d8c6c9..831d8909c 100644 --- a/src/Dodge/LevelGen/LevelStructure.hs +++ b/src/Dodge/LevelGen/LevelStructure.hs @@ -21,8 +21,9 @@ import System.Random worldToGenWorld :: IM.IntMap Room -> World -> GenWorld worldToGenWorld rms w = GenWorld { _gWorld = w & genParams .~ gparams - , _gPlacements = IM.empty - , _gRooms = rms + & genRooms .~ rms +-- , _gPlacements = IM.empty +-- , _gRooms = rms } where gparams = evalState generateGenParams (_randGen w) diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index 6f9574423..65c34101d 100644 --- a/src/Dodge/LockAndKey.hs +++ b/src/Dodge/LockAndKey.hs @@ -2,7 +2,7 @@ module Dodge.LockAndKey where import Dodge.Data import Dodge.Tree -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data import Dodge.Room import Dodge.RandomHelp import Dodge.Creature diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index 20b5f34eb..2cf8352d7 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -3,7 +3,7 @@ module Dodge.Placement.Instance.Analyser , testYouHave , testYourHealth ) where -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data --import Dodge.PlacementSpot import Dodge.Data import Dodge.Base.You diff --git a/src/Dodge/Placement/Instance/Creature.hs b/src/Dodge/Placement/Instance/Creature.hs index b4f7cbcdd..ef9b773f1 100644 --- a/src/Dodge/Placement/Instance/Creature.hs +++ b/src/Dodge/Placement/Instance/Creature.hs @@ -1,5 +1,6 @@ module Dodge.Placement.Instance.Creature where -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import Dodge.RandomHelp import Dodge.Creature.ArmourChase import Dodge.Creature.ChaseCrit diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index 10e7ba138..a6bb88b05 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/src/Dodge/Placement/PlaceSpot.hs @@ -5,7 +5,7 @@ module Dodge.Placement.PlaceSpot ( placeSpot ) where -import Dodge.LevelGen.LevelStructure +--import Dodge.LevelGen.LevelStructure import Dodge.Placement.Shift import Dodge.Data import Dodge.Path @@ -45,7 +45,7 @@ placeSpot (w,rm) plmnt = case plmnt of shift = _rmShift rm placePickOne :: Int -> Placement -> Room -> GenWorld -> GenWorld -placePickOne i pl rm w = w & gPlacements %~ IM.insertWith (++) i [(pl, fromJust (_rmMID rm))] +placePickOne i pl rm w = w & gWorld . genPlacements %~ IM.insertWith (++) i [(pl, fromJust (_rmMID rm))] placeRandomPlacement :: State StdGen Placement -> GenWorld -> Room -> ((GenWorld,Room),[Placement]) placeRandomPlacement rplmnt w rm = placeSpot (w & gWorld . randGen .~ g,rm) plmnt' diff --git a/src/Dodge/Placement/PlaceSpot/Block.hs b/src/Dodge/Placement/PlaceSpot/Block.hs index 348160177..ef8ce5621 100644 --- a/src/Dodge/Placement/PlaceSpot/Block.hs +++ b/src/Dodge/Placement/PlaceSpot/Block.hs @@ -6,7 +6,7 @@ module Dodge.Placement.PlaceSpot.Block where import Dodge.Data import Dodge.Path -import Dodge.LevelGen.LevelStructure +--import Dodge.LevelGen.LevelStructure import Dodge.Base import Dodge.Zone import Geometry diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs index 7c9ad2377..f788496c1 100644 --- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs +++ b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs @@ -11,7 +11,7 @@ import Picture import Geometry import qualified IntMapHelp as IM import Dodge.SoundLogic -import Dodge.LevelGen.LevelStructure +--import Dodge.LevelGen.LevelStructure import Data.List import Control.Lens diff --git a/src/Dodge/Placement/Shift.hs b/src/Dodge/Placement/Shift.hs index 17bc9f629..084870bbd 100644 --- a/src/Dodge/Placement/Shift.hs +++ b/src/Dodge/Placement/Shift.hs @@ -3,7 +3,8 @@ module Dodge.Placement.Shift , shiftPSBy , shiftRelativeToPS ) where -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import Dodge.ShiftPoint import LensHelp diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs index 15d2c3e18..2b5ef484c 100644 --- a/src/Dodge/PlacementSpot.hs +++ b/src/Dodge/PlacementSpot.hs @@ -30,7 +30,8 @@ module Dodge.PlacementSpot , usedRoomLinkPoss , usedRoomInLinkPoss ) where -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import Geometry import Control.Lens diff --git a/src/Dodge/Randify.hs b/src/Dodge/Randify.hs index a0496a525..544109f83 100644 --- a/src/Dodge/Randify.hs +++ b/src/Dodge/Randify.hs @@ -1,6 +1,6 @@ module Dodge.Randify where import Dodge.Data -import Dodge.LevelGen.LevelStructure +--import Dodge.LevelGen.LevelStructure import System.Random import Control.Monad.State diff --git a/src/Dodge/Room/Branch.hs b/src/Dodge/Room/Branch.hs index a5ac30528..bf14c9cf6 100644 --- a/src/Dodge/Room/Branch.hs +++ b/src/Dodge/Room/Branch.hs @@ -4,7 +4,8 @@ Collections of rooms that branch into multiple paths. module Dodge.Room.Branch where --import Geometry -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import Dodge.Room.Door import Dodge.Room.Link import Dodge.Room.Procedural diff --git a/src/Dodge/Room/CheckConsistency.hs b/src/Dodge/Room/CheckConsistency.hs index aa4b4bcd4..6cd75b62e 100644 --- a/src/Dodge/Room/CheckConsistency.hs +++ b/src/Dodge/Room/CheckConsistency.hs @@ -1,6 +1,7 @@ module Dodge.Room.CheckConsistency where -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import Dodge.Graph import Dodge.RoomLink diff --git a/src/Dodge/Room/Corridor.hs b/src/Dodge/Room/Corridor.hs index 9cc78e33a..89db1c4cb 100644 --- a/src/Dodge/Room/Corridor.hs +++ b/src/Dodge/Room/Corridor.hs @@ -1,7 +1,8 @@ {-# LANGUAGE TupleSections #-} module Dodge.Room.Corridor where import Data.Tile -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import Dodge.RoomLink --import Dodge.Room.Foreground import Dodge.Default.Room diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index 451f71539..969ce27b7 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -10,7 +10,7 @@ import Color import Data.Maybe import qualified Data.IntMap.Strict as IM -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data import Control.Lens door :: Room diff --git a/src/Dodge/Room/GlassLesson.hs b/src/Dodge/Room/GlassLesson.hs index e0eec964b..61a3724f4 100644 --- a/src/Dodge/Room/GlassLesson.hs +++ b/src/Dodge/Room/GlassLesson.hs @@ -3,6 +3,7 @@ module Dodge.Room.GlassLesson where import Dodge.RoomLink import Dodge.Creature import Dodge.LevelGen.Data +import Dodge.Data import Dodge.RandomHelp import Dodge.Default.Wall import Dodge.Tree diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index f22bf0f6b..ea42fe0b6 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -19,7 +19,8 @@ module Dodge.Room.Link import Dodge.ShiftPoint --import Dodge.Placement.PlaceSpot import Dodge.Placement.Shift -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import Dodge.RandomHelp import Geometry import Data.Tile diff --git a/src/Dodge/Room/LongRoom.hs b/src/Dodge/Room/LongRoom.hs index cb4aa50f9..72a92c7a4 100644 --- a/src/Dodge/Room/LongRoom.hs +++ b/src/Dodge/Room/LongRoom.hs @@ -5,6 +5,7 @@ import Dodge.Tree --import Dodge.Default.Room import Dodge.Default.Wall import Dodge.LevelGen.Data +import Dodge.Data import Dodge.Placement.Instance import Dodge.Room.Link import Dodge.Room.Door diff --git a/src/Dodge/Room/Modify/Girder.hs b/src/Dodge/Room/Modify/Girder.hs index d611df854..8b191674b 100644 --- a/src/Dodge/Room/Modify/Girder.hs +++ b/src/Dodge/Room/Modify/Girder.hs @@ -6,6 +6,7 @@ module Dodge.Room.Modify.Girder ) where --import Dodge.Data import Dodge.LevelGen.Data +import Dodge.Data import Dodge.RandomHelp --import Dodge.Room.Procedural import Dodge.Room.Foreground diff --git a/src/Dodge/Room/Ngon.hs b/src/Dodge/Room/Ngon.hs index 384df7473..db74da4e0 100644 --- a/src/Dodge/Room/Ngon.hs +++ b/src/Dodge/Room/Ngon.hs @@ -3,7 +3,8 @@ import Data.Tile import Dodge.PlacementSpot import Dodge.RoomLink import Dodge.Default.Room -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import Dodge.Placement.Instance --import Dodge.LevelGen.Data import Geometry diff --git a/src/Dodge/Room/Path.hs b/src/Dodge/Room/Path.hs index ef36a163d..baa81d736 100644 --- a/src/Dodge/Room/Path.hs +++ b/src/Dodge/Room/Path.hs @@ -6,7 +6,8 @@ module Dodge.Room.Path , createPathGrid ) where -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import Dodge.LevelGen.StaticWalls import Dodge.RoomLink import Geometry diff --git a/src/Dodge/Room/Warning.hs b/src/Dodge/Room/Warning.hs index 858d822d3..bf28709fb 100644 --- a/src/Dodge/Room/Warning.hs +++ b/src/Dodge/Room/Warning.hs @@ -1,7 +1,7 @@ --{-# LANGUAGE TupleSections #-} module Dodge.Room.Warning where import Dodge.Terminal -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data import Dodge.PlacementSpot import Dodge.Placement.Instance.Terminal import Dodge.Data diff --git a/src/Dodge/RoomLink.hs b/src/Dodge/RoomLink.hs index c17714d87..0461119a5 100644 --- a/src/Dodge/RoomLink.hs +++ b/src/Dodge/RoomLink.hs @@ -21,7 +21,8 @@ module Dodge.RoomLink , getLinksOfType , swapInOutLinks ) where -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import Geometry import Data.List (partition) diff --git a/src/Dodge/RoomPos.hs b/src/Dodge/RoomPos.hs index d122ddfc7..33eb543ff 100644 --- a/src/Dodge/RoomPos.hs +++ b/src/Dodge/RoomPos.hs @@ -1,5 +1,6 @@ module Dodge.RoomPos where -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import Geometry extractRoomPos :: RoomPos -> (Point2,Float) diff --git a/src/Dodge/Tree/Shift.hs b/src/Dodge/Tree/Shift.hs index cabc611d6..63bde73cb 100644 --- a/src/Dodge/Tree/Shift.hs +++ b/src/Dodge/Tree/Shift.hs @@ -7,7 +7,8 @@ module Dodge.Tree.Shift ( positionRoomsFromTree , PosRooms (..) ) where -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import Dodge.Room.Link import Dodge.Tree.Polymorphic import Dodge.RoomLink diff --git a/src/Dodge/Wire.hs b/src/Dodge/Wire.hs index 9ad8b2a89..3452e67d6 100644 --- a/src/Dodge/Wire.hs +++ b/src/Dodge/Wire.hs @@ -1,5 +1,6 @@ module Dodge.Wire where -import Dodge.LevelGen.Data +--import Dodge.LevelGen.Data +import Dodge.Data import Geometry import qualified Data.IntMap.Strict as IM