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

1 files changed, 32 insertions, 4 deletions

diff --git a/src/Xanthous/Util/Graphics.hs b/src/Xanthous/Util/Graphics.hs
index e8269e72d6c8..bd6a0906a6d5 100644
--- a/src/Xanthous/Util/Graphics.hs
+++ b/src/Xanthous/Util/Graphics.hs
@@ -4,16 +4,26 @@ module Xanthous.Util.Graphics
   ( circle
   , filledCircle
   , line
+  , straightLine
+  , delaunay
   ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude
+--------------------------------------------------------------------------------
+import qualified Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer
+              as Geometry
+import qualified Algorithms.Geometry.DelaunayTriangulation.Types as Geometry
+import           Codec.Picture (imagePixels)
+import qualified Data.Geometry.Point as Geometry
+import           Data.Ext ((:+)(..))
 import           Data.List (unfoldr)
+import           Data.List.NonEmpty (NonEmpty)
 import           Data.Ix (range, Ix)
 import           Data.Word (Word8)
 import qualified Graphics.Rasterific as Raster
-import           Graphics.Rasterific hiding (circle, line)
+import           Graphics.Rasterific hiding (circle, line, V2(..))
 import           Graphics.Rasterific.Texture (uniformTexture)
-import           Codec.Picture (imagePixels)
+import           Linear.V2
 --------------------------------------------------------------------------------
 
 
@@ -24,7 +34,7 @@ circle :: (Num i, Integral i, Ix i)
 circle (ox, oy) radius
   = pointsFromRaster (ox + radius) (oy + radius)
   $ stroke 1 JoinRound (CapRound, CapRound)
-  $ Raster.circle (V2 (fromIntegral ox) (fromIntegral oy))
+  $ Raster.circle (Raster.V2 (fromIntegral ox) (fromIntegral oy))
   $ fromIntegral radius
 
 filledCircle :: (Num i, Integral i, Ix i)
@@ -34,7 +44,7 @@ filledCircle :: (Num i, Integral i, Ix i)
 filledCircle (ox, oy) radius
   = pointsFromRaster (ox + radius) (oy + radius)
   $ fill
-  $ Raster.circle (V2 (fromIntegral ox) (fromIntegral oy))
+  $ Raster.circle (Raster.V2 (fromIntegral ox) (fromIntegral oy))
   $ fromIntegral radius
 
 -- showCells . fromPoints . NE.fromList $ filledCircle (15, 15) 7
@@ -83,3 +93,21 @@ line pa@(xa, ya) pb@(xb, yb)
         (newY, newError) = if (2 * tempError) >= δx
                            then (yTemp + ystep, tempError - δx)
                            else (yTemp, tempError)
+
+straightLine :: (Num i, Ord i) => (i, i) -> (i, i) -> [(i, i)]
+straightLine pa@(xa, _) pb@(_, yb) = line pa midpoint ++ line midpoint pb
+  where midpoint = (xa, yb)
+
+
+delaunay
+  :: (Ord n, Fractional n)
+  => NonEmpty (V2 n, p)
+  -> [((V2 n, p), (V2 n, p))]
+delaunay
+  = map (over both fromPoint)
+  . Geometry.triangulationEdges
+  . Geometry.delaunayTriangulation
+  . map toPoint
+  where
+    toPoint (V2 px py, pid) = Geometry.Point2 px py :+ pid
+    fromPoint (Geometry.Point2 px py :+ pid) = (V2 px py, pid)