{-# 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 }