Files
loop/src/Dodge/Room/Corridor.hs
T

119 lines
3.1 KiB
Haskell

{-# LANGUAGE TupleSections #-}
module Dodge.Room.Corridor where
import Data.Tile
import Dodge.LevelGen.Data
import Dodge.RoomLink
--import Dodge.Room.Foreground
import Dodge.Default.Room
--import Dodge.LevelGen.Data
--import Dodge.LightSources.Lamp
import Dodge.Placement.Instance
import Dodge.PlacementSpot
import Geometry
import Tile
--import Data.Bifunctor
{- | First exit due north, two other exits at angles next to this.
Entrance from south. -}
corridor :: Room
corridor = defaultRoom
{ _rmPolys = [poly]
, _rmLinks = lnks'
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
, _rmPmnts = [ spanLightI (V2 0 39.5) (V2 40 39.5) ]
, _rmBound = [ rectNSWE 50 30 0 40 ]
, _rmFloor = Tiled [makeTileFromPoly poly 2]
, _rmRandPSs = [psRandRanges (10,30) (30,60) (0,2*pi)]
, _rmName = "Corridor"
}
where
poly = rectNSWE 80 0 0 40
lnks' =
[uncurry outLink (V2 20 70 , 0)
,uncurry outLink (V2 20 70 , pi/6)
,uncurry outLink (V2 20 70 , negate $ pi/6)
,uncurry inLink (V2 20 10 , pi)
]
lnks =
[ (V2 20 70, 0::Float)
, (V2 20 70, pi/6)
, (V2 20 70, negate $ pi/6)
, (V2 20 10, pi)
]
keyholeCorridor :: Room
keyholeCorridor = corridor
{ _rmPath = []
, _rmPmnts =
[ midWall $ rectNSEW top bot 0 15
, midWall $ rectNSEW top bot 25 40]
}
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 ]
}
where lnks = [uncurry outLink (V2 20 70 ,0)
,uncurry inLink (V2 20 10 ,pi)
]
pth = doublePair (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 = [uncurry outLink(V2 20 70 ,0)
,uncurry inLink(V2 20 10 ,pi)
]
pth = doublePair (V2 20 70,V2 20 10)
tEast :: Room
tEast = defaultRoom
{ _rmPolys = [rectNSWE 80 0 (-20) 20
,rectNSWE 80 40 (-40) 40
]
, _rmLinks = lnks'
, _rmPath = concatMap (doublePair . (,) (V2 0 60) . fst) lnks
, _rmPmnts = []
, _rmBound = [ rectNSWE 70 10 0 40 ]
}
where
lnks =
[(V2 30 60, (-pi/2)::Float)
,(V2 (-30) 60, pi/2 )
,(V2 0 10, pi )
]
lnks' =
[uncurry outLink (V2 30 60,-pi/2)
,uncurry outLink (V2 (-30) 60,pi/2)
,uncurry inLink (V2 0 10,pi)
]
tWest :: Room
tWest = defaultRoom
{ _rmPolys = [rectNSWE 80 0 (-20) 20
,rectNSWE 80 40 (-40) 40
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (V2 0 60 ,) . _rlPos) lnks
, _rmPmnts = []
, _rmBound = [ rectNSWE 70 10 0 40 ]
}
where
lnks =
[outLink (V2 (-30) 60) ( pi/2)
,outLink (V2 30 60) (-pi/2)
,inLink (V2 0 10) pi
]