Neighbors.hs

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 = pure False

everyone :: Neighbors Bool
everyone = pure True

data Neighbors a = Neighbors
  { northWest :: a
  , north     :: a
  , northEast :: a
  , east      :: a
  , southEast :: a
  , south     :: a
  , southWest :: a
  , west      :: a
  }
  deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable, Generic1)
  deriving Applicative via Generically1 Neighbors

bitsNW :: Neighbors Int
bitsNW = fmap fst . enumerate $ pure ()

{-# INLINE testBitsNW #-}
testBitsNW :: Bits a => Neighbors (a -> Bool)
testBitsNW =
  bitsNW <&> \i packed ->
    testBit packed i

{-# INLINE fromBitsNW #-}
fromBitsNW :: Bits a => a -> Neighbors Bool
fromBitsNW packed =
  testBitsNW <&> \test ->
    test packed

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

{-# INLINE toBits #-}
toBits :: Neighbors Int -> Neighbors Bool -> Int
toBits bits = foldl' (flip (.|.)) zeroBits . liftA2 toBit bits
  where
    toBit i = bool zeroBits (bit i)

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

isCorner :: Neighbors Bool
isCorner = Neighbors
  { northWest = True
  , north     = False
  , northEast = True
  , east      = False
  , southEast = True
  , south     = False
  , southWest = True
  , west      = False
  }

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