Move GenWorld fields into World

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