about summary refs log tree commit diff
path: root/src/Xanthous/Util/Graphics.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/Util/Graphics.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/Util/Graphics.hs')
-rw-r--r--src/Xanthous/Util/Graphics.hs36
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)