about summary refs log tree commit diff
path: root/src/Xanthous/Random.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-12-30T16·31-0500
committerGriffin Smith <root@gws.fyi>2019-12-30T16·31-0500
commite76567b9e776070812838828d8de8220c2a461e7 (patch)
tree40a801de9684b39a3258f4f33f121b14dd407a64 /src/Xanthous/Random.hs
parent6f427fe4d6ba9a03f122d15839298040a7cfb925 (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.hs23
1 files changed, 16 insertions, 7 deletions
diff --git a/src/Xanthous/Random.hs b/src/Xanthous/Random.hs
index bbf176f71d..3cb0b068d3 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