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 /test/Xanthous/Util/GraphSpec.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 'test/Xanthous/Util/GraphSpec.hs')
-rw-r--r-- | test/Xanthous/Util/GraphSpec.hs | 39 |
1 files changed, 39 insertions, 0 deletions
diff --git a/test/Xanthous/Util/GraphSpec.hs b/test/Xanthous/Util/GraphSpec.hs new file mode 100644 index 000000000000..35ff090b28b9 --- /dev/null +++ b/test/Xanthous/Util/GraphSpec.hs @@ -0,0 +1,39 @@ +module Xanthous.Util.GraphSpec (main, test) where +-------------------------------------------------------------------------------- +import Test.Prelude +-------------------------------------------------------------------------------- +import Xanthous.Util.Graph +import Data.Graph.Inductive.Basic +import Data.Graph.Inductive.Graph (labNodes, size, order) +import Data.Graph.Inductive.PatriciaTree +import Data.Graph.Inductive.Arbitrary +-------------------------------------------------------------------------------- + +main :: IO () +main = defaultMain test + +test :: TestTree +test = testGroup "Xanthous.Util.Graph" + [ testGroup "mstSubGraph" + [ testProperty "always produces a subgraph" + $ \(CG _ (graph :: Gr Int Int)) -> + let msg = mstSubGraph $ undir graph + in counterexample (show msg) + $ msg `isSubGraphOf` undir graph + , testProperty "returns a graph with the same nodes" + $ \(CG _ (graph :: Gr Int Int)) -> + let msg = mstSubGraph graph + in counterexample (show msg) + $ labNodes msg === labNodes graph + , testProperty "has nodes - 1 edges" + $ \(CG _ (graph :: Gr Int Int)) -> + order graph > 1 ==> + let msg = mstSubGraph graph + in counterexample (show msg) + $ size msg === order graph - 1 + , testProperty "always produces a simple graph" + $ \(CG _ (graph :: Gr Int Int)) -> + let msg = mstSubGraph graph + in counterexample (show msg) $ isSimple msg + ] + ] |