144 lines
4.5 KiB
Haskell
144 lines
4.5 KiB
Haskell
{-# LANGUAGE StrictData #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Dodge.Data.GenWorld (
|
|
module Dodge.Data.GenWorld,
|
|
module Dodge.Data.Room,
|
|
module Dodge.Data.RoomCluster,
|
|
module Dodge.Data.World,
|
|
) where
|
|
|
|
import Color
|
|
import Control.Lens
|
|
import Control.Monad.State
|
|
import qualified Data.Set as S
|
|
import Data.Tile
|
|
import Dodge.Data.Room
|
|
import Dodge.Data.RoomCluster
|
|
import Dodge.Data.World
|
|
import Geometry.Data
|
|
import qualified IntMapHelp as IM
|
|
import Picture.Data
|
|
import System.Random
|
|
|
|
data GenWorld = GenWorld
|
|
{ _gwWorld :: World
|
|
, _genPlacements :: IM.IntMap [(Placement, Int)]
|
|
, _genRooms :: IM.IntMap Room
|
|
}
|
|
|
|
---- ROOM DATATYPES
|
|
data PSType
|
|
= PutCrit {_unPutCrit :: Creature}
|
|
| PutMachine {_putMachinePoly :: [Point2], _putMachineMachine :: Machine, _putMachineWall :: Wall}
|
|
| PutLS LightSource
|
|
| PutButton {_putButton :: Button}
|
|
| PutProp Prop
|
|
| PutTerminal {_unputTerminal :: Terminal}
|
|
| PutFlIt {_putItem :: Item}
|
|
| PutPPlate PressPlate
|
|
| PutBlock {_putBlock :: Block, _putWall :: Wall, _putPoly :: [Point2]}
|
|
| PutCoord Point2
|
|
| PutMod Modification
|
|
| PutTrigger Bool
|
|
| PutLineBlock
|
|
{ _putWall :: Wall
|
|
, _putWidth :: Float
|
|
, _putStartPoint :: Point2
|
|
, _putEndPoint :: Point2
|
|
}
|
|
| PutWall {_pwPoly :: [Point2], _pwWall :: Wall}
|
|
| PutSlideDr Door Wall EdgeObstacle Float Point2 Point2
|
|
| PutDoor Color EdgeObstacle WdBl [(Point2, Point2)]
|
|
| RandPS (State StdGen PSType)
|
|
| PutForeground ForegroundShape
|
|
| PutDecoration Picture
|
|
| PutWorldUpdate (PlacementSpot -> World -> World)
|
|
| PutNothing
|
|
| PutUsingGenParams (World -> (World, 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
|
|
{ _plOrder :: Int
|
|
, _plSpot :: PlacementSpot
|
|
, _plType :: PSType
|
|
, _plMID :: Maybe Int
|
|
, _plIDCont :: World -> 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]
|
|
, -- the Int is the number of previous outlinks that have been assigned
|
|
_rmLinkEff ::
|
|
RoomLink -> -- child link
|
|
Room -> -- child room
|
|
Int -> -- child number
|
|
RoomLink -> -- parent link
|
|
Room -> -- parent room
|
|
Room
|
|
, _rmPos :: [RoomPos]
|
|
, _rmPath :: S.Set (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
|
|
, _rmClusterStatus :: ClusterStatus
|
|
}
|
|
|
|
data OutPlacement = OutPlacement
|
|
{ _opPlacement :: Placement
|
|
, _opPlacementID :: Int
|
|
}
|
|
|
|
data InPlacement = InPlacement
|
|
{ _ipPlacement :: [Placement] -> Placement
|
|
, _ipPlacementID :: Int
|
|
}
|
|
|
|
makeLenses ''GenWorld
|
|
makeLenses ''Room
|
|
makeLenses ''RoomType
|
|
makeLenses ''PSType
|
|
makeLenses ''PlacementSpot
|
|
makeLenses ''Placement
|