From e76567b9e776070812838828d8de8220c2a461e7 Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Mon, 30 Dec 2019 11:31:56 -0500
Subject: 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
---
 src/Xanthous/Orphans.hs | 33 ++++++++++++---------------------
 1 file changed, 12 insertions(+), 21 deletions(-)

(limited to 'src/Xanthous/Orphans.hs')

diff --git a/src/Xanthous/Orphans.hs b/src/Xanthous/Orphans.hs
index 6a860e1c49f1..b7a4a3212629 100644
--- a/src/Xanthous/Orphans.hs
+++ b/src/Xanthous/Orphans.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE UndecidableInstances, PatternSynonyms #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PackageImports #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 --------------------------------------------------------------------------------
 module Xanthous.Orphans
@@ -13,21 +15,23 @@ import           Xanthous.Prelude hiding (elements, (.=))
 import           Data.Aeson
 import           Data.Aeson.Types (typeMismatch)
 import           Data.List.NonEmpty (NonEmpty(..))
-import qualified Data.List.NonEmpty as NonEmpty
-import           Data.Text.Arbitrary ()
 import           Graphics.Vty.Attributes
 import           Brick.Widgets.Edit
 import           Data.Text.Zipper.Generic (GenericTextZipper)
 import           Brick.Widgets.Core (getName)
 import           System.Random (StdGen)
 import           Test.QuickCheck
+import           "quickcheck-instances" Test.QuickCheck.Instances ()
 import           Text.Megaparsec (errorBundlePretty)
 import           Text.Megaparsec.Pos
 import           Text.Mustache
 import           Text.Mustache.Type ( showKey )
 import           Control.Monad.State
+import           Linear
 --------------------------------------------------------------------------------
 import           Xanthous.Util.JSON
+import           Xanthous.Util.QuickCheck
+--------------------------------------------------------------------------------
 
 instance forall s a.
   ( Cons s s a a
@@ -130,18 +134,6 @@ instance Function Template where
       parseTemplatePartial txt
         = compileMustacheText "template" txt ^?! _Right
 
-instance Arbitrary a => Arbitrary (NonEmpty a) where
-  arbitrary = do
-    x <- arbitrary
-    xs <- arbitrary
-    pure $ x :| xs
-
-instance CoArbitrary a => CoArbitrary (NonEmpty a) where
-  coarbitrary = coarbitrary . toList
-
-instance Function a => Function (NonEmpty a) where
-  function = functionMap toList NonEmpty.fromList
-
 ppNode :: Map PName [Node] -> Node -> Text
 ppNode _ (TextBlock txt) = txt
 ppNode _ (EscapedVar k) = "{{" <> showKey k <> "}}"
@@ -169,12 +161,6 @@ instance FromJSON Template where
     $ either (fail . errorBundlePretty) pure
     . compileMustacheText "template"
 
-instance CoArbitrary Text where
-  coarbitrary = coarbitrary . unpack
-
-instance Function Text where
-  function = functionMap unpack pack
-
 deriving anyclass instance NFData Node
 deriving anyclass instance NFData Template
 
@@ -353,3 +339,8 @@ instance CoArbitrary StdGen where
 deriving newtype instance (Arbitrary s, CoArbitrary (m (a, s)))
             => CoArbitrary (StateT s m a)
 
+--------------------------------------------------------------------------------
+
+deriving via (GenericArbitrary (V2 a)) instance Arbitrary a => Arbitrary (V2 a)
+instance CoArbitrary a => CoArbitrary (V2 a)
+instance Function a => Function (V2 a)
-- 
cgit 1.4.1