Cleanup room moduling
This commit is contained in:
+1
-1
@@ -39,7 +39,7 @@ initialAnoTree :: RandomGen g => Tree [Annotation g]
|
||||
initialAnoTree = padSucWithCorridors $ treeFromTrunk
|
||||
[[StartRoom]
|
||||
,[SetLabel 0 $ return $ roomRectAutoLinks 100 100
|
||||
& rmExtendedPmnt .~ Just (externalButton red (PS (V2 50 50) 0))
|
||||
& rmExtendedPmnt ?~ externalButton red (anyLnkInPS 5)
|
||||
]
|
||||
,[UseLabel 0 $ return switchDoorRoom]
|
||||
,[SpecificRoom $ return $ connectRoom lasTunnel ]
|
||||
|
||||
@@ -25,8 +25,6 @@ import Data.List (nubBy)
|
||||
--import Control.Monad.State
|
||||
import Control.Lens
|
||||
import System.Random
|
||||
--import Data.Graph.Inductive.Graph (labNodes)
|
||||
--import qualified Data.Map as M
|
||||
import Data.Foldable
|
||||
import qualified Control.Foldl as L
|
||||
import Data.Maybe
|
||||
|
||||
@@ -4,18 +4,7 @@ import Dodge.Data
|
||||
import Dodge.RandomHelp
|
||||
import Dodge.Layout.Tree.Polymorphic
|
||||
import Dodge.Layout.Tree.Either
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.Room.Branch
|
||||
import Dodge.Room.RoadBlock
|
||||
import Dodge.Room.Door
|
||||
import Dodge.Room.Boss
|
||||
import Dodge.Room.Treasure
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.Data
|
||||
import Dodge.Room.Airlock
|
||||
import Dodge.Room.Start
|
||||
import Dodge.Room
|
||||
import Dodge.Room.Teleport
|
||||
|
||||
import Data.Tree
|
||||
import Control.Monad.State
|
||||
@@ -27,7 +16,6 @@ data Annotation g
|
||||
| Key Int
|
||||
| Corridor
|
||||
| CorridorDebug
|
||||
| DoorAno
|
||||
| SwitchDoorAno
|
||||
| DoorNumAno Int
|
||||
| AirlockAno
|
||||
@@ -76,7 +64,7 @@ anoToRoomTree anos = case anos of
|
||||
anoToRoomTree a
|
||||
[Corridor] -> pure . Right <$> randomiseOutLinks corridor
|
||||
[CorridorDebug] -> pure . Right <$> randomiseOutLinks corridorDebug
|
||||
[DoorAno] -> roomThenCorridor door
|
||||
-- [DoorAno] -> roomThenCorridor door
|
||||
[AirlockAno] -> airlock >>= roomThenCorridor
|
||||
[FirstWeapon] -> do
|
||||
branchWP <- branchRectWith weaponRoom
|
||||
|
||||
@@ -36,7 +36,7 @@ placeSpot (w,rm) plmnt = case plmnt of
|
||||
Placement{_plSpot = PSLnk{}} -> placeSpotUsingLink w rm plmnt
|
||||
Placement{} ->
|
||||
let (i,w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
|
||||
newplmnt = plmnt & plMID .~ Just i
|
||||
newplmnt = plmnt & plMID ?~ i
|
||||
in maybe ((w',rm),[newplmnt]) (recrPlace newplmnt w') (_plIDCont plmnt newplmnt)
|
||||
where
|
||||
recrPlace newplmnt w' pl = let (wr,newplmnts) = placeSpot (w',rm) pl
|
||||
|
||||
@@ -3,13 +3,14 @@
|
||||
module Dodge.LevelGen.Data where
|
||||
import Dodge.Data
|
||||
import Picture
|
||||
import Geometry.Data
|
||||
import Geometry
|
||||
import Shape.Data
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
import System.Random
|
||||
import Data.Maybe
|
||||
--import Data.Bifunctor
|
||||
data PSType = PutCrit {_unPutCrit :: Creature}
|
||||
| PutMachine Color [Point2] Machine
|
||||
| PutLS LightSource
|
||||
@@ -46,6 +47,15 @@ data Placement = Placement
|
||||
| PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position
|
||||
| RandomPlacement {_unRandomPlacement :: State StdGen Placement}
|
||||
|
||||
anyLnkOutPS :: PlacementSpot
|
||||
anyLnkOutPS = PSLnk (const True) id Nothing
|
||||
|
||||
anyLnkInPS :: Float -- ^ amount to shift inward
|
||||
-> PlacementSpot
|
||||
anyLnkInPS x = PSLnk (const True) f Nothing
|
||||
where
|
||||
f (v,a) = (v -.- x *.* unitVectorAtAngle (a + 0.5 * pi), a+ pi)
|
||||
|
||||
spNoID :: PlacementSpot -> PSType -> Placement
|
||||
spNoID ps pst = Placement ps pst Nothing (const Nothing)
|
||||
|
||||
@@ -76,7 +86,7 @@ jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0) pst Nothing $ \_ -> Just plm
|
||||
ps0 :: PSType -> (Int -> Maybe Placement) -> Placement
|
||||
ps0 pst = Placement (PS (V2 0 0) 0) pst Nothing . intPlPlPl
|
||||
|
||||
intPlPlPl :: (Int -> Maybe Placement) -> Placement -> (Maybe Placement)
|
||||
intPlPlPl :: (Int -> Maybe Placement) -> Placement -> Maybe Placement
|
||||
intPlPlPl f = f . fromJust . _plMID
|
||||
|
||||
jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
|
||||
|
||||
+21
-481
@@ -2,20 +2,30 @@
|
||||
Specification of individual rooms.
|
||||
-}
|
||||
module Dodge.Room
|
||||
( module Dodge.Room
|
||||
( module Dodge.Room.Room
|
||||
, module Dodge.Room.Foreground
|
||||
, module Dodge.Room.Data
|
||||
, module Dodge.Room.Procedural
|
||||
, module Dodge.Room.Corridor
|
||||
, module Dodge.Room.Link
|
||||
, module Dodge.Room.Door
|
||||
, module Dodge.Room.Airlock
|
||||
, module Dodge.Room.LongDoor
|
||||
, module Dodge.Room.Branch
|
||||
, module Dodge.Room.RoadBlock
|
||||
, module Dodge.Room.Teleport
|
||||
, module Dodge.Room.Start
|
||||
, module Dodge.Room.Boss
|
||||
, module Dodge.Room.Treasure
|
||||
) where
|
||||
import Dodge.Default.Room
|
||||
import Dodge.Item.Weapon.BulletGuns
|
||||
import Dodge.Item.Weapon.Launcher
|
||||
import Dodge.Creature
|
||||
import Dodge.Room.Room
|
||||
import Dodge.Room.Treasure
|
||||
import Dodge.Room.Boss
|
||||
import Dodge.Room.Start
|
||||
import Dodge.Room.RoadBlock
|
||||
import Dodge.Room.Teleport
|
||||
import Dodge.Room.Branch
|
||||
import Dodge.Room.Foreground
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.RandomHelp
|
||||
import Dodge.Default.Wall
|
||||
import Dodge.Layout.Tree.Polymorphic
|
||||
import Dodge.Layout.Tree.Either
|
||||
import Dodge.Placements
|
||||
import Dodge.Room.Data
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.Room.Corridor
|
||||
@@ -23,473 +33,3 @@ import Dodge.Room.Link
|
||||
import Dodge.Room.Door
|
||||
import Dodge.Room.Airlock
|
||||
import Dodge.Room.LongDoor
|
||||
import Geometry
|
||||
import Picture
|
||||
import Tile
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Loops
|
||||
import System.Random
|
||||
import Data.Tree
|
||||
import Data.Bifunctor
|
||||
|
||||
roomC :: RandomGen g => Float -> Float -> State g Room
|
||||
roomC w h = do
|
||||
wl <- takeOne
|
||||
[ sPS (V2 0 0) 0 $ PutWall (rectNSWE (h-60) 0 (w/2-10) (w/2+10)) defaultCrystalWall
|
||||
, windowLine (V2 (w/2) 0) (V2 (w/2) (h-60))
|
||||
]
|
||||
changeLinkFrom fromCond $ roomRectAutoLinks w h
|
||||
& rmPmnts %~ (wl : )
|
||||
& rmRandPSs .~ [farside]
|
||||
where
|
||||
fromCond (V2 x _,_) = x < w / 2 - 10
|
||||
farside = do
|
||||
x <- state $ randomR (5, w/2 - 20)
|
||||
y <- state $ randomR (5, h - 70)
|
||||
a <- state $ randomR (0, 2*pi)
|
||||
return (V2 x y,a)
|
||||
|
||||
roomPadCut :: [Point2] -> Point2 -> Room
|
||||
roomPadCut ps p = defaultRoom
|
||||
{ _rmPolys = [ps]
|
||||
, _rmLinks = [(p,0),(V2 0 0,pi)]
|
||||
, _rmPath = [(V2 0 0,p)]
|
||||
}
|
||||
roomPillars :: Room
|
||||
roomPillars = over rmLinks init $ set rmPmnts plmnts $ roomRect 240 240 2 2
|
||||
where
|
||||
plmnts = spanLightI (V2 120 24) (V2 120 216)
|
||||
: mountLightV (V2 12 12) (V3 25 25 70)
|
||||
: mountLightV (V2 228 228) (V3 215 215 70)
|
||||
: sps0 (PutForeground $ thinHighBar 75 (V2 26 25) (V2 120 25))
|
||||
: sps0 (PutForeground $ thinHighBar 75 (V2 214 215) (V2 120 215))
|
||||
: 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
|
||||
|
||||
|
||||
manyDoors :: Int -> Tree (Either Room Room)
|
||||
manyDoors i = treeFromPost (replicate i (Left door)) $ Right door
|
||||
|
||||
-- TODO: partially combine a room tree into a room
|
||||
glassLesson :: RandomGen g => State g (Tree (Either Room Room))
|
||||
glassLesson = do
|
||||
i <- takeOne [1,2,3]
|
||||
corridors <- replicateM i $ 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 rmPmnts botplmnts $ roomRect 200 200 1 1
|
||||
topRoom = set rmPmnts 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
|
||||
,RandomPlacement $ takeOne
|
||||
[ spanLightI (V2 160 0) (V2 160 220)
|
||||
, mountLightV (V2 180 200) (V3 160 180 50)
|
||||
]
|
||||
]
|
||||
topplmnts =
|
||||
[windowLine (V2 100 200) (V2 100 0)
|
||||
,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
|
||||
--,sPS (V2 50 50) 0 putLamp
|
||||
,RandomPlacement $ takeOne
|
||||
[ spanLightI (V2 160 (-20)) (V2 160 220)
|
||||
, mountLightV (V2 180 200) (V3 160 180 50)
|
||||
]
|
||||
]
|
||||
|
||||
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
|
||||
con1 (V2 _ y,_) = y < 0.5*hgt
|
||||
plmnts =
|
||||
[ mntLightLnkCond con1
|
||||
, mntLightLnkCond (not . con1)
|
||||
,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
|
||||
]
|
||||
let northPSs = do
|
||||
cry <- randomRanges [3*hf+10,4*hf-10
|
||||
,4*hf+10,5*hf-10
|
||||
]
|
||||
crx <- state $ randomR (wllen,wth-(wllen+40))
|
||||
return (V2 crx cry,1.5*pi)
|
||||
midPS = return (V2 (wth-20) (hgt/2+40), pi)
|
||||
return $ roomRect wth hgt 2 4
|
||||
& rmPmnts .~ plmnts
|
||||
& rmRandPSs .~ [northPSs,midPS]
|
||||
|
||||
glassSwitchBackCrits :: RandomGen g => State g Room
|
||||
glassSwitchBackCrits = glassSwitchBack
|
||||
<&> rmPmnts %~ ([spNoID (PSRoomRand 0) (PutCrit miniGunCrit)
|
||||
, spNoID (PSRoomRand 1) randC1
|
||||
] ++)
|
||||
|
||||
miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
|
||||
miniTree2 = glassSwitchBackCrits
|
||||
>>= 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 rmPmnts 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 rmPmnts 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
|
||||
, mntLightLnkCond (const True)
|
||||
, mntLightLnkCond (const True)
|
||||
]
|
||||
|
||||
roomOctogon :: Room
|
||||
roomOctogon = defaultRoom
|
||||
{ _rmPolys = [poly ]
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = allPairs $ map fst lnks -- this is too much
|
||||
, _rmPmnts = []
|
||||
, _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]
|
||||
|
||||
{- 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
|
||||
,mntLightLnkCond (const True)
|
||||
]
|
||||
(fmap connectRoom . randomiseOutLinks) =<<
|
||||
changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts 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 rmPmnts plmnts corridorN))
|
||||
rcp <- roomCenterPillar
|
||||
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 rmPmnts (++ plmnts1) rcp
|
||||
]
|
||||
(connectRoom $ set rmPmnts [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 & rmPmnts %~ (++ plmnts)
|
||||
(fmap connectRoom . randomiseOutLinks) =<< filterLinks f theRoom
|
||||
where
|
||||
f (_,a) = a == 0
|
||||
|
||||
weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
|
||||
weaponLongCorridor = do
|
||||
root <- takeOne [tEast, tWest]
|
||||
connectingRoom <- takeOne
|
||||
[tEast & rmPmnts .~ [spanLightI (V2 (-40) 40) (V2 (-40) 80)]
|
||||
]
|
||||
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 rmPmnts (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
|
||||
putWp = set rmPmnts [sPS (V2 20 60) 0 $ RandPS randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)]
|
||||
|
||||
critInDeadEnd :: Room
|
||||
critInDeadEnd = set rmPmnts [sPS (V2 0 0) 0 randC1] deadEndRoom
|
||||
|
||||
deadEndRoom :: Room
|
||||
deadEndRoom = defaultRoom
|
||||
{ _rmPolys = [rectNSWE 40 (-20) (-20) 20
|
||||
]
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = []
|
||||
, _rmPmnts = [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 Room
|
||||
roomCCrits = roomC 200 200
|
||||
<&> rmPmnts %~ (replicate 20 (spNoID (PSRoomRand 0) randC1) ++ )
|
||||
|
||||
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 & rmPmnts .~ 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
|
||||
]
|
||||
|
||||
doubleCorridorBarrels :: RandomGen g => State g Room
|
||||
doubleCorridorBarrels = do
|
||||
h <- state $ randomR (200,300)
|
||||
let cond x = (sndV2 . fst) x < h - 40
|
||||
changeLinkTo cond $ roomRect 100 h 1 1 & rmPmnts .~
|
||||
[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
|
||||
]
|
||||
|
||||
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 (280,550)
|
||||
y2 <- state $ randomR (280,550)
|
||||
y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (280,560)
|
||||
x4 <- state $ randomR (60,w-60)
|
||||
y4 <- state $ randomR (40,150)
|
||||
let bln x y = putBlockN (x+25) (x-25) (y+20) (y+10)
|
||||
blv x y = putBlockV (x+25) (x-25) (y+20) (y+10)
|
||||
plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
|
||||
++ [spanLightI (V2 (-10) 200) (V2 (w/2) 200)
|
||||
,spanLightI (V2 (w/2) 200) (V2 (w+10) 200)
|
||||
]
|
||||
toPS x y = return (V2 x y,-0.5*pi)
|
||||
return $ set rmPmnts plmnts $ roomRectAutoLinks w 600
|
||||
& rmPmnts .~ plmnts
|
||||
& rmRandPSs .~ [toPS x1 y1,toPS x2 y2,toPS x3 y3]
|
||||
|
||||
shootersRoom1 :: RandomGen g => State g Room
|
||||
shootersRoom1 = shootersRoom' <&> rmPmnts %~
|
||||
( (
|
||||
RandomPlacement $ takeOne $ map (\i -> spNoID (PSRoomRand i) (PutCrit autoCrit))
|
||||
[0,1,2]
|
||||
) :)
|
||||
|
||||
shootersRoom :: RandomGen g => State g Room
|
||||
shootersRoom = shootersRoom' <&> rmPmnts %~
|
||||
( map (\i -> spNoID (PSRoomRand i) (PutCrit autoCrit))
|
||||
[0,1,2]
|
||||
++ )
|
||||
|
||||
pillarGrid :: RandomGen g => State g Room
|
||||
pillarGrid = do
|
||||
let f2 x y = singleBlock (V2 x y)
|
||||
f <- takeOne [f2]
|
||||
h <- state $ randomR (400,800)
|
||||
let w = h
|
||||
i <- takeOne [3,4,5]
|
||||
let j = fromIntegral i
|
||||
-- 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,20+1.5*(w-40)/j..]
|
||||
ys = take i [20+0.5*(h-40)/j,20+1.5*(h-40)/j..]
|
||||
gap = 0.5 * h / (j+1)
|
||||
rps = do
|
||||
x <- takeOne xs
|
||||
y <- takeOne ys
|
||||
a <- state $ randomR (0,2*pi)
|
||||
return (V2 (x+gap) y,a)
|
||||
cornerRestrict (V2 x y,_)
|
||||
= (x > 40 && x < h - 40)
|
||||
|| (y > 40 && y < h - 40)
|
||||
let plmnts = replicate 8 (mntLightLnkCond cornerRestrict)
|
||||
++
|
||||
concat [f x y | x<-xs,y<-ys]
|
||||
return $ roomRect w h (max i 2) (max i 2)
|
||||
& rmPmnts .~ plmnts
|
||||
& rmRandPSs .~ [rps]
|
||||
|
||||
-- TODO remove possible identical draws on random PSs
|
||||
pistolerRoom :: RandomGen g => State g Room
|
||||
pistolerRoom = pillarGrid
|
||||
<&> rmPmnts %~ (
|
||||
[spNoID (PSRoomRand 0) (PutCrit pistolCrit)
|
||||
,spNoID (PSRoomRand 0) (PutCrit pistolCrit)
|
||||
,spNoID (PSRoomRand 0) (PutCrit pistolCrit)
|
||||
]
|
||||
++)
|
||||
|
||||
shootingRange :: RandomGen g => State g (Tree (Either Room Room))
|
||||
shootingRange = do
|
||||
rm1 <- shootersRoom1 >>= changeLinkTo (\(V2 _ y,_) -> y < 40)
|
||||
>>= changeLinkFrom (\(V2 _ y,r) -> y > 200 && r /= 0)
|
||||
rm2 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
|
||||
>>= changeLinkFrom (\(V2 _ y,r) -> y > 200 && r /= 0)
|
||||
rm3 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
|
||||
>>= changeLinkFrom (\(_,r) -> r == 0)
|
||||
return $ treeFromPost
|
||||
[Left rm1
|
||||
,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
|
||||
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
|
||||
,Left rm2
|
||||
,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
|
||||
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
|
||||
]
|
||||
(Right rm3)
|
||||
|
||||
spawnerRoom :: RandomGen g => State g (Tree (Either Room Room))
|
||||
spawnerRoom = do
|
||||
x <- state $ randomR (250,300)
|
||||
y <- state $ randomR (300,400)
|
||||
roomWithSpawner <- roomC x y <&>
|
||||
rmPmnts %~ (spNoID (PSRoomRand 0) (PutCrit spawnerCrit) :)
|
||||
aRoom <- airlock
|
||||
return $ treeFromTrunk [Left aRoom,Left corridor] $ connectRoom roomWithSpawner
|
||||
|
||||
@@ -0,0 +1,489 @@
|
||||
module Dodge.Room.Room where
|
||||
import Dodge.Default.Room
|
||||
import Dodge.Item.Weapon.BulletGuns
|
||||
import Dodge.Item.Weapon.Launcher
|
||||
import Dodge.Creature
|
||||
import Dodge.Room.Foreground
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.RandomHelp
|
||||
import Dodge.Default.Wall
|
||||
import Dodge.Layout.Tree.Polymorphic
|
||||
import Dodge.Layout.Tree.Either
|
||||
import Dodge.Placements
|
||||
import Dodge.Room.Data
|
||||
import Dodge.Room.Procedural
|
||||
import Dodge.Room.Corridor
|
||||
import Dodge.Room.Link
|
||||
import Dodge.Room.Door
|
||||
import Dodge.Room.Airlock
|
||||
import Dodge.Room.LongDoor
|
||||
import Geometry
|
||||
import Picture
|
||||
import Tile
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Loops
|
||||
import System.Random
|
||||
import Data.Tree
|
||||
import Data.Bifunctor
|
||||
|
||||
roomC :: RandomGen g => Float -> Float -> State g Room
|
||||
roomC w h = do
|
||||
wl <- takeOne
|
||||
[ sPS (V2 0 0) 0 $ PutWall (rectNSWE (h-60) 0 (w/2-10) (w/2+10)) defaultCrystalWall
|
||||
, windowLine (V2 (w/2) 0) (V2 (w/2) (h-60))
|
||||
]
|
||||
changeLinkFrom fromCond $ roomRectAutoLinks w h
|
||||
& rmPmnts %~ (wl : )
|
||||
& rmRandPSs .~ [farside]
|
||||
where
|
||||
fromCond (V2 x _,_) = x < w / 2 - 10
|
||||
farside = do
|
||||
x <- state $ randomR (5, w/2 - 20)
|
||||
y <- state $ randomR (5, h - 70)
|
||||
a <- state $ randomR (0, 2*pi)
|
||||
return (V2 x y,a)
|
||||
|
||||
roomPadCut :: [Point2] -> Point2 -> Room
|
||||
roomPadCut ps p = defaultRoom
|
||||
{ _rmPolys = [ps]
|
||||
, _rmLinks = [(p,0),(V2 0 0,pi)]
|
||||
, _rmPath = [(V2 0 0,p)]
|
||||
}
|
||||
roomPillars :: Room
|
||||
roomPillars = over rmLinks init $ set rmPmnts plmnts $ roomRect 240 240 2 2
|
||||
where
|
||||
plmnts = spanLightI (V2 120 24) (V2 120 216)
|
||||
: mountLightV (V2 12 12) (V3 25 25 70)
|
||||
: mountLightV (V2 228 228) (V3 215 215 70)
|
||||
: sps0 (PutForeground $ thinHighBar 75 (V2 26 25) (V2 120 25))
|
||||
: sps0 (PutForeground $ thinHighBar 75 (V2 214 215) (V2 120 215))
|
||||
: 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
|
||||
|
||||
|
||||
manyDoors :: Int -> Tree (Either Room Room)
|
||||
manyDoors i = treeFromPost (replicate i (Left door)) $ Right door
|
||||
|
||||
-- TODO: partially combine a room tree into a room
|
||||
glassLesson :: RandomGen g => State g (Tree (Either Room Room))
|
||||
glassLesson = do
|
||||
i <- takeOne [1,2,3]
|
||||
corridors <- replicateM i $ 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 rmPmnts botplmnts $ roomRect 200 200 1 1
|
||||
topRoom = set rmPmnts 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
|
||||
,RandomPlacement $ takeOne
|
||||
[ spanLightI (V2 160 0) (V2 160 220)
|
||||
, mountLightV (V2 180 200) (V3 160 180 50)
|
||||
]
|
||||
]
|
||||
topplmnts =
|
||||
[windowLine (V2 100 200) (V2 100 0)
|
||||
,sPS (V2 50 100) 0 $ PutCrit miniGunCrit
|
||||
--,sPS (V2 50 50) 0 putLamp
|
||||
,RandomPlacement $ takeOne
|
||||
[ spanLightI (V2 160 (-20)) (V2 160 220)
|
||||
, mountLightV (V2 180 200) (V3 160 180 50)
|
||||
]
|
||||
]
|
||||
|
||||
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
|
||||
con1 (V2 _ y,_) = y < 0.5*hgt
|
||||
plmnts =
|
||||
[ mntLightLnkCond con1
|
||||
, mntLightLnkCond (not . con1)
|
||||
,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
|
||||
]
|
||||
let northPSs = do
|
||||
cry <- randomRanges [3*hf+10,4*hf-10
|
||||
,4*hf+10,5*hf-10
|
||||
]
|
||||
crx <- state $ randomR (wllen,wth-(wllen+40))
|
||||
return (V2 crx cry,1.5*pi)
|
||||
midPS = return (V2 (wth-20) (hgt/2+40), pi)
|
||||
return $ roomRect wth hgt 2 4
|
||||
& rmPmnts .~ plmnts
|
||||
& rmRandPSs .~ [northPSs,midPS]
|
||||
|
||||
glassSwitchBackCrits :: RandomGen g => State g Room
|
||||
glassSwitchBackCrits = glassSwitchBack
|
||||
<&> rmPmnts %~ ([spNoID (PSRoomRand 0) (PutCrit miniGunCrit)
|
||||
, spNoID (PSRoomRand 1) randC1
|
||||
] ++)
|
||||
|
||||
miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
|
||||
miniTree2 = glassSwitchBackCrits
|
||||
>>= 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 rmPmnts 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 rmPmnts 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
|
||||
, mntLightLnkCond (const True)
|
||||
, mntLightLnkCond (const True)
|
||||
]
|
||||
|
||||
roomOctogon :: Room
|
||||
roomOctogon = defaultRoom
|
||||
{ _rmPolys = [poly ]
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = allPairs $ map fst lnks -- this is too much
|
||||
, _rmPmnts = []
|
||||
, _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]
|
||||
|
||||
{- 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
|
||||
,mntLightLnkCond (const True)
|
||||
]
|
||||
(fmap connectRoom . randomiseOutLinks) =<<
|
||||
changeLinkTo ((\p -> dist p (V2 (w/2) 0) < 10) . fst) (set rmPmnts 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 rmPmnts plmnts corridorN))
|
||||
rcp <- roomCenterPillar
|
||||
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 rmPmnts (++ plmnts1) rcp
|
||||
]
|
||||
(connectRoom $ set rmPmnts [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 & rmPmnts %~ (++ plmnts)
|
||||
(fmap connectRoom . randomiseOutLinks) =<< filterLinks f theRoom
|
||||
where
|
||||
f (_,a) = a == 0
|
||||
|
||||
weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
|
||||
weaponLongCorridor = do
|
||||
root <- takeOne [tEast, tWest]
|
||||
connectingRoom <- takeOne
|
||||
[tEast & rmPmnts .~ [spanLightI (V2 (-40) 40) (V2 (-40) 80)]
|
||||
]
|
||||
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 rmPmnts (++ [sPS (V2 10 40) (-pi/2) randC1 ,sPS (V2 (-10) 40) (-pi/2) randC1 ])
|
||||
putWp = set rmPmnts [sPS (V2 20 60) 0 $ RandPS randFirstWeapon ,spanLightI (V2 0 40) (V2 40 40)]
|
||||
|
||||
critInDeadEnd :: Room
|
||||
critInDeadEnd = set rmPmnts [sPS (V2 0 0) 0 randC1] deadEndRoom
|
||||
|
||||
deadEndRoom :: Room
|
||||
deadEndRoom = defaultRoom
|
||||
{ _rmPolys = [rectNSWE 40 (-20) (-20) 20
|
||||
]
|
||||
, _rmLinks = lnks
|
||||
, _rmPath = []
|
||||
, _rmPmnts = [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 Room
|
||||
roomCCrits = roomC 200 200
|
||||
<&> rmPmnts %~ (replicate 20 (spNoID (PSRoomRand 0) randC1) ++ )
|
||||
|
||||
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 & rmPmnts .~ 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
|
||||
]
|
||||
|
||||
doubleCorridorBarrels :: RandomGen g => State g Room
|
||||
doubleCorridorBarrels = do
|
||||
h <- state $ randomR (200,300)
|
||||
let cond x = (sndV2 . fst) x < h - 40
|
||||
changeLinkTo cond $ roomRect 100 h 1 1 & rmPmnts .~
|
||||
[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
|
||||
]
|
||||
|
||||
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 (280,550)
|
||||
y2 <- state $ randomR (280,550)
|
||||
y3 <- iterateWhile (\y' -> abs (y1 - y2) < 60 && abs (y2 - y') < 60) $ state $ randomR (280,560)
|
||||
x4 <- state $ randomR (60,w-60)
|
||||
y4 <- state $ randomR (40,150)
|
||||
let bln x y = putBlockN (x+25) (x-25) (y+20) (y+10)
|
||||
blv x y = putBlockV (x+25) (x-25) (y+20) (y+10)
|
||||
plmnts = bln x1 y1 ++ bln x2 y2 ++ bln x3 y3 ++ blv x4 y4
|
||||
++ [spanLightI (V2 (-10) 200) (V2 (w/2) 200)
|
||||
,spanLightI (V2 (w/2) 200) (V2 (w+10) 200)
|
||||
]
|
||||
toPS x y = return (V2 x y,-0.5*pi)
|
||||
return $ set rmPmnts plmnts $ roomRectAutoLinks w 600
|
||||
& rmPmnts .~ plmnts
|
||||
& rmRandPSs .~ [toPS x1 y1,toPS x2 y2,toPS x3 y3]
|
||||
|
||||
shootersRoom1 :: RandomGen g => State g Room
|
||||
shootersRoom1 = shootersRoom' <&> rmPmnts %~
|
||||
( (
|
||||
RandomPlacement $ takeOne $ map (\i -> spNoID (PSRoomRand i) (PutCrit autoCrit))
|
||||
[0,1,2]
|
||||
) :)
|
||||
|
||||
shootersRoom :: RandomGen g => State g Room
|
||||
shootersRoom = shootersRoom' <&> rmPmnts %~
|
||||
( map (\i -> spNoID (PSRoomRand i) (PutCrit autoCrit))
|
||||
[0,1,2]
|
||||
++ )
|
||||
|
||||
pillarGrid :: RandomGen g => State g Room
|
||||
pillarGrid = do
|
||||
let f2 x y = singleBlock (V2 x y)
|
||||
f <- takeOne [f2]
|
||||
h <- state $ randomR (400,800)
|
||||
let w = h
|
||||
i <- takeOne [3,4,5]
|
||||
let j = fromIntegral i
|
||||
-- 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,20+1.5*(w-40)/j..]
|
||||
ys = take i [20+0.5*(h-40)/j,20+1.5*(h-40)/j..]
|
||||
gap = 0.5 * h / (j+1)
|
||||
rps = do
|
||||
x <- takeOne xs
|
||||
y <- takeOne ys
|
||||
a <- state $ randomR (0,2*pi)
|
||||
return (V2 (x+gap) y,a)
|
||||
cornerRestrict (V2 x y,_)
|
||||
= (x > 40 && x < h - 40)
|
||||
|| (y > 40 && y < h - 40)
|
||||
let plmnts = replicate 8 (mntLightLnkCond cornerRestrict)
|
||||
++
|
||||
concat [f x y | x<-xs,y<-ys]
|
||||
return $ roomRect w h (max i 2) (max i 2)
|
||||
& rmPmnts .~ plmnts
|
||||
& rmRandPSs .~ [rps]
|
||||
|
||||
-- TODO remove possible identical draws on random PSs
|
||||
pistolerRoom :: RandomGen g => State g Room
|
||||
pistolerRoom = pillarGrid
|
||||
<&> rmPmnts %~ (
|
||||
[spNoID (PSRoomRand 0) (PutCrit pistolCrit)
|
||||
,spNoID (PSRoomRand 0) (PutCrit pistolCrit)
|
||||
,spNoID (PSRoomRand 0) (PutCrit pistolCrit)
|
||||
]
|
||||
++)
|
||||
|
||||
shootingRange :: RandomGen g => State g (Tree (Either Room Room))
|
||||
shootingRange = do
|
||||
rm1 <- shootersRoom1 >>= changeLinkTo (\(V2 _ y,_) -> y < 40)
|
||||
>>= changeLinkFrom (\(V2 _ y,r) -> y > 200 && r /= 0)
|
||||
rm2 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
|
||||
>>= changeLinkFrom (\(V2 _ y,r) -> y > 200 && r /= 0)
|
||||
rm3 <- shootersRoom >>= changeLinkTo (\(V2 x y,_) -> y < 10 && x > 20 && x < 180)
|
||||
>>= changeLinkFrom (\(_,r) -> r == 0)
|
||||
return $ treeFromPost
|
||||
[Left rm1
|
||||
,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
|
||||
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
|
||||
,Left rm2
|
||||
,Left $ roomPadCut (rectNSWE 40 (-40) (-80) 80) (V2 0 20)
|
||||
& rmPmnts %~ (spanLightI (V2 (-80) 10) (V2 80 10) :)
|
||||
]
|
||||
(Right rm3)
|
||||
|
||||
spawnerRoom :: RandomGen g => State g (Tree (Either Room Room))
|
||||
spawnerRoom = do
|
||||
x <- state $ randomR (250,300)
|
||||
y <- state $ randomR (300,400)
|
||||
roomWithSpawner <- roomC x y <&>
|
||||
rmPmnts %~ (spNoID (PSRoomRand 0) (PutCrit spawnerCrit) :)
|
||||
aRoom <- airlock
|
||||
return $ treeFromTrunk [Left aRoom,Left corridor] $ connectRoom roomWithSpawner
|
||||
Reference in New Issue
Block a user