Add dungeon level generation

Add a dungeon level generator, which:

1. generates an infinite sequence of rectangular rooms within the
   dimensions of the level
2. removes any duplicates from that sequence
3. Generates a graph from the delaunay triangulation of the centerpoints
   of those rooms
4. Generates the minimum-spanning-tree of that delaunay triangulation,
   with weights given by line length in points
5. Adds back a subset (default 10-15%) of edges from the delaunay
   triangulation to the graph
6. Uses the resulting graph to draw corridors between the rooms, using a
   random point on the near edge of each room to pick the points of the
   corridors
This commit is contained in:
Griffin Smith 2019-12-30 11:31:56 -05:00
parent 6f427fe4d6
commit e76567b9e7
20 changed files with 680 additions and 103 deletions

View file

@ -8,17 +8,19 @@ module Xanthous.Random
, Weighted(..)
, evenlyWeighted
, weightedBy
, subRand
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
--------------------------------------------------------------------------------
import Data.List.NonEmpty (NonEmpty)
import Control.Monad.Random.Class (MonadRandom(getRandomR, getRandom))
import Data.Random.Shuffle.Weighted
import Data.Random.Distribution
import Data.Random.Distribution.Uniform
import Data.Random.Distribution.Uniform.Exclusive
import Data.Random.Sample
import Data.List.NonEmpty (NonEmpty(..))
import Control.Monad.Random.Class (MonadRandom(getRandomR, getRandom))
import Control.Monad.Random (Rand, evalRand, mkStdGen, StdGen)
import Data.Random.Shuffle.Weighted
import Data.Random.Distribution
import Data.Random.Distribution.Uniform
import Data.Random.Distribution.Uniform.Exclusive
import Data.Random.Sample
import qualified Data.Random.Source as DRS
--------------------------------------------------------------------------------
@ -58,6 +60,10 @@ instance Choose (NonEmpty a) where
type RandomResult (NonEmpty a) = a
choose = choose . fromNonEmpty @[_]
instance Choose (a, a) where
type RandomResult (a, a) = a
choose (x, y) = choose (x :| [y])
newtype Weighted w t a = Weighted (t (w, a))
evenlyWeighted :: [a] -> Weighted Int [] a
@ -76,3 +82,6 @@ instance (Num w, Ord w, Distribution Uniform w, Excludable w) => Choose (Weighte
sample
$ fromMaybe (error "unreachable") . headMay
<$> weightedSample 1 (toList ws)
subRand :: MonadRandom m => Rand StdGen a -> m a
subRand sub = evalRand sub . mkStdGen <$> getRandom