diff options
author | Griffin Smith <root@gws.fyi> | 2019-12-30T16·31-0500 |
---|---|---|
committer | Griffin Smith <root@gws.fyi> | 2019-12-30T16·31-0500 |
commit | e76567b9e776070812838828d8de8220c2a461e7 (patch) | |
tree | 40a801de9684b39a3258f4f33f121b14dd407a64 /src/Xanthous/Random.hs | |
parent | 6f427fe4d6ba9a03f122d15839298040a7cfb925 (diff) |
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
Diffstat (limited to 'src/Xanthous/Random.hs')
-rw-r--r-- | src/Xanthous/Random.hs | 23 |
1 files changed, 16 insertions, 7 deletions
diff --git a/src/Xanthous/Random.hs b/src/Xanthous/Random.hs index bbf176f71d6e..3cb0b068d3d7 100644 --- a/src/Xanthous/Random.hs +++ b/src/Xanthous/Random.hs @@ -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 |