Move GenWorld fields into World
This commit is contained in:
+7
-176
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user