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

Random tree structure generation of rooms

Browse Source
This commit is contained in:
justin
2021-04-20 02:01:24 +02:00
parent 38d67520cc
commit b911a013e0
14 changed files with 407 additions and 235 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room.hs
+10 -70
View File
@@ -2,7 +2,9 @@
Specification of individual rooms.
-}
module Dodge.Room
where
( module Dodge.Room
, module Dodge.Room.Corridor
) where
import Dodge.Data
import Dodge.Item.Weapon
import Dodge.Creature
@@ -21,6 +23,8 @@ import Dodge.SoundLogic
import Dodge.Room.Data
import Dodge.Room.Placement
import Dodge.Room.Procedural
import Dodge.Room.Corridor
import Dodge.Room.Link
import Geometry
import Picture
@@ -79,63 +83,6 @@ airlock n = Room
]
cond w = or $ M.lookup (DoorNumOpen n) (_worldState w)
col = dim $ dim $ bright red
corridor :: Room
corridor = Room
{ _rmPolys = [rectNSWE 80 0 0 40
,[(0,80), (0,80) +.+ rotateV (pi/3) (40,0),(40,80)]
,[(40,0), (0,0) +.+ rotateV (0-pi/3) (40,0),( 0, 0)]
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (20,60)) $ map fst lnks
, _rmPS = []
, _rmBound = rectNSWE 50 30 0 40
}
where lnks = [((20,70) ,0)
,((20,80) +.+ rotateV (0-pi/3) (-10,0), pi/6)
,((20,80) +.+ rotateV ( pi/3) ( 10,0),0-pi/6)
,((20,10) ,pi)
]
corridorN :: Room
corridorN = Room
{ _rmPolys = [rectNSWE 80 0 0 40
]
, _rmLinks = lnks
, _rmPath = pth
, _rmPS = []
, _rmBound = rectNSWE 50 30 0 40
}
where lnks = [((20,70) ,0)
,((20,10) ,pi)
]
pth = doublePair ((20,70),(20,10))
tEast :: Room
tEast = Room
{ _rmPolys = [rectNSWE 80 0 (-20) (20)
,rectNSWE 80 40 (-40) 40
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (0,60)) $ map fst lnks
, _rmPS = []
, _rmBound = rectNSWE 70 10 0 40
}
where lnks = [(( 30,60),-pi/2)
,((-30,60),pi/2)
,((0,10),pi)
]
tWest :: Room
tWest = Room
{ _rmPolys = [rectNSWE 80 0 (-20) (20)
,rectNSWE 80 40 (-40) 40
]
, _rmLinks = lnks
, _rmPath = concatMap (doublePair . (,) (0,60)) $ map fst lnks
, _rmPS = []
, _rmBound = rectNSWE 70 10 0 40
}
where lnks = [((-30,60),pi/2)
,(( 30,60),-pi/2)
,((0,10),pi)
]
roomC :: Float -> Float -> Room
roomC x y = Room
{ _rmPolys = [rectNSWE y 0 0 x]
@@ -143,7 +90,6 @@ roomC x y = Room
, _rmPath = []
, _rmPS = [windowLine (x/2,0) (x/2,y-60)
]
--, _rmBound = rectNSWE y 0 0 x
, _rmBound = rectNSWE (y+5) (-5) (-5) (x+5)
}
where
@@ -161,12 +107,6 @@ roomPadCut ps p = Room
, _rmPS = []
, _rmBound = []
}
door :: Room
door = Room
{ _rmPolys = [rectNSWE 40 0 0 40]
@@ -305,7 +245,7 @@ miniRoom3 = do
,PS cp (pi/8+7*pi/4) b
,PS (w/2,h/2) 0 putLamp
]
randomiseLinks $ set rmPS plmnts $ roomRectAutoLinks w h
fmap connectRoom $ randLinks $ set rmPS plmnts $ roomRectAutoLinks w h
rot90Around :: Point2 -> Point2 -> Point2
rot90Around cen p = cen +.+ vNormal (p -.- cen)
@@ -318,7 +258,7 @@ roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treePost
,join $ takeOne [miniTree2,glassLesson]
-- ,join $ takeOne [miniRoom1]
]
$ randomiseLinks corridor
$ fmap connectRoom $ randLinks 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) []
@@ -392,7 +332,7 @@ weaponEmptyRoom = do
,PS (w-20,20) (pi/2) $ randC1
,PS (w/2,h/2) 0 $ putLamp
]
randomiseLinks =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst)
(fmap connectRoom . randLinks) =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst)
$ set rmPS plmnts $ roomRect' w h 2 2)
@@ -437,7 +377,7 @@ weaponBetweenPillars = do
,PS crPos1 (d crPos1) $ randC1
,PS crPos2 (d crPos2) $ randC1
]
randomiseLinks =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars)
(fmap connectRoom . randLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars)
where f (_,a) = a == 0
blockedCorridor :: RandomGen g => State g (Tree (Either Room Room))
@@ -708,5 +648,5 @@ spawnerRoom = do
,PS (x/2, y-10) 0 putLamp
]
let f ((lx,_),_) = lx < x/2-5
roomWithSpawner <- randomiseLinks =<< (filterLinks f $ set rmPS plmnts $ roomRect' x y 2 2)
roomWithSpawner <- (fmap connectRoom . randLinks) =<< (filterLinks f $ set rmPS plmnts $ roomRect' x y 2 2)
return $ treeTrunk [Left (airlock 0)] roomWithSpawner