From 22b7a9be84b26d3c40d065fc0d699ad1ebcadb3c Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Mon, 17 Feb 2020 18:01:57 -0500
Subject: Drop Rasterific for non-filled circles

Rasterific appears to generate some pretty surprising, if  not
completely wrong, circles at especially low sizes - this was resulting
in unexpected behavior with vision calculation, including the character
never being able to see directly to the left of them, among other
things. This moves back to the old midpoint circle algorithm I pulled
off of rosetta code, but only for the non-filled circle. The filled
circle is still using the wonky algorithm for now, but at some point I'd
love to refactor it such that empty circles are eg always a subset of
non-filled circles.
---
 src/Xanthous/Data.hs | 23 ++++++++++++++++-------
 1 file changed, 16 insertions(+), 7 deletions(-)

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

diff --git a/src/Xanthous/Data.hs b/src/Xanthous/Data.hs
index 1874b45e9047..2cfb8204d58c 100644
--- a/src/Xanthous/Data.hs
+++ b/src/Xanthous/Data.hs
@@ -68,6 +68,7 @@ module Xanthous.Data
   , move
   , asPosition
   , directionOf
+  , Cardinal(..)
 
     -- *
   , Corner(..)
@@ -86,12 +87,12 @@ module Xanthous.Data
   , Hitpoints(..)
   ) where
 --------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (Left, Down, Right, (.=))
+import           Xanthous.Prelude hiding (Left, Down, Right, (.=), elements)
 --------------------------------------------------------------------------------
 import           Linear.V2 hiding (_x, _y)
 import qualified Linear.V2 as L
 import           Linear.V4 hiding (_x, _y)
-import           Test.QuickCheck (Arbitrary, CoArbitrary, Function)
+import           Test.QuickCheck (Arbitrary, CoArbitrary, Function, elements)
 import           Test.QuickCheck.Arbitrary.Generic
 import           Data.Group
 import           Brick (Location(Location), Edges(..))
@@ -267,11 +268,9 @@ data Direction where
   DownLeft  :: Direction
   DownRight :: Direction
   Here      :: Direction
-  deriving stock (Show, Eq, Generic)
-
-instance Arbitrary Direction where
-  arbitrary = genericArbitrary
-  shrink = genericShrink
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (CoArbitrary, Function, NFData)
+  deriving Arbitrary via GenericArbitrary Direction
 
 instance Opposite Direction where
   opposite Up        = Down
@@ -330,6 +329,16 @@ stepTowards (view _Position -> p₁) (view _Position -> p₂)
     let (_:p:_) = line p₁ p₂
     in _Position # p
 
+-- | Newtype controlling arbitrary generation to only include cardinal
+-- directions ('Up', 'Down', 'Left', 'Right')
+newtype Cardinal = Cardinal { getCardinal :: Direction }
+  deriving stock (Eq, Show, Ord, Generic)
+  deriving anyclass (NFData, Function, CoArbitrary)
+  deriving newtype (Opposite)
+
+instance Arbitrary Cardinal where
+  arbitrary = Cardinal <$> elements [Up, Down, Left, Right]
+
 --------------------------------------------------------------------------------
 
 data Corner
-- 
cgit 1.4.1