{-# 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 :: Neighbors Bool nobody = forall (f :: * -> *) a. Applicative f => a -> f a pure Bool False everyone :: Neighbors Bool everyone :: Neighbors Bool everyone = 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 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, Neighbors a -> Neighbors a -> Bool Neighbors a -> Neighbors a -> Ordering 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 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 -> 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 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 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. 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 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a b. (a, b) -> a fst forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (t :: * -> *) ix a. (Traversable t, Num ix) => t a -> t (ix, a) enumerate forall a b. (a -> b) -> a -> b $ 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 forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \Int i a packed -> 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 = forall a. Bits a => Neighbors (a -> Bool) testBitsNW 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 = forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' (forall a b c. (a -> b -> c) -> b -> a -> c flip forall a. Bits a => a -> a -> a (.|.)) forall a. Bits a => a zeroBits forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 forall {a}. Bits a => Int -> Bool -> a toBit Neighbors Int bits where toBit :: Int -> Bool -> a toBit Int i = forall a. a -> a -> Bool -> a bool forall a. Bits a => a zeroBits (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 { $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 { $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 { $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" } fromPoints :: Vec2 -> Vec2 -> Neighbors Vec2 fromPoints :: Vec2 -> Vec2 -> Neighbors Vec2 fromPoints Vec2 a Vec2 b = forall r. Vec2 -> (Float -> Float -> r) -> r withVec2 Vec2 a \Float ax Float ay -> forall r. Vec2 -> (Float -> Float -> r) -> r withVec2 Vec2 b \Float bx Float by -> let top :: Float top = forall a. Ord a => a -> a -> a min Float ay Float by right :: Float right = forall a. Ord a => a -> a -> a max Float ax Float bx bottom :: Float bottom = forall a. Ord a => a -> a -> a max Float ay Float by left :: Float left = forall a. Ord a => a -> a -> a min Float ax Float bx midX :: Float midX = Float ax forall a. Num a => a -> a -> a * Float 0.5 forall a. Num a => a -> a -> a + Float bx forall a. Num a => a -> a -> a * Float 0.5 midY :: Float midY = Float ay forall a. Num a => a -> a -> a * Float 0.5 forall a. Num a => a -> a -> a + Float by forall a. Num a => a -> a -> a * Float 0.5 in Neighbors { $sel:northWest:Neighbors :: Vec2 northWest = Float -> Float -> Vec2 vec2 Float left Float top , $sel:north:Neighbors :: Vec2 north = Float -> Float -> Vec2 vec2 Float midX Float top , $sel:northEast:Neighbors :: Vec2 northEast = Float -> Float -> Vec2 vec2 Float right Float top , $sel:east:Neighbors :: Vec2 east = Float -> Float -> Vec2 vec2 Float right Float midY , $sel:southEast:Neighbors :: Vec2 southEast = Float -> Float -> Vec2 vec2 Float right Float bottom , $sel:south:Neighbors :: Vec2 south = Float -> Float -> Vec2 vec2 Float midX Float bottom , $sel:southWest:Neighbors :: Vec2 southWest = Float -> Float -> Vec2 vec2 Float left Float bottom , $sel:west:Neighbors :: Vec2 west = Float -> Float -> Vec2 vec2 Float left Float midY }