529 lines
21 KiB
Haskell
529 lines
21 KiB
Haskell
{-
|
|
Specification of individual rooms.
|
|
-}
|
|
module Dodge.Room
|
|
( module Dodge.Room
|
|
, module Dodge.Room.Corridor
|
|
) where
|
|
import Dodge.Default.Room
|
|
import Dodge.Item.Weapon
|
|
import Dodge.Item.Weapon.AutoGun
|
|
import Dodge.Item.Weapon.Launcher
|
|
import Dodge.Creature
|
|
--import Dodge.Creature.Inanimate
|
|
--import Dodge.LevelGen
|
|
import Dodge.LevelGen.Data
|
|
--import Dodge.Base
|
|
import Dodge.RandomHelp
|
|
import Dodge.LevelGen
|
|
import Dodge.Default.Wall
|
|
--import Dodge.Path
|
|
--import Dodge.Layout
|
|
import Dodge.Layout.Tree.Polymorphic
|
|
import Dodge.Layout.Tree.Either
|
|
--import Dodge.LightSources
|
|
--import Dodge.SoundLogic
|
|
import Dodge.Room.Data
|
|
import Dodge.Room.Placement
|
|
import Dodge.Room.Procedural
|
|
import Dodge.Room.Corridor
|
|
import Dodge.Room.Link
|
|
--import Dodge.Room.Branch
|
|
import Dodge.Room.Door
|
|
import Dodge.Room.Airlock
|
|
import Dodge.Room.LongDoor
|
|
import Geometry
|
|
--import Geometry.Data
|
|
import Picture
|
|
import Tile
|
|
|
|
import Control.Lens
|
|
import Control.Monad.State
|
|
import Control.Monad.Loops
|
|
import System.Random
|
|
import Data.Tree
|
|
import Data.Bifunctor
|
|
--import qualified Data.Map as M
|
|
--import qualified Data.IntMap.Strict as IM
|
|
|
|
roomC :: Float -> Float -> Room
|
|
roomC x y = defaultRoom
|
|
{ _rmPolys = [rectNSWE y 0 0 x]
|
|
, _rmLinks = lnks
|
|
, _rmPath = pth
|
|
, _rmPS = [windowLine (V2 (x/2) 0) (V2 (x/2) (y-60))
|
|
]
|
|
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
|
|
}
|
|
where
|
|
lnks = map (first toV2)
|
|
[( (x-20, 0),pi)
|
|
,( ( 20, 0),pi)
|
|
,( ( 0, 20),pi/2)
|
|
]
|
|
xn = 4
|
|
yn = 4
|
|
yd = (y - 40) / fromIntegral yn
|
|
xd = (x - 40) / fromIntegral xn
|
|
pth = linksAndPath lnks $ translateS (V2 20 20) (makeGrid xd xn yd yn)
|
|
|
|
roomPadCut :: [Point2] -> Point2 -> Room
|
|
roomPadCut ps p = defaultRoom
|
|
{ _rmPolys = [ps]
|
|
, _rmLinks = [(p,0),(V2 0 0,pi)]
|
|
, _rmPath = [(V2 0 0,p)]
|
|
, _rmPS = []
|
|
, _rmBound = []
|
|
}
|
|
roomPillars :: Room
|
|
roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
|
|
where
|
|
plmnts = sPS (V2 120 120) 0 putLamp
|
|
: sPS (V2 12 12) 0 putLamp
|
|
: sPS (V2 228 228) 0 putLamp
|
|
: g 180 150 90 60
|
|
f a x b y = putBlockRect a x b y
|
|
g a b c d = f a b a b ++ f a b c d ++ f c d a b ++ f c d c d
|
|
|
|
branchWith :: Room -> [Tree Room] -> Tree (Either Room Room)
|
|
branchWith r ts = Node (Left r) $ return (Right door) : fmap (fmap Left) ts
|
|
|
|
glassSwitchBack :: RandomGen g => State g Room
|
|
glassSwitchBack = do
|
|
wth <- state $ randomR (200,400)
|
|
hgt <- state $ randomR (400,600)
|
|
wllen <- state $ randomR (60,wth/2-40)
|
|
let hf = hgt/5
|
|
let plmnts =
|
|
[windowLine (V2 (wth-60 ) hf ) (V2 wllen hf )
|
|
,windowLine (V2 (wth-wllen) (2*hf)) (V2 60 (2*hf))
|
|
,windowLine (V2 (wth-60 ) (3*hf)) (V2 wllen (3*hf))
|
|
,windowLine (V2 (wth-wllen) (4*hf)) (V2 60 (4*hf))
|
|
,blockLine (V2 0 (1*hf)) (V2 wllen (1*hf))
|
|
,blockLine (V2 (wth-wllen) (2*hf)) (V2 wth (2*hf))
|
|
,blockLine (V2 0 (3*hf)) (V2 wllen (3*hf))
|
|
,blockLine (V2 (wth-wllen) (4*hf)) (V2 wth (4*hf))
|
|
, sPS (V2 (wth/2) (hgt/2)) 0 putLamp
|
|
]
|
|
return $ set rmPS plmnts $ roomRect wth hgt 2 6
|
|
|
|
manyDoors :: Int -> Tree (Either Room Room)
|
|
manyDoors i = treeFromPost (replicate i (Left door)) $ Right door
|
|
|
|
glassLesson :: RandomGen g => State g (Tree (Either Room Room))
|
|
glassLesson = do
|
|
corridors <- replicateM 3 $ Left <$> randomiseOutLinks corridor
|
|
return $ Node (Left botRoom) [deadRoom door,uppers, treeFromPost (Left door : corridors) $ Right door]
|
|
where
|
|
uppers = Node (Left door) [deadRoom topRoom]
|
|
botRoom = set rmPS botplmnts $ roomRect 200 200 1 1
|
|
topRoom = set rmPS topplmnts $ roomRect 200 200 1 1
|
|
botplmnts =
|
|
[sPS (V2 0 0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
|
|
,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
|
|
,sPS (V2 50 50) 0 putLamp
|
|
]
|
|
topplmnts =
|
|
[windowLine (V2 100 200) (V2 100 0)
|
|
,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
|
|
,sPS (V2 50 50) 0 putLamp
|
|
]
|
|
|
|
miniRoom1 :: RandomGen g => State g Room
|
|
miniRoom1 = do
|
|
wth <- state $ randomR (200,400)
|
|
hgt <- state $ randomR (400,600)
|
|
wllen <- state $ randomR (60,wth/2-40)
|
|
let hf = hgt/5
|
|
cry <- randomRanges [--50+2*hf,30+3*hf
|
|
50+3*hf,30+4*hf
|
|
,50+4*hf,30+5*hf
|
|
]
|
|
crx <- state $ randomR (wllen,wth-(wllen+40))
|
|
let plmnts = [windowLine (V2 (wth-60) ( 40+hf)) (V2 wllen (40+hf))
|
|
,windowLine (V2 (wth-wllen) (40+2*hf)) (V2 60 (40+2*hf))
|
|
,windowLine (V2 (wth-60) ( 40+3*hf)) (V2 wllen (40+3*hf))
|
|
,windowLine (V2 (wth-wllen) (40+4*hf)) (V2 60 (40+4*hf))
|
|
,sPS (V2 crx cry) 0 $ PutCrit miniGunCrit
|
|
,sPS (V2 (wth-20) (hgt/2+40)) 0 randC1
|
|
,sPS (V2 (wth/2) (hgt/2)) 0 putLamp
|
|
,blockLine (V2 0 ( 40+1*hf)) (V2 wllen (40+1*hf))
|
|
,blockLine (V2 (wth-wllen) ( 40+2*hf)) (V2 wth (40+2*hf))
|
|
,blockLine (V2 0 ( 40+3*hf)) (V2 wllen (40+3*hf))
|
|
,blockLine (V2 (wth-wllen) ( 40+4*hf)) (V2 wth (40+4*hf))
|
|
]
|
|
return $ set rmPS plmnts $ shiftRoomBy (V2 0 40,0) $ roomRect wth hgt 2 4
|
|
|
|
miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
|
|
miniTree2 = miniRoom1
|
|
>>= randomiseOutLinks
|
|
>>= changeLinkTo (\p -> (sndV2 . fst) p < 70)
|
|
<&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)
|
|
|
|
miniRoom3 :: RandomGen g => State g (Tree (Either Room Room))
|
|
miniRoom3 = do
|
|
w <- state $ randomR (300,400)
|
|
h <- state $ randomR (300,400)
|
|
let cp = V2 0 (h/2+40)
|
|
let b = PutBlock [5,20,20] (greyN 0.5) $ map toV2 [(-10,-60)
|
|
,( 10,-60)
|
|
,( 10,-80)
|
|
,(-10,-80)
|
|
]
|
|
let plmnts = [sPS cp 0 $ PutCrit miniGunCrit
|
|
,sPS cp 0 $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
|
,sPS cp (1*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
|
,sPS cp (2*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
|
,sPS cp (3*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
|
,sPS cp (4*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
|
,sPS cp (5*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
|
,sPS cp (6*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
|
,sPS cp (7*pi/4) $ windowLineType (V2 0 (-40)) (V2 0 (-80))
|
|
,sPS cp (pi/8) b
|
|
,sPS cp (pi/8+1*pi/4) b
|
|
,sPS cp (pi/8+2*pi/4) b
|
|
,sPS cp (pi/8+3*pi/4) b
|
|
,sPS cp (pi/8+4*pi/4) b
|
|
,sPS cp (pi/8+5*pi/4) b
|
|
,sPS cp (pi/8+6*pi/4) b
|
|
,sPS cp (pi/8+7*pi/4) b
|
|
,sPS (V2 (w/2) (h/2)) 0 putLamp
|
|
]
|
|
fmap connectRoom $ randomiseOutLinks $ set rmPS plmnts $ roomRectAutoLinks w h
|
|
|
|
rot90Around :: Point2 -> Point2 -> Point2
|
|
rot90Around cen p = cen +.+ vNormal (p -.- cen)
|
|
|
|
-- So, the idea is to attach outer children to the bottommost right nodes
|
|
-- inside an inner tree
|
|
roomMiniIntro :: RandomGen g => State g (Tree (Either Room Room))
|
|
roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost
|
|
[return $ connectRoom door
|
|
,join $ takeOne [miniTree2,glassLesson]
|
|
]
|
|
$ connectRoom <$> randomiseOutLinks corridor
|
|
where
|
|
f (Node (Right x) xs) = Node (Right (Right x)) $ map f xs
|
|
f (Node (Left x) xs) = Node (Left (Left x)) $ map f xs
|
|
g (Node (Right x) []) = Node (Right x) []
|
|
g (Node (Right x) xs) = Node (Left x) $ map g xs
|
|
g (Node y ys) = Node y $ map g ys
|
|
|
|
roomCenterPillar :: RandomGen g => State g Room
|
|
roomCenterPillar = changeLinkTo ((\p -> dist p (V2 120 0) < 10) . fst)
|
|
$ set rmPS plmnts $ roomRect 240 240 2 2
|
|
where
|
|
plmnts =
|
|
[ blockLine (V2 115 115) (V2 115 125)
|
|
, blockLine (V2 125 115) (V2 125 125)
|
|
, sPS (V2 40 120) 0 putLamp
|
|
, sPS (V2 200 120) 0 putLamp
|
|
]
|
|
|
|
roomOctogon :: Room
|
|
roomOctogon = defaultRoom
|
|
{ _rmPolys = [poly ]
|
|
, _rmLinks = lnks
|
|
, _rmPath = allPairs $ map fst lnks
|
|
, _rmPS = []
|
|
, _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ]
|
|
, _rmFloor = [makeTileFromPoly poly 7]
|
|
}
|
|
where
|
|
poly = map toV2 [(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)]
|
|
lnks = map (first toV2)
|
|
[((0,140),0)
|
|
,((35,125),negate $ pi/4)
|
|
,((-35,125),pi/4)
|
|
,( (50,90),negate $ pi/2)
|
|
,( (-50,90),pi/2)
|
|
,((35,55),negate $ 3*pi/4)
|
|
,((-35,55),3*pi/4)
|
|
,( (0,40),pi)
|
|
]
|
|
|
|
allPairs :: Eq a => [a] -> [(a,a)]
|
|
allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
|
|
|
|
randomCorridorFrom :: RandomGen g => [a] -> State g (Tree (Either a a))
|
|
randomCorridorFrom xs = do
|
|
rooms <- replicateM 5 $ takeOne xs
|
|
return $ treeFromTrunk (map Left $ init rooms) (Node (Right (last rooms)) [])
|
|
{- Probabilites of the type of the first floor weapon. -}
|
|
randFirstWeapon :: State StdGen PSType
|
|
randFirstWeapon = do
|
|
takeOne $ map PutFlIt $
|
|
replicate 10 pistol
|
|
++ replicate 5 ltAutoGun
|
|
++ replicate 5 spreadGun
|
|
++ replicate 5 multGun
|
|
++ replicate 2 autoGun
|
|
++ [launcher]
|
|
|
|
|
|
weaponEmptyRoom :: RandomGen g => State g (Tree (Either Room Room))
|
|
weaponEmptyRoom = do
|
|
w <- state $ randomR (220,300)
|
|
h <- state $ randomR (220,300)
|
|
let plmnts =
|
|
[sPS (V2 (w/2) (h-40)) 0 $ RandPS randFirstWeapon
|
|
,sPS (V2 20 20) (pi/2) randC1
|
|
,sPS (V2 (w-20) 20) (pi/2) randC1
|
|
,sPS (V2 (w/2) (h/2)) 0 putLamp
|
|
]
|
|
(fmap connectRoom . randomiseOutLinks) =<<
|
|
changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPS plmnts $ roomRect w h 2 2)
|
|
|
|
weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
|
|
weaponUnderCrits = do
|
|
let plmnts =
|
|
[sPS (V2 20 0) 0 $ RandPS randFirstWeapon
|
|
,sPS (V2 20 0) (negate $ pi/2) randC1
|
|
,sPS (V2 20 20) (negate $ pi/2) randC1
|
|
]
|
|
let continuationRoom = treeFromTrunk
|
|
[Left corridorN,Left corridorN]
|
|
(connectRoom (set rmPS plmnts corridorN))
|
|
rcp' <- roomCenterPillar
|
|
let rcp = over rmPS ( sPS (V2 120 80) 0 putLamp : ) rcp'
|
|
deadEndRoom' <- takeOne [roomPillars,rcp]
|
|
junctionRoom <- takeOne [Left tEast,Left tWest]
|
|
return $ treeFromTrunk [Left corridorN,Left corridorN]
|
|
$ Node junctionRoom
|
|
[continuationRoom
|
|
,deadRoom deadEndRoom'
|
|
]
|
|
|
|
weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
|
|
weaponBehindPillar = do
|
|
cpos <- takeOne $ [V2 x y | x <- [20,220], y <- [20,220]] ++ [V2 120 160,V2 120 200]
|
|
let d p = argV $ V2 120 80 -.- p
|
|
let plmnts1 =
|
|
[sPS (V2 120 160) 0 $ RandPS randFirstWeapon
|
|
,sPS cpos (d cpos) randC1
|
|
]
|
|
rcp <- roomCenterPillar
|
|
return $ treeFromTrunk
|
|
[Left door
|
|
,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp
|
|
]
|
|
(connectRoom $ set rmPS [sPS (V2 20 60) (negate $ pi/2) randC1] corridorN)
|
|
|
|
weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
|
|
weaponBetweenPillars = do
|
|
wpPos <- takeOne [V2 x y | x <- [20,120,220], y <- [20,120,220]]
|
|
(ps,_) <- takeNMore 2 ([], [V2 x y | x <- [20,220], y <- [20,120,220]])
|
|
let crPos1:crPos2:_ = ps
|
|
d p = argV $ V2 120 120 -.- p
|
|
plmnts =
|
|
[sPS wpPos 0 $ RandPS randFirstWeapon
|
|
,sPS crPos1 (d crPos1) randC1
|
|
,sPS crPos2 (d crPos2) randC1
|
|
]
|
|
theRoom = roomPillars & rmPS %~ (++ plmnts)
|
|
-- & rmPolys %~ (rectNSWE 300 0 0 300 :)
|
|
(fmap connectRoom . randomiseOutLinks) =<< filterLinks f theRoom
|
|
where
|
|
f (_,a) = a == 0
|
|
--f (_,_) = True -- this is probably preferable...
|
|
|
|
weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
|
|
weaponLongCorridor = do
|
|
root <- takeOne [tEast, tWest]
|
|
connectingRoom <- takeOne
|
|
[tEast & rmPS .~ [sPS (V2 (-40) 60) 0 putLamp]
|
|
,tWest & rmPS .~ [sPS (V2 40 60) 0 putLamp]
|
|
]
|
|
i1 <- state $ randomR (2,5)
|
|
i2 <- state $ randomR (2,5)
|
|
let branch1 = treeFromTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom)
|
|
let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor)
|
|
return $ Node (Left root) [branch1,branch2]
|
|
where
|
|
putCrs = over rmPS (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
|
|
putWp = set rmPS [sPS (V2 20 40) 0 $ RandPS randFirstWeapon ,sPS (V2 20 60) 0 putLamp ]
|
|
|
|
critInDeadEnd :: Room
|
|
critInDeadEnd = set rmPS [sPS (V2 0 0) 0 randC1] deadEndRoom
|
|
|
|
deadEndRoom :: Room
|
|
deadEndRoom = defaultRoom
|
|
{ _rmPolys = [rectNSWE 40 (-20) (-20) 20
|
|
]
|
|
, _rmLinks = lnks
|
|
, _rmPath = []
|
|
, _rmPS = [sPS (V2 0 (-10)) 0 putLamp]
|
|
, _rmBound = [rectNSWE 20 (-20) (-30) 30]
|
|
}
|
|
where
|
|
lnks = [(V2 0 30 ,0) ]
|
|
{- A random Either tree with a weapon and melee monster challenge. -}
|
|
weaponRoom :: RandomGen g => State g (Tree (Either Room Room))
|
|
weaponRoom = join $ takeOne
|
|
[ weaponEmptyRoom
|
|
, weaponUnderCrits
|
|
, weaponBehindPillar
|
|
, weaponBetweenPillars
|
|
, weaponLongCorridor
|
|
]
|
|
|
|
roomCCrits :: RandomGen g => State g (Tree (Either Room Room))
|
|
roomCCrits = do
|
|
ps <- replicateM 20 $ randInCirc 9
|
|
let plmnts = map (\p -> sPS p 0 randC1)
|
|
$ zipWith (+.+) [V2 x y | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps
|
|
lamps = [sPS (V2 50 100) 0 putLamp , sPS (V2 175 100) 0 putLamp]
|
|
return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200
|
|
|
|
|
|
longRoom :: RandomGen g => State g Room
|
|
longRoom = do
|
|
h <- state $ randomR (1500,1500)
|
|
let w = 75
|
|
let cond x = (sndV2 . fst) x < h - 40
|
|
let ws = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall)
|
|
[rectNSWE (h-35) (h-135) (-10) 10
|
|
,rectNSWE (h-35) (h-135) 15 35
|
|
,rectNSWE (h-35) (h-135) 40 60
|
|
,rectNSWE (h-35) (h-135) 65 85
|
|
]
|
|
let wsDefense = map (\ps -> sPS (V2 0 0) 0 $ PutWall ps defaultCrystalWall)
|
|
[rectNSWE 95 70 0 25
|
|
,rectNSWE 95 70 50 75
|
|
]
|
|
brls <- fmap (map (\p -> sPS (p +.+ V2 10 200) 0 $ PutCrit explosiveBarrel) )
|
|
$ replicateM 5 $ randInRect (w-20) 900
|
|
let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
|
|
changeLinkTo cond $ rm & rmPS .~ ws ++ brls ++ wsDefense ++
|
|
[sPS (V2 12.5 (h-25)) 0 $ PutCrit longCrit
|
|
,sPS (V2 37.5 (h-25)) 0 $ PutCrit longCrit
|
|
,sPS (V2 62.5 (h-25)) 0 $ PutCrit longCrit
|
|
,sPS (V2 25 20 ) 0 putLamp
|
|
,sPS (V2 25 (h-10)) 0 putLamp
|
|
]
|
|
|
|
shooterRoom :: RandomGen g => State g Room
|
|
shooterRoom = do
|
|
h <- state $ randomR (200,300)
|
|
let cond x = (sndV2 . fst) x < h - 40
|
|
changeLinkTo cond $ roomRect 100 h 1 1 & rmPS .~
|
|
[blockLine (V2 50 50) (V2 50 h)
|
|
,sPS (V2 25 (h-25)) 0 $ PutCrit $ addArmour autoCrit
|
|
,sPS (V2 75 (h-30)) 0 $ PutCrit explosiveBarrel
|
|
,sPS (V2 75 (h-60)) 0 $ PutCrit explosiveBarrel
|
|
,sPS (V2 85 (h-10)) 0 $ PutCrit explosiveBarrel
|
|
,sPS (V2 85 (h-45)) 0 $ PutCrit explosiveBarrel
|
|
,sPS (V2 75 (h-80)) 0 putLamp
|
|
]
|
|
|
|
shootersRoom1 :: RandomGen g => State g Room
|
|
shootersRoom1 = do
|
|
w <- state $ randomR (200,300)
|
|
x1 <- state $ randomR (20,w/3-20)
|
|
x2 <- state $ randomR (w/3+20,2*w/3-20)
|
|
x3 <- state $ randomR (2*w/3+20,w-20)
|
|
y1 <- state $ randomR (250,560)
|
|
y2 <- state $ randomR (250,560)
|
|
y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (250,560)
|
|
x4 <- state $ randomR (60,w-60)
|
|
y4 <- state $ randomR (40,180)
|
|
p <- takeOne [V2 x1 (y1-10),V2 x2 (y2-10),V2 x3 (y3-10)]
|
|
let bln x y = putBlockN (x+25) (x-25) (y+10) y
|
|
let blv x y = putBlockV (x+25) (x-25) (y+10) y
|
|
let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
|
|
++ [sPS p (-pi/2) $ PutCrit autoCrit
|
|
,sPS (V2 (w/2) 200) 0 putLamp
|
|
]
|
|
return $ set rmPS plmnts $ roomRectAutoLinks w 600
|
|
|
|
shootersRoom :: RandomGen g => State g Room
|
|
shootersRoom = do
|
|
w <- state $ randomR (200,300)
|
|
x1 <- state $ randomR (20,w/3-20)
|
|
x2 <- state $ randomR (w/3+20,2*w/3-20)
|
|
x3 <- state $ randomR (2*w/3+20,w-20)
|
|
y1 <- state $ randomR (250,560)
|
|
y2 <- state $ randomR (250,560)
|
|
y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (250,560)
|
|
x4 <- state $ randomR (60,w-60)
|
|
y4 <- state $ randomR (40,180)
|
|
let bln x y = putBlockN (x+25) (x-25) (y+10) y
|
|
let blv x y = putBlockV (x+25) (x-25) (y+10) y
|
|
let plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
|
|
++ [sPS (V2 x1 (y1-10)) (-pi/2) $ PutCrit autoCrit
|
|
,sPS (V2 x2 (y2-10)) (-pi/2) $ PutCrit autoCrit
|
|
,sPS (V2 x3 (y3-10)) (-pi/2) $ PutCrit autoCrit
|
|
,sPS (V2 (w/2) 200 ) 0 putLamp
|
|
]
|
|
return $ set rmPS plmnts $ roomRectAutoLinks w 600
|
|
|
|
pistolerRoom :: RandomGen g => State g Room
|
|
pistolerRoom = do
|
|
let f2 x y = singleBlock (V2 x y)
|
|
--f3 x y = [blockLine (x-20,y) (x+20,y)
|
|
-- ,blockLine (x,y-20) (x,y+20) ]
|
|
--f4 x y = [blockLine (x-20,y-20) (x+20,y+20)
|
|
-- ,blockLine (x+20,y-20) (x-20,y+20) ]
|
|
f <- takeOne [f2]
|
|
h <- state $ randomR (400,800)
|
|
let w = h
|
|
i <- takeOne [3,4,5]
|
|
let j = fromIntegral (i+1)
|
|
-- the 20+etc here is to correct for the pathfinding grid, which matches up to
|
|
-- edges based on the size of doors (i.e. the line next to the wall is 20
|
|
-- away from it)
|
|
xs = take i [20+0.5*(w-40)/(j-1),20+1.5*(w-40)/(j-1)..]
|
|
ys = take i [20+0.5*(h-40)/(j-1),20+1.5*(h-40)/(j-1)..]
|
|
gap = 0.5 * h / j
|
|
ps <- takeN 3 $ zipWith V2 (map (+gap) xs) ys
|
|
aa <- state $ randomR (0,2*pi)
|
|
ab <- state $ randomR (0,2*pi)
|
|
ac <- state $ randomR (0,2*pi)
|
|
let plmnts = [sPS (ps !! 0) aa $ PutCrit pistolCrit
|
|
,sPS (ps !! 1) ab $ PutCrit pistolCrit
|
|
,sPS (ps !! 2) ac $ PutCrit pistolCrit
|
|
,sPS (V2 (w/2) (h-50)) 0 putLamp
|
|
,sPS (V2 (w/2) 50 ) 0 putLamp
|
|
,sPS (V2 (w-5) (h-5) ) 0 putLamp
|
|
,sPS (V2 5 (h-5) ) 0 putLamp
|
|
,sPS (V2 (w-5) 5 ) 0 putLamp
|
|
,sPS (V2 5 5 ) 0 putLamp
|
|
,sPS (V2 (w/2) (h/2) ) 0 putLamp
|
|
]
|
|
++
|
|
concat [f x y | x<-xs,y<-ys]
|
|
return
|
|
$ set rmPS plmnts $ roomRect w h (max i 2) (max i 2)
|
|
|
|
shootingRange :: RandomGen g => State g (Tree (Either Room Room))
|
|
shootingRange = do
|
|
rm1 <- shootersRoom1 >>= changeLinkTo (\(V2 _ y,_) -> y < 40)
|
|
>>= filterLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
|
|
rm2 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
|
|
>>= filterLinks (\(V2 _ y,r) -> y > 200 && r /= 0)
|
|
rm3 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
|
|
>>= filterLinks (\(_,r) -> r == 0)
|
|
return $ treeFromPost [Left rm1
|
|
,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (V2 0 20)
|
|
,Left rm2
|
|
,Left $ roomPadCut (rectNSWE 20 (-20) (-80) 80) (V2 0 20)
|
|
]
|
|
(Right rm3)
|
|
|
|
spawnerRoom :: RandomGen g => State g (Tree (Either Room Room))
|
|
spawnerRoom = do
|
|
x <- state $ randomR (250,300)
|
|
y <- state $ randomR (300,400)
|
|
wl <- takeOne [sPS (V2 0 0) 0 $ PutWall (rectNSWE (y-60) 0 (x/2-10) (x/2+10))
|
|
defaultCrystalWall
|
|
,windowLine (V2 (x/2) 0) (V2 (x/2) (y-60))
|
|
]
|
|
let plmnts = [sPS (V2 (x/4) ( y/4)) (pi/2) $ PutCrit spawnerCrit
|
|
,wl
|
|
,sPS (V2 (x/2) ( y-10)) 0 putLamp
|
|
]
|
|
let f (V2 lx _,_) = lx < x/2-5
|
|
roomWithSpawner <- (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (set rmPS plmnts $ roomRect x y 2 2)
|
|
aRoom <- airlock 0
|
|
return $ treeFromTrunk [Left aRoom] roomWithSpawner
|