justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Work toward adding wiring

Browse Source
This commit is contained in:
justin
2021-11-14 00:39:24 +00:00
parent 96c72ef578
commit 4a089ff0cc
34 changed files with 154 additions and 214 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Debug/LinkDecoration.hs
+1 -1
View File
@@ -4,7 +4,7 @@ module Dodge.Debug.LinkDecoration
) where
import Dodge.Data
--import Dodge.Base
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.Picture.Layer
import Picture
import qualified IntMapHelp as IM
src/Dodge/Default/Room.hs
+11 -10
View File
@@ -1,7 +1,7 @@
module Dodge.Default.Room
where
import Geometry.Data
import Dodge.Room.Data
import Dodge.LevelGen.Data
defaultRoom :: Room
defaultRoom = Room
@@ -10,14 +10,15 @@ defaultRoom = Room
, _rmPos = []
, _rmPath = []
, _rmPmnts = []
, _rmPartialPmnt = Nothing
, _rmExtendedPmnt = Nothing
, _rmBound = []
, _rmFloor = []
, _rmName = "defaultRoom"
, _rmShift = (V2 0 0 , 0)
, _rmPartPmnt = Nothing
, _rmExtPmnt = Nothing
, _rmBound = []
, _rmFloor = []
, _rmName = "defaultRoom"
, _rmShift = (V2 0 0 , 0)
, _rmViewpoints = []
, _rmRandPSs = []
, _rmLabel = Nothing
, _rmTakeFrom = Nothing
, _rmRandPSs = []
, _rmLabel = Nothing
, _rmTakeFrom = Nothing
, _rmWires = []
}
src/Dodge/Floor.hs
+4 -19
View File
@@ -6,16 +6,7 @@ module Dodge.Floor
import Geometry.Data
import Dodge.Data
import Dodge.Creature.State.Data
import Dodge.Room.Procedural
import Dodge.Room.RoadBlock
import Dodge.Room.Data
import Dodge.Room
import Dodge.Room.Door
import Dodge.Room.Branch
import Dodge.Room.Boss
import Dodge.Room.LongDoor
import Dodge.Room.NoNeedWeapon
import Dodge.Room.Link
import Dodge.Placements.Button
import Dodge.Layout.Tree.Polymorphic
import Dodge.Layout.Tree.Either
@@ -38,10 +29,11 @@ import Data.Maybe
initialAnoTree :: RandomGen g => Tree [Annotation g]
initialAnoTree = padSucWithCorridors $ treeFromTrunk
[[StartRoom]
,[SetLabel 0 $ return $ roomRectAutoLinks 100 100
& rmExtendedPmnt ?~ externalButton red (anyLnkInPS 5)
,[ChainAnos [[SetLabel 0 $ return $ roomRectAutoLinks 100 100
& rmExtPmnt ?~ externalButton red (anyLnkInPS 5) ]
,[UseLabel 0 $ return switchDoorRoom]
]
]
,[UseLabel 0 $ return switchDoorRoom]
,[SpecificRoom $ return $ connectRoom lasTunnel ]
,[SpecificRoom $ fmap connectRoom slowDoorRoom ]
,[Corridor]
@@ -113,12 +105,6 @@ layoutLevelFromSeed i seed = do
putStr $ "Level generation with seed " ++ show seed ++ " failed: "
let (seed',_) = random g
layoutLevelFromSeed i' seed'
-- where
-- setLastLinkToUsed rm = case _rmLinks rm of
-- (_:_) -> rm
-- & rmLinks %~ init
-- & rmUsedLinks %~ (last (_rmLinks rm) :)
-- _ -> rm
compactDrawTree :: Tree String -> String
compactDrawTree = unlines . compactDraw
@@ -132,5 +118,4 @@ compactDraw (Node x ts0) = lines x ++ drawSubTrees ts0
"|" : compactDraw t
drawSubTrees (t:ts) =
"|" : shift "+- " "| " (compactDraw t) ++ drawSubTrees ts
shift first other = zipWith (++) (first : repeat other)
src/Dodge/Layout.hs
+44 -30
View File
@@ -1,8 +1,6 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Layout
( generateLevelFromRoomList
-- , doPartialPlacements
-- , doExtendedPlacements
) where
import Dodge.Data
import Dodge.LevelGen
@@ -12,30 +10,30 @@ import Dodge.LevelGen.Pathing
import Dodge.Wall.Zone
import Dodge.GameRoom
import Dodge.Bounds
import Dodge.Room.Data
import Dodge.Room.AddTile
--import Dodge.LevelGen.Data
import Dodge.Room.Foreground
import Dodge.Default.Wall
import Geometry
--import Geometry.Data
import qualified IntMapHelp as IM
--import Dodge.Debug.LinkDecoration
import Tile
import Data.List (nubBy)
--import Control.Monad.State
import Data.Traversable
import Control.Lens
import System.Random
import Data.Foldable
import qualified Control.Foldl as L
import Data.Maybe
import Data.Function
generateLevelFromRoomList :: [Room] -> World -> World
generateLevelFromRoomList gr w
= initWallZoning
. setupWorldBounds
. doPartialPlacements rs
. doExtendedPlacements rs
. flip (foldl' doRoomPlacements) rs
. placeWires
. doPartialPlacements
. doExtendedPlacements
. flip (mapAccumR doRoomPlacements) rs
$ w { _walls = wallsFromRooms rs
, _floorTiles = floorsFromRooms rs
, _gameRooms = gameRoomsFromRooms rs
@@ -48,29 +46,40 @@ generateLevelFromRoomList gr w
rs = zipWith addTile zs gr
zs = map fromIntegral $ randomRs (0,63::Int) $ _randGen w
doPartialPlacements :: [Room] -> (IM.IntMap [Placement],World) -> World
doPartialPlacements rms (im,w) = foldr (doPartialPlacement im) w rms
placeWires :: (World,[Room])-> World
placeWires (w,rms) = foldr placeRoomWires w rms
doPartialPlacement :: IM.IntMap [Placement] -> Room -> World -> World
doPartialPlacement im rm w = case _rmPartialPmnt rm of
Nothing -> w
placeRoomWires :: Room -> World -> World
placeRoomWires rm w = foldr placeWire w (_rmWires rm)
placeWire :: RoomWire -> World -> World
placeWire rw w = case rw of
RoomWire (p,_) (q,_) -> w & foregroundShape %~ (thinHighBar 40 p q <>)
doPartialPlacements :: ( (IM.IntMap [Placement],World) , [Room] ) -> (World,[Room])
doPartialPlacements ((im,w),rms) = mapAccumR (doPartialPlacement im) w rms
doPartialPlacement :: IM.IntMap [Placement] -> World -> Room -> (World, Room)
doPartialPlacement im w rm = case _rmPartPmnt rm of
Nothing -> (w, rm)
Just fi -> case _rmTakeFrom rm of
Nothing -> w
Just i -> fst $ fst $ placeSpot (w,rm) (fi (im IM.! i))
Nothing -> (w, rm)
Just i -> fst $ placeSpot (w,rm) (fi (im IM.! i))
doExtendedPlacements :: [Room] -> World -> (IM.IntMap [Placement], World)
doExtendedPlacements rms w = foldr doExtendedPlacement (IM.empty,w) rms
doExtendedPlacements :: (World,[Room]) -> ( (IM.IntMap [Placement], World) , [Room] )
doExtendedPlacements (w,rms) = mapAccumR doExtendedPlacement (IM.empty,w) rms
doExtendedPlacement :: Room -> (IM.IntMap [Placement], World) -> (IM.IntMap [Placement], World)
doExtendedPlacement rm (im,w) = case _rmExtendedPmnt rm of
Nothing -> (im,w)
doExtendedPlacement :: (IM.IntMap [Placement], World) -> Room
-> ( (IM.IntMap [Placement], World) , Room )
doExtendedPlacement (im,w) rm = case _rmExtPmnt rm of
Nothing -> ( (im,w) , rm )
Just plmnt -> case _rmLabel rm of
Nothing -> (im,w)
Just i -> let ((neww,_),plmnts) = placeSpot (w,rm) plmnt
in (IM.insert i plmnts im, neww)
Nothing -> ( (im,w) , rm )
Just i -> let ((neww,newrm),plmnts) = placeSpot (w,rm) plmnt
in ( (IM.insert i plmnts im, neww) , newrm )
doRoomPlacements :: World -> Room -> World
doRoomPlacements w rm = fst $ foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm
doRoomPlacements :: World -> Room -> (World, Room)
doRoomPlacements w rm = foldl' (\wr -> fst . placeSpot wr) (w,rm) $ _rmPmnts rm
setupWorldBounds :: World -> World
setupWorldBounds w = w
@@ -93,9 +102,6 @@ setupWorldBounds w = w
initWallZoning :: World -> World
initWallZoning w = foldl' (flip insertWallInZones) (w & wallsZone . znObjects .~ IM.empty) (_walls w)
--initWallZoning w = set (wallsZone . znObjects) (foldl' (flip wallInZone) IM.empty (_walls w)) w
-- where
-- wallInZone wl = flip (foldl' (flip $ \(a,b) -> insertIMInZone a b (_wlID wl) wl)) (zoneOfWall wl)
--makePath :: Tree Room -> [(Point2,Point2)]
--makePath = concatMap _rmPath . flatten
@@ -168,3 +174,11 @@ floorsFromRooms = concatMap (concatMap tToRender . _rmFloor)
-- f r = shiftRoomBy ( V2 0 0 -.- rotateV (pi-a) p , 0) $ shiftRoomBy (V2 0 0,pi-a) r
-- where
-- (p,a) = last $ _rmLinks r
addTile :: Float -> Room -> Room
addTile z r
| not (null (_rmFloor r)) || null rp = r
| otherwise = r & rmFloor .~ [makeTileFromPoly poly z]
where
rp = _rmPolys r
poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat rp
src/Dodge/Layout/Tree/Annotate.hs
+4 -5
View File
@@ -15,9 +15,6 @@ data Annotation g
= Lock Int
| Key Int
| Corridor
| CorridorDebug
| SwitchDoorAno
| DoorNumAno Int
| AirlockAno
| FirstWeapon
| StartRoom
@@ -28,6 +25,7 @@ data Annotation g
| TreasureAno [Creature] [Item]
| SetLabel Int (State g Room)
| UseLabel Int (State g Room)
| ChainAnos [[Annotation g]]
addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g])
addLock i t = do
@@ -59,12 +57,13 @@ anoToRoomTree anos = case anos of
[UseLabel i randrm] -> do
rm <- randrm
return $ connectRoom $ rm & rmTakeFrom ?~ i
[ChainAnos ass] -> do
rms <- mapM anoToRoomTree ass
return $ linkEitherTrees rms
[OrAno as] -> do
a <- takeOne as
anoToRoomTree a
[Corridor] -> pure . Right <$> randomiseOutLinks corridor
[CorridorDebug] -> pure . Right <$> randomiseOutLinks corridorDebug
-- [DoorAno] -> roomThenCorridor door
[AirlockAno] -> airlock >>= roomThenCorridor
[FirstWeapon] -> do
branchWP <- branchRectWith weaponRoom
src/Dodge/Layout/Tree/Either.hs
+6
View File
@@ -7,6 +7,7 @@ module Dodge.Layout.Tree.Either
, connectRoom
, connectTrunk
, deadRoom
, linkEitherTrees
) where
import Data.Tree
@@ -32,6 +33,11 @@ appendEitherTree
appendEitherTree (Node (Left x) ts) ts' = Node (Left x) $ map (`appendEitherTree` ts') ts
appendEitherTree (Node (Right x) _) ts' = Node (Left x) ts'
linkEitherTrees :: [Tree (Either a a)] -> Tree (Either a a)
linkEitherTrees (t:s:ts) = linkEitherTrees (appendEitherTree t [s]:ts)
linkEitherTrees [t] = t
linkEitherTrees [] = error "tried to concatenate an empty list of either trees"
removeEither :: Either p p -> p
removeEither (Left y) = y
removeEither (Right y) = y
src/Dodge/Layout/Tree/Shift.hs
+1 -1
View File
@@ -4,7 +4,7 @@ Creates a list of rooms; after this step the structure is determined by the actu
module Dodge.Layout.Tree.Shift
( positionRooms
) where
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.Room.Link
import Dodge.Layout.Tree.Polymorphic
import Geometry.ConvexPoly
src/Dodge/LevelGen.hs
+4 -5
View File
@@ -15,7 +15,6 @@ import Dodge.LevelGen.TriggerDoor
import Dodge.LevelGen.Data
import Dodge.Default.Wall
import Dodge.RandomHelp
import Dodge.Room.Data
import Dodge.Placements.Spot
import Geometry
import Geometry.Vector3D
@@ -30,7 +29,7 @@ import qualified Data.IntSet as IS
-- when placing a placement, we update the world and the room and assign an id
-- to the placement
placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement])
placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement] )
placeSpot (w,rm) plmnt = case plmnt of
Placement{_plSpot = PSRoomRand i} -> placeSpotRoomRand rm i plmnt w
Placement{_plSpot = PSLnk{}} -> placeSpotUsingLink w rm plmnt
@@ -58,11 +57,11 @@ placeSpotUsingLink w rm plmnt = case lnks of
where
uselnk lnki = rm & rmLinks %~ deletei lnki
rps = _plSpot plmnt
fallback = _psFallback rps
test = _psLinkTest rps
fallback = _psLnkFallback rps
test = _psLnkTest rps
(lnks,g) = runState (shuffle $ filter (test . snd) $ zip [0..]
$ map (invShiftLinkBy $ _rmShift rm) $ _rmLinks rm) $ _randGen w
f x (PSLnk t s _)
f x (PSLnk t s _ _)
| t x = uncurry PS $ s x
f _ ps = ps
invShiftLinkBy :: (Point2,Float) -> (Point2,Float) -> (Point2,Float)
src/Dodge/LevelGen/Data.hs
+45 -6
View File
@@ -5,6 +5,7 @@ import Dodge.Data
import Picture
import Geometry
import Shape.Data
import Data.Tile
import Control.Lens
import Control.Monad.State
@@ -33,10 +34,12 @@ data PSType = PutCrit {_unPutCrit :: Creature}
-- maybe there is a monadic implementation of this?
data PlacementSpot
= PS { _psPos :: Point2 , _psRot :: Float }
| PSLnk { _psLinkTest :: (Point2,Float) -> Bool
, _psLinkShift :: (Point2,Float) -> (Point2,Float)
, _psFallback :: Maybe Placement
}
| PSLnk
{ _psLnkTest :: (Point2,Float) -> Bool
, _psLnkShift :: (Point2,Float) -> (Point2,Float)
, _psLnkRoomEff :: (Point2,Float) -> Room -> Room
, _psLnkFallback :: Maybe Placement
}
| PSRoomRand { _psRoomRandPointNum :: Int }
data Placement = Placement
{ _plSpot :: PlacementSpot
@@ -48,11 +51,11 @@ data Placement = Placement
| RandomPlacement {_unRandomPlacement :: State StdGen Placement}
anyLnkOutPS :: PlacementSpot
anyLnkOutPS = PSLnk (const True) id Nothing
anyLnkOutPS = PSLnk (const True) id (const id) Nothing
anyLnkInPS :: Float -- ^ amount to shift inward
-> PlacementSpot
anyLnkInPS x = PSLnk (const True) f Nothing
anyLnkInPS x = PSLnk (const True) f (const id) Nothing
where
f (v,a) = (v -.- x *.* unitVectorAtAngle (a + 0.5 * pi), a+ pi)
@@ -104,6 +107,42 @@ addPlmnt pl pl2 = case pl2 of
g Nothing = Just pl
g (Just pl') = Just $ addPlmnt pl pl'
{-
The '_rmPolys' list states 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 :: [(Point2,Float)]
, _rmPos :: [RoomPos]
, _rmPath :: [(Point2, Point2)]
, _rmPmnts :: [Placement]
, _rmPartPmnt :: Maybe ([Placement] -> Placement)
, _rmExtPmnt :: Maybe Placement
, _rmBound :: [ [Point2] ]
, _rmFloor :: [Tile]
, _rmName :: String
, _rmShift :: (Point2, Float)
, _rmViewpoints :: [Point2]
, _rmRandPSs :: [State StdGen (Point2,Float)]
, _rmLabel :: Maybe Int
, _rmTakeFrom :: Maybe Int
, _rmWires :: [RoomWire]
}
data RoomWire
= RoomWire (Point2,Float) (Point2,Float)
data RoomPos
= OutLink Int Point2 Float
| InLink Point2 Float
| PosPl Point2 Float
| LabPos Int RoomPos
deriving (Eq,Ord,Show)
makeLenses ''Room
makeLenses ''PSType
makeLenses ''PlacementSpot
makeLenses ''Placement
src/Dodge/Placements/Button.hs
+1 -1
View File
@@ -38,5 +38,5 @@ putLitButtonID' col f subpl
where
changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
thePS = PSLnk f id Nothing
thePS = PSLnk f id (const id) Nothing
src/Dodge/Placements/LightSource.hs
+4 -7
View File
@@ -27,9 +27,6 @@ mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _)
V2 x y = rotateV 1 . (0.1 *.*) . normalizeV $ wallp -.- V2 lx ly
setCol = maybe id colorSH mcol
redMID :: (Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement)
-> Point2 -> Point3 -> Placement
redMID f wallp lampp = f Nothing defaultLS wallp lampp (const Nothing)
iShape :: Point2 -> Point3 -> Shape
iShape wp (V3 x y z) = thinHighBar z wp (V2 x y)
@@ -80,17 +77,17 @@ vShape wallpos (V3 x y z) =
wallposDown = wallpos -.- n
mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement
mntLS shp = redMID $ mntLSOn shp
mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing)
mntLSCond :: (Point2 -> Point3 -> Shape) -> ((Point2,Float) -> Bool) -> Placement
mntLSCond shp cond = updatePSToLevel 2 (const $ PSLnk cond id Nothing)
$ redMID (mntLSOn shp) 0 (V3 0 (-40) 40)
mntLSCond shp cond = updatePSToLevel 2 (const $ PSLnk cond id (const id) Nothing)
$ mntLS shp 0 (V3 0 (-40) 40)
-- note that this perhaps pushes the vshape light out too far
mntLight :: Point2 -> Point2 -> Placement
mntLight a b = RandomPlacement $ do
shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
return $ redMID (mntLSOn shp) a (addZ 50 b)
return $ mntLS shp a (addZ 50 b)
mntLightLnkCond :: ((Point2,Float) -> Bool) -> Placement
mntLightLnkCond f = RandomPlacement $ do
src/Dodge/Placements/Wall.hs
-1
View File
@@ -5,7 +5,6 @@ import Color
import Geometry
import Dodge.LevelGen.Data
import Dodge.Default.Wall
import Dodge.Room.Data
import Data.List
import Control.Lens
src/Dodge/Room.hs
+2 -2
View File
@@ -4,7 +4,7 @@ Specification of individual rooms.
module Dodge.Room
( module Dodge.Room.Room
, module Dodge.Room.Foreground
, module Dodge.Room.Data
, module Dodge.LevelGen.Data
, module Dodge.Room.Procedural
, module Dodge.Room.Corridor
, module Dodge.Room.Link
@@ -26,7 +26,7 @@ import Dodge.Room.RoadBlock
import Dodge.Room.Teleport
import Dodge.Room.Branch
import Dodge.Room.Foreground
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.Room.Procedural
import Dodge.Room.Corridor
import Dodge.Room.Link
src/Dodge/Room/AddTile.hs
-17
View File
@@ -1,17 +0,0 @@
module Dodge.Room.AddTile
where
import Dodge.Room.Data
import Tile
import Geometry
import Control.Lens
import Data.List
import Data.Function
addTile :: Float -> Room -> Room
addTile z r
| not (null (_rmFloor r)) || null rp = r
| otherwise = r & rmFloor .~ [makeTileFromPoly poly z]
where
rp = _rmPolys r
poly = orderPolygon . convexHullSafe . nubBy ((==) `on` roundPoint2) $ concat rp
src/Dodge/Room/Airlock.hs
-1
View File
@@ -1,7 +1,6 @@
{-# LANGUAGE TupleSections #-}
{- Rooms that contain two doors and a switch alternating both. -}
module Dodge.Room.Airlock where
import Dodge.Room.Data
import Dodge.Placements
import Dodge.Room.Foreground
import Dodge.Default.Room
src/Dodge/Room/Boss.hs
+2 -2
View File
@@ -4,12 +4,12 @@ module Dodge.Room.Boss
import Dodge.Data
import Dodge.Default.Room
import Dodge.Placements
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.Room.Procedural
import Dodge.Room.Link
import Dodge.Room.Corridor
import Dodge.Room.Path
import Dodge.LevelGen.Data
--import Dodge.LevelGen.Data
import Dodge.Creature
import Dodge.Creature.State.Data
import Dodge.RandomHelp
src/Dodge/Room/Branch.hs
+1 -1
View File
@@ -4,7 +4,7 @@ Collections of rooms that branch into multiple paths.
module Dodge.Room.Branch
where
--import Geometry
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.Room.Door
import Dodge.Room.Link
import Dodge.Room.Procedural
src/Dodge/Room/CheckConsistency.hs
+1 -1
View File
@@ -1,6 +1,6 @@
module Dodge.Room.CheckConsistency
where
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.Graph
linksOnPath :: Room -> Bool
src/Dodge/Room/Corridor.hs
+1 -21
View File
@@ -1,6 +1,6 @@
module Dodge.Room.Corridor
where
import Dodge.Room.Data
import Dodge.LevelGen.Data
--import Dodge.Room.Foreground
import Dodge.Default.Room
--import Dodge.LevelGen.Data
@@ -29,26 +29,6 @@ corridor = defaultRoom
,((20,70), negate $ pi/6)
,((20,10) ,pi)
]
{- | Debug drop-in copy of corridor -}
corridorDebug :: Room
corridorDebug = defaultRoom
{ _rmPolys =
[ rectNSWE 80 0 0 40
--, [ (0,0), (0,200) , (200,100)]
--, [ (0,0), (0,20) , (20,10)]
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
, _rmPmnts = []
, _rmBound = [ rectNSWE 50 30 0 40 ]
}
where
lnks = map (first toV2)
[((20,70) ,0)
,((20,70), pi/6)
,((20,70), negate $ pi/6)
,((20,10) ,pi)
]
corridorN :: Room
corridorN = defaultRoom
{ _rmPolys = [rectNSWE 80 0 0 40
src/Dodge/Room/Data.hs
-45
View File
@@ -1,45 +0,0 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
module Dodge.Room.Data
where
import Dodge.LevelGen.Data
import Geometry.Data
import Data.Tile
import Control.Monad.State
import System.Random
import Control.Lens
--import qualified Data.IntMap.Strict as IM
{-
The '_rmPolys' list states 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 :: [(Point2,Float)]
, _rmPos :: [RoomPos]
, _rmPath :: [(Point2, Point2)]
, _rmPmnts :: [Placement]
, _rmPartialPmnt :: Maybe ([Placement] -> Placement)
, _rmExtendedPmnt :: Maybe Placement
, _rmBound :: [ [Point2] ]
, _rmFloor :: [Tile]
, _rmName :: String
, _rmShift :: (Point2, Float)
, _rmViewpoints :: [Point2]
, _rmRandPSs :: [State StdGen (Point2,Float)]
, _rmLabel :: Maybe Int
, _rmTakeFrom :: Maybe Int
}
data RoomPos
= OutLink Int Point2 Float
| InLink Point2 Float
| PosInt Int Point2 Float
| PosPl Point2 Float
deriving (Eq,Ord,Show)
makeLenses ''Room
src/Dodge/Room/Door.hs
+1 -2
View File
@@ -3,7 +3,6 @@ module Dodge.Room.Door
where
import Geometry
import Dodge.Data
import Dodge.Room.Data
import Dodge.Default.Room
import Dodge.Placements
import Color
@@ -32,7 +31,7 @@ switchDoorRoom = defaultRoom
{ _rmPolys = [rectNSWE 40 0 0 40]
, _rmLinks = lnks
, _rmPath = [(V2 20 35,V2 20 5)]
, _rmPartialPmnt = Just f
, _rmPartPmnt = Just f
-- door extends into side walls (for shadows as rendered 12/03)
-- note no bounds
}
src/Dodge/Room/Foreground.hs
-3
View File
@@ -1,11 +1,8 @@
--{-# LANGUAGE TupleSections #-}
module Dodge.Room.Foreground
where
--import Dodge.Picture
--import Dodge.Base
import Picture
import Geometry
--import Geometry.Data
import Geometry.Vector3D
import Shape
import Quaternion
src/Dodge/Room/Link.hs
+1 -1
View File
@@ -16,7 +16,7 @@ module Dodge.Room.Link
, setLastLinkToUsed
) where
import Dodge.LevelGen
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.RandomHelp
import Geometry
import Data.Tile
src/Dodge/Room/Listed.hs
-7
View File
@@ -1,7 +0,0 @@
module Dodge.Room.Listed
( roomList
) where
import Dodge.Room.Data
roomList :: [Room]
roomList = []
src/Dodge/Room/LockAndKeyList.hs
+1 -1
View File
@@ -1,6 +1,6 @@
module Dodge.Room.LockAndKeyList
where
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.Room.RoadBlock
import Dodge.Room.Boss
src/Dodge/Room/LongDoor.hs
+2 -2
View File
@@ -5,12 +5,12 @@ module Dodge.Room.LongDoor
where
import Dodge.Data
import Dodge.Default.Room
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.Placements
import Dodge.Room.Link
import Dodge.Room.Procedural
--import Dodge.Layout.Tree.Either
import Dodge.LevelGen.Data
--import Dodge.LevelGen.Data
import Dodge.LevelGen.Switch
import Dodge.RandomHelp
import Dodge.Creature.Inanimate
src/Dodge/Room/NoNeedWeapon.hs
+2 -2
View File
@@ -6,11 +6,11 @@ import Dodge.Data
import Dodge.Creature
import Dodge.Creature.State.Data
--import Dodge.Creature.Inanimate
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.Room.Procedural
import Dodge.Room.Link
import Dodge.RandomHelp
import Dodge.LevelGen.Data
--import Dodge.LevelGen.Data
import Geometry.Data
import Control.Lens
src/Dodge/Room/Path.hs
+1 -1
View File
@@ -5,7 +5,7 @@ module Dodge.Room.Path
, createPathGrid
)
where
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.LevelGen.StaticWalls
import Geometry
src/Dodge/Room/Procedural.hs
-1
View File
@@ -11,7 +11,6 @@ module Dodge.Room.Procedural
) where
import Dodge.Data
import Dodge.Default.Wall
import Dodge.Room.Data
import Dodge.Placements
import Dodge.Room.Link
import Dodge.Room.Path
src/Dodge/Room/RoadBlock.hs
+2 -3
View File
@@ -2,14 +2,13 @@
module Dodge.Room.RoadBlock
where
import Geometry
--import Dodge.Data
import Dodge.Default.Room
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.Room.Link
import Dodge.Placements
import Dodge.Room.Corridor
import Dodge.Room.Furniture
import Dodge.LevelGen.Data
--import Dodge.LevelGen.Data
--import Dodge.Default.Wall
--import Dodge.RandomHelp
import Dodge.Creature
src/Dodge/Room/Room.hs
+1 -1
View File
@@ -10,7 +10,7 @@ import Dodge.Default.Wall
import Dodge.Layout.Tree.Polymorphic
import Dodge.Layout.Tree.Either
import Dodge.Placements
import Dodge.Room.Data
--import Dodge.LevelGen.Data
import Dodge.Room.Procedural
import Dodge.Room.Corridor
import Dodge.Room.Link
src/Dodge/Room/Start.hs
+9 -11
View File
@@ -1,5 +1,5 @@
module Dodge.Room.Start where
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.Room.Door
import Dodge.Room.Link
import Dodge.Room.Procedural
@@ -7,7 +7,7 @@ import Dodge.Room.Foreground
import Dodge.Room.Furniture
import Dodge.Placements
import Dodge.Layout.Tree.Polymorphic
import Dodge.LevelGen.Data
--import Dodge.LevelGen.Data
import Geometry.Data
import Color
import Shape
@@ -25,13 +25,8 @@ startRoom :: RandomGen g => State g (Tree (Either Room Room))
startRoom = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
let fground = sPS (V2 0 0) 0 $ PutForeground $
girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2))
treeFromPost [Left rezBox, Left door] . Right
<$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0)
$ roomRectAutoLinks w h & rmPmnts %~
(
[ fground
let plmnts =
[ sPS (V2 0 0) 0 $ PutForeground $ girderV 40 20 10 (V2 0 (h/2)) (V2 w (h/2))
, mntLS jShape (V2 0 (h/3)) (V3 40 (h/3) 70)
, tankSquareEmboss4 (dim orange) 50 (h-60)
, tankSquare (dim orange) 50 50
@@ -39,6 +34,9 @@ startRoom = do
, lightSensor (V2 (0.8*w) (0.25*h)) 0
, putLasTurret & plSpot .~ PS (V2 (0.8*w) (0.8*h)) 0
, sps0 $ PutForeground $ colorSH orange $ pipePP 2 (V3 50 50 25) (V3 50 120 25)
] ++
)
]
treeFromPost [Left rezBox, Left door] . Right
<$> randomiseOutLinks
(shiftRoomBy (V2 (-20) (-20),0)
$ roomRectAutoLinks w h & rmPmnts %~ (plmnts ++)
)
src/Dodge/Room/Teleport.hs
+2 -2
View File
@@ -3,10 +3,10 @@ module Dodge.Room.Teleport
where
import Dodge.Data
import Dodge.Base
import Dodge.Room.Data
import Dodge.LevelGen.Data
import Dodge.Room.Procedural
import Dodge.Placements
import Dodge.LevelGen.Data
--import Dodge.LevelGen.Data
import Geometry
import Picture
import Dodge.WorldEvent.Explosion
src/Dodge/Room/Treasure.hs
-1
View File
@@ -5,7 +5,6 @@ Typically dead ends.
module Dodge.Room.Treasure
where
import Dodge.Data
import Dodge.Room.Data
import Dodge.Placements
import Dodge.Default.Room
import Dodge.LevelGen.Data