Neighbors.hs

{-# LANGUAGE NoStrictData #-}

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

  , bitsNW
  , testBitsNW
  , fromBitsNW
  , toBitsNW

  , directionsWith
  , isCorner
  , names

  , fromPoints
  ) where

import RIO

import Data.Bits
import Geomancy.Vec2 (Vec2, withVec2, vec2)
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"
  }

fromPoints :: Vec2 -> Vec2 -> Neighbors Vec2
fromPoints a b =
  withVec2 a \ax ay ->
    withVec2 b \bx by ->
      let
        top = min ay by
        right = max ax bx
        bottom = max ay by
        left = min ax bx

        midX = ax * 0.5 + bx * 0.5
        midY = ay * 0.5 + by * 0.5
      in
        Neighbors
          { northWest = vec2 left top
          , north     = vec2 midX top
          , northEast = vec2 right top
          , east      = vec2 right midY
          , southEast = vec2 right bottom
          , south     = vec2 midX bottom
          , southWest = vec2 left bottom
          , west      = vec2 left midY
          }