module Geometry.Tile.Neighbors
  ( Neighbors(..)
  , nobody
  , everyone

  , bitsNW
  , testBitsNW
  , fromBitsNW
  , toBitsNW

  , directionsWith
  , isCorner
  , names
  ) where

import RIO

import Data.Bits
import Resource.Collection (Generic1, Generically1(..), enumerate)

nobody :: Neighbors Bool
nobody :: Neighbors Bool
nobody = Bool -> Neighbors Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

everyone :: Neighbors Bool
everyone :: Neighbors Bool
everyone = Bool -> Neighbors Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

data Neighbors a = Neighbors
  { forall a. Neighbors a -> a
northWest :: a
  , forall a. Neighbors a -> a
north     :: a
  , forall a. Neighbors a -> a
northEast :: a
  , forall a. Neighbors a -> a
east      :: a
  , forall a. Neighbors a -> a
southEast :: a
  , forall a. Neighbors a -> a
south     :: a
  , forall a. Neighbors a -> a
southWest :: a
  , forall a. Neighbors a -> a
west      :: a
  }
  deriving stock (Neighbors a -> Neighbors a -> Bool
(Neighbors a -> Neighbors a -> Bool)
-> (Neighbors a -> Neighbors a -> Bool) -> Eq (Neighbors a)
forall a. Eq a => Neighbors a -> Neighbors a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Neighbors a -> Neighbors a -> Bool
$c/= :: forall a. Eq a => Neighbors a -> Neighbors a -> Bool
== :: Neighbors a -> Neighbors a -> Bool
$c== :: forall a. Eq a => Neighbors a -> Neighbors a -> Bool
Eq, Eq (Neighbors a)
Eq (Neighbors a)
-> (Neighbors a -> Neighbors a -> Ordering)
-> (Neighbors a -> Neighbors a -> Bool)
-> (Neighbors a -> Neighbors a -> Bool)
-> (Neighbors a -> Neighbors a -> Bool)
-> (Neighbors a -> Neighbors a -> Bool)
-> (Neighbors a -> Neighbors a -> Neighbors a)
-> (Neighbors a -> Neighbors a -> Neighbors a)
-> Ord (Neighbors a)
Neighbors a -> Neighbors a -> Bool
Neighbors a -> Neighbors a -> Ordering
Neighbors a -> Neighbors a -> Neighbors a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Neighbors a)
forall a. Ord a => Neighbors a -> Neighbors a -> Bool
forall a. Ord a => Neighbors a -> Neighbors a -> Ordering
forall a. Ord a => Neighbors a -> Neighbors a -> Neighbors a
min :: Neighbors a -> Neighbors a -> Neighbors a
$cmin :: forall a. Ord a => Neighbors a -> Neighbors a -> Neighbors a
max :: Neighbors a -> Neighbors a -> Neighbors a
$cmax :: forall a. Ord a => Neighbors a -> Neighbors a -> Neighbors a
>= :: Neighbors a -> Neighbors a -> Bool
$c>= :: forall a. Ord a => Neighbors a -> Neighbors a -> Bool
> :: Neighbors a -> Neighbors a -> Bool
$c> :: forall a. Ord a => Neighbors a -> Neighbors a -> Bool
<= :: Neighbors a -> Neighbors a -> Bool
$c<= :: forall a. Ord a => Neighbors a -> Neighbors a -> Bool
< :: Neighbors a -> Neighbors a -> Bool
$c< :: forall a. Ord a => Neighbors a -> Neighbors a -> Bool
compare :: Neighbors a -> Neighbors a -> Ordering
$ccompare :: forall a. Ord a => Neighbors a -> Neighbors a -> Ordering
Ord, Int -> Neighbors a -> ShowS
[Neighbors a] -> ShowS
Neighbors a -> String
(Int -> Neighbors a -> ShowS)
-> (Neighbors a -> String)
-> ([Neighbors a] -> ShowS)
-> Show (Neighbors a)
forall a. Show a => Int -> Neighbors a -> ShowS
forall a. Show a => [Neighbors a] -> ShowS
forall a. Show a => Neighbors a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Neighbors a] -> ShowS
$cshowList :: forall a. Show a => [Neighbors a] -> ShowS
show :: Neighbors a -> String
$cshow :: forall a. Show a => Neighbors a -> String
showsPrec :: Int -> Neighbors a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Neighbors a -> ShowS
Show, (forall a b. (a -> b) -> Neighbors a -> Neighbors b)
-> (forall a b. a -> Neighbors b -> Neighbors a)
-> Functor Neighbors
forall a b. a -> Neighbors b -> Neighbors a
forall a b. (a -> b) -> Neighbors a -> Neighbors b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Neighbors b -> Neighbors a
$c<$ :: forall a b. a -> Neighbors b -> Neighbors a
fmap :: forall a b. (a -> b) -> Neighbors a -> Neighbors b
$cfmap :: forall a b. (a -> b) -> Neighbors a -> Neighbors b
Functor, (forall m. Monoid m => Neighbors m -> m)
-> (forall m a. Monoid m => (a -> m) -> Neighbors a -> m)
-> (forall m a. Monoid m => (a -> m) -> Neighbors a -> m)
-> (forall a b. (a -> b -> b) -> b -> Neighbors a -> b)
-> (forall a b. (a -> b -> b) -> b -> Neighbors a -> b)
-> (forall b a. (b -> a -> b) -> b -> Neighbors a -> b)
-> (forall b a. (b -> a -> b) -> b -> Neighbors a -> b)
-> (forall a. (a -> a -> a) -> Neighbors a -> a)
-> (forall a. (a -> a -> a) -> Neighbors a -> a)
-> (forall a. Neighbors a -> [a])
-> (forall a. Neighbors a -> Bool)
-> (forall a. Neighbors a -> Int)
-> (forall a. Eq a => a -> Neighbors a -> Bool)
-> (forall a. Ord a => Neighbors a -> a)
-> (forall a. Ord a => Neighbors a -> a)
-> (forall a. Num a => Neighbors a -> a)
-> (forall a. Num a => Neighbors a -> a)
-> Foldable Neighbors
forall a. Eq a => a -> Neighbors a -> Bool
forall a. Num a => Neighbors a -> a
forall a. Ord a => Neighbors a -> a
forall m. Monoid m => Neighbors m -> m
forall a. Neighbors a -> Bool
forall a. Neighbors a -> Int
forall a. Neighbors a -> [a]
forall a. (a -> a -> a) -> Neighbors a -> a
forall m a. Monoid m => (a -> m) -> Neighbors a -> m
forall b a. (b -> a -> b) -> b -> Neighbors a -> b
forall a b. (a -> b -> b) -> b -> Neighbors a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Neighbors a -> a
$cproduct :: forall a. Num a => Neighbors a -> a
sum :: forall a. Num a => Neighbors a -> a
$csum :: forall a. Num a => Neighbors a -> a
minimum :: forall a. Ord a => Neighbors a -> a
$cminimum :: forall a. Ord a => Neighbors a -> a
maximum :: forall a. Ord a => Neighbors a -> a
$cmaximum :: forall a. Ord a => Neighbors a -> a
elem :: forall a. Eq a => a -> Neighbors a -> Bool
$celem :: forall a. Eq a => a -> Neighbors a -> Bool
length :: forall a. Neighbors a -> Int
$clength :: forall a. Neighbors a -> Int
null :: forall a. Neighbors a -> Bool
$cnull :: forall a. Neighbors a -> Bool
toList :: forall a. Neighbors a -> [a]
$ctoList :: forall a. Neighbors a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Neighbors a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Neighbors a -> a
foldr1 :: forall a. (a -> a -> a) -> Neighbors a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Neighbors a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Neighbors a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Neighbors a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Neighbors a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Neighbors a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Neighbors a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Neighbors a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Neighbors a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Neighbors a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Neighbors a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Neighbors a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Neighbors a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Neighbors a -> m
fold :: forall m. Monoid m => Neighbors m -> m
$cfold :: forall m. Monoid m => Neighbors m -> m
Foldable, Functor Neighbors
Foldable Neighbors
Functor Neighbors
-> Foldable Neighbors
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Neighbors a -> f (Neighbors b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Neighbors (f a) -> f (Neighbors a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Neighbors a -> m (Neighbors b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Neighbors (m a) -> m (Neighbors a))
-> Traversable Neighbors
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Neighbors (m a) -> m (Neighbors a)
forall (f :: * -> *) a.
Applicative f =>
Neighbors (f a) -> f (Neighbors a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Neighbors a -> m (Neighbors b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Neighbors a -> f (Neighbors b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Neighbors (m a) -> m (Neighbors a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Neighbors (m a) -> m (Neighbors a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Neighbors a -> m (Neighbors b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Neighbors a -> m (Neighbors b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Neighbors (f a) -> f (Neighbors a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Neighbors (f a) -> f (Neighbors a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Neighbors a -> f (Neighbors b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Neighbors a -> f (Neighbors b)
Traversable, (forall a. Neighbors a -> Rep1 Neighbors a)
-> (forall a. Rep1 Neighbors a -> Neighbors a)
-> Generic1 Neighbors
forall a. Rep1 Neighbors a -> Neighbors a
forall a. Neighbors a -> Rep1 Neighbors a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Neighbors a -> Neighbors a
$cfrom1 :: forall a. Neighbors a -> Rep1 Neighbors a
Generic1)
  deriving Functor Neighbors
Functor Neighbors
-> (forall a. a -> Neighbors a)
-> (forall a b. Neighbors (a -> b) -> Neighbors a -> Neighbors b)
-> (forall a b c.
    (a -> b -> c) -> Neighbors a -> Neighbors b -> Neighbors c)
-> (forall a b. Neighbors a -> Neighbors b -> Neighbors b)
-> (forall a b. Neighbors a -> Neighbors b -> Neighbors a)
-> Applicative Neighbors
forall a. a -> Neighbors a
forall a b. Neighbors a -> Neighbors b -> Neighbors a
forall a b. Neighbors a -> Neighbors b -> Neighbors b
forall a b. Neighbors (a -> b) -> Neighbors a -> Neighbors b
forall a b c.
(a -> b -> c) -> Neighbors a -> Neighbors b -> Neighbors c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Neighbors a -> Neighbors b -> Neighbors a
$c<* :: forall a b. Neighbors a -> Neighbors b -> Neighbors a
*> :: forall a b. Neighbors a -> Neighbors b -> Neighbors b
$c*> :: forall a b. Neighbors a -> Neighbors b -> Neighbors b
liftA2 :: forall a b c.
(a -> b -> c) -> Neighbors a -> Neighbors b -> Neighbors c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Neighbors a -> Neighbors b -> Neighbors c
<*> :: forall a b. Neighbors (a -> b) -> Neighbors a -> Neighbors b
$c<*> :: forall a b. Neighbors (a -> b) -> Neighbors a -> Neighbors b
pure :: forall a. a -> Neighbors a
$cpure :: forall a. a -> Neighbors a
Applicative via Generically1 Neighbors

bitsNW :: Neighbors Int
bitsNW :: Neighbors Int
bitsNW = ((Int, ()) -> Int) -> Neighbors (Int, ()) -> Neighbors Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, ()) -> Int
forall a b. (a, b) -> a
fst (Neighbors (Int, ()) -> Neighbors Int)
-> (Neighbors () -> Neighbors (Int, ()))
-> Neighbors ()
-> Neighbors Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Neighbors () -> Neighbors (Int, ())
forall (t :: * -> *) ix a.
(Traversable t, Num ix) =>
t a -> t (ix, a)
enumerate (Neighbors () -> Neighbors Int) -> Neighbors () -> Neighbors Int
forall a b. (a -> b) -> a -> b
$ () -> Neighbors ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{-# INLINE testBitsNW #-}
testBitsNW :: Bits a => Neighbors (a -> Bool)
testBitsNW :: forall a. Bits a => Neighbors (a -> Bool)
testBitsNW =
  Neighbors Int
bitsNW Neighbors Int -> (Int -> a -> Bool) -> Neighbors (a -> Bool)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int
i a
packed ->
    a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
packed Int
i

{-# INLINE fromBitsNW #-}
fromBitsNW :: Bits a => a -> Neighbors Bool
fromBitsNW :: forall a. Bits a => a -> Neighbors Bool
fromBitsNW a
packed =
  Neighbors (a -> Bool)
forall a. Bits a => Neighbors (a -> Bool)
testBitsNW Neighbors (a -> Bool) -> ((a -> Bool) -> Bool) -> Neighbors Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a -> Bool
test ->
    a -> Bool
test a
packed

{-# INLINE toBitsNW #-}
toBitsNW :: Neighbors Bool -> Int
toBitsNW :: Neighbors Bool -> Int
toBitsNW = Neighbors Int -> Neighbors Bool -> Int
toBits Neighbors Int
bitsNW

{-# INLINE toBits #-}
toBits :: Neighbors Int -> Neighbors Bool -> Int
toBits :: Neighbors Int -> Neighbors Bool -> Int
toBits Neighbors Int
bits = (Int -> Int -> Int) -> Int -> Neighbors Int -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
forall a. Bits a => a -> a -> a
(.|.)) Int
forall a. Bits a => a
zeroBits (Neighbors Int -> Int)
-> (Neighbors Bool -> Neighbors Int) -> Neighbors Bool -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool -> Int)
-> Neighbors Int -> Neighbors Bool -> Neighbors Int
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Int -> Bool -> Int
forall {a}. Bits a => Int -> Bool -> a
toBit Neighbors Int
bits
  where
    toBit :: Int -> Bool -> a
toBit Int
i = a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool a
forall a. Bits a => a
zeroBits (Int -> a
forall a. Bits a => Int -> a
bit Int
i)

directionsWith :: (Num a) => (a -> a -> b) -> Neighbors b
directionsWith :: forall a b. Num a => (a -> a -> b) -> Neighbors b
directionsWith a -> a -> b
f = Neighbors :: forall a. a -> a -> a -> a -> a -> a -> a -> a -> Neighbors a
Neighbors
  { $sel:northWest:Neighbors :: b
northWest = a -> a -> b
f (-a
1) (-a
1)
  , $sel:north:Neighbors :: b
north     = a -> a -> b
f   a
0  (-a
1)
  , $sel:northEast:Neighbors :: b
northEast = a -> a -> b
f   a
1  (-a
1)
  , $sel:east:Neighbors :: b
east      = a -> a -> b
f   a
1    a
0
  , $sel:southEast:Neighbors :: b
southEast = a -> a -> b
f   a
1    a
1
  , $sel:south:Neighbors :: b
south     = a -> a -> b
f   a
0    a
1
  , $sel:southWest:Neighbors :: b
southWest = a -> a -> b
f (-a
1)   a
1
  , $sel:west:Neighbors :: b
west      = a -> a -> b
f (-a
1)   a
0
  }

isCorner :: Neighbors Bool
isCorner :: Neighbors Bool
isCorner = Neighbors :: forall a. a -> a -> a -> a -> a -> a -> a -> a -> Neighbors a
Neighbors
  { $sel:northWest:Neighbors :: Bool
northWest = Bool
True
  , $sel:north:Neighbors :: Bool
north     = Bool
False
  , $sel:northEast:Neighbors :: Bool
northEast = Bool
True
  , $sel:east:Neighbors :: Bool
east      = Bool
False
  , $sel:southEast:Neighbors :: Bool
southEast = Bool
True
  , $sel:south:Neighbors :: Bool
south     = Bool
False
  , $sel:southWest:Neighbors :: Bool
southWest = Bool
True
  , $sel:west:Neighbors :: Bool
west      = Bool
False
  }

names :: IsString a => Neighbors a
names :: forall a. IsString a => Neighbors a
names = Neighbors :: forall a. a -> a -> a -> a -> a -> a -> a -> a -> Neighbors a
Neighbors
  { $sel:northWest:Neighbors :: a
northWest = a
"nw"
  , $sel:north:Neighbors :: a
north     = a
"n"
  , $sel:northEast:Neighbors :: a
northEast = a
"ne"
  , $sel:east:Neighbors :: a
east      = a
"e"
  , $sel:southEast:Neighbors :: a
southEast = a
"se"
  , $sel:south:Neighbors :: a
south     = a
"s"
  , $sel:southWest:Neighbors :: a
southWest = a
"sw"
  , $sel:west:Neighbors :: a
west      = a
"w"
  }