140 lines
3.4 KiB
Haskell
140 lines
3.4 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
|
|
module Dodge.Room.Corridor where
|
|
|
|
import Data.Tile
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Default.Room
|
|
import Dodge.Placement.Instance
|
|
import Dodge.PlacementSpot
|
|
import Dodge.RoomLink
|
|
import Geometry
|
|
import Tile
|
|
|
|
{- | First exit due north, two other exits at angles next to this.
|
|
Entrance from south.
|
|
-}
|
|
corridor :: Room
|
|
corridor =
|
|
defaultRoom
|
|
{ _rmPolys = [poly]
|
|
, _rmLinks = lnks'
|
|
, --, _rmPath = foldMap (doublePairSet . (,) (V2 20 60) . fst) lnks
|
|
_rmPath = foldMap (doublePairSet . (,) (V2 20 60)) [V2 20 70, V2 20 5]
|
|
--, _rmPmnts = [spanLightI (V2 0 39.5) (V2 40 39.5)]
|
|
, _rmPmnts = []
|
|
, _rmBound = [rectNSWE 45 35 (-5) 45]
|
|
-- , _rmBound = [rectNSWE 50 40 (-5) 45]
|
|
, _rmFloor = Tiled [makeTileFromPoly poly 5]
|
|
, _rmRandPSs = [psRandRanges (10, 30) (30, 60) (0, 2 * pi)]
|
|
, _rmName = "Corridor"
|
|
}
|
|
where
|
|
poly = rectNSWE 80 0 0 40
|
|
lnks' =
|
|
[ outLink (V2 20 70) 0
|
|
, outLink (V2 20 70) (pi / 3)
|
|
, outLink (V2 20 70) (negate $ pi / 3)
|
|
, outLink (V2 20 70) (pi / 4)
|
|
, outLink (V2 20 70) (negate $ pi / 4)
|
|
, outLink (V2 20 70) (pi / 6)
|
|
, outLink (V2 20 70) (negate $ pi / 6)
|
|
, inLink (V2 20 5) pi
|
|
]
|
|
|
|
keyholeCorridor :: Room
|
|
keyholeCorridor =
|
|
corridor
|
|
{ _rmPath = mempty
|
|
, _rmPmnts =
|
|
[ midWall $ rectNSWE top bot 15 0
|
|
, midWall $ rectNSWE top bot 40 25
|
|
]
|
|
}
|
|
where
|
|
top = 65
|
|
bot = 15
|
|
|
|
corridorN :: Room
|
|
corridorN =
|
|
defaultRoom
|
|
{ _rmPolys =
|
|
[ rectNSWE 80 0 0 40
|
|
]
|
|
, _rmLinks = lnks
|
|
, _rmPath = pth
|
|
, _rmPmnts = []
|
|
, _rmBound = [rectNSWE 50 30 0 40]
|
|
, _rmName = "corridorN"
|
|
}
|
|
where
|
|
lnks =
|
|
[ outLink (V2 20 70) 0
|
|
, inLink (V2 20 10) pi
|
|
]
|
|
pth = doublePairSet (V2 20 70, V2 20 10)
|
|
|
|
corridorWallN :: Room
|
|
corridorWallN =
|
|
defaultRoom
|
|
{ _rmPolys =
|
|
[ rectNSWE 70 0 0 40
|
|
]
|
|
, _rmLinks = lnks
|
|
, _rmPath = pth
|
|
, _rmPmnts = []
|
|
, _rmBound = [rectNSWE 50 30 0 40]
|
|
}
|
|
where
|
|
lnks =
|
|
[ outLink (V2 20 70) 0
|
|
, inLink (V2 20 10) pi
|
|
]
|
|
pth = doublePairSet (V2 20 70, V2 20 10)
|
|
|
|
-- this should be combined with tWest
|
|
tEast :: Room
|
|
tEast =
|
|
defaultRoom
|
|
{ _rmPolys =
|
|
[ rectNSWE 80 0 (-20) 20
|
|
, rectNSWE 80 40 (-40) 40
|
|
]
|
|
, _rmLinks = lnks'
|
|
, _rmPath = foldMap (doublePairSet . (,) (V2 0 60) . fst) lnks
|
|
, _rmPmnts = []
|
|
, _rmBound = [rectNSWE 70 10 0 40]
|
|
, _rmName = "tEast"
|
|
}
|
|
where
|
|
lnks =
|
|
[ (V2 30 60, (- pi / 2) :: Float)
|
|
, (V2 (-30) 60, pi / 2)
|
|
, (V2 0 10, pi)
|
|
]
|
|
lnks' =
|
|
[ outLink (V2 30 60) (- pi / 2)
|
|
, outLink (V2 (-30) 60) (pi / 2)
|
|
, inLink (V2 0 10) pi
|
|
]
|
|
|
|
tWest :: Room
|
|
tWest =
|
|
defaultRoom
|
|
{ _rmPolys =
|
|
[ rectNSWE 80 0 (-20) 20
|
|
, rectNSWE 80 40 (-40) 40
|
|
]
|
|
, _rmLinks = lnks
|
|
, _rmPath = foldMap (doublePairSet . (V2 0 60,) . _rlPos) lnks
|
|
, _rmPmnts = []
|
|
, _rmBound = [rectNSWE 70 10 0 40]
|
|
, _rmName = "tWest"
|
|
}
|
|
where
|
|
lnks =
|
|
[ outLink (V2 (-30) 60) (pi / 2)
|
|
, outLink (V2 30 60) (- pi / 2)
|
|
, inLink (V2 0 10) pi
|
|
]
|