module Geometry.Tile.Microblob ( Microblob(..) , indices , names , quad , genSets ) where import RIO import Data.Bits import Geometry.Quad (Quad(..)) import Geometry.Tile.Neighbors (Neighbors(..)) import Resource.Collection (Generic1, Generically1(..), enumerate) import RIO.Map qualified as Map import RIO.Set qualified as Set data Microblob a = Microblob { forall a. Microblob a -> a brCornerInner :: a , forall a. Microblob a -> a blCornerInner :: a , forall a. Microblob a -> a trCornerInner :: a , forall a. Microblob a -> a tlCornerInner :: a , forall a. Microblob a -> a tlCornerOuter :: a , forall a. Microblob a -> a ttEdgeHorizontal :: a , forall a. Microblob a -> a trCornerOuter :: a , forall a. Microblob a -> a llEdgeVertical :: a , forall a. Microblob a -> a full :: a , forall a. Microblob a -> a rrEdgeVertical :: a , forall a. Microblob a -> a blCornerOuter :: a , forall a. Microblob a -> a bbEdgeHorizontal :: a , forall a. Microblob a -> a brCornerOuter :: a } deriving stock (Microblob a -> Microblob a -> Bool (Microblob a -> Microblob a -> Bool) -> (Microblob a -> Microblob a -> Bool) -> Eq (Microblob a) forall a. Eq a => Microblob a -> Microblob a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Microblob a -> Microblob a -> Bool $c/= :: forall a. Eq a => Microblob a -> Microblob a -> Bool == :: Microblob a -> Microblob a -> Bool $c== :: forall a. Eq a => Microblob a -> Microblob a -> Bool Eq, Eq (Microblob a) Eq (Microblob a) -> (Microblob a -> Microblob a -> Ordering) -> (Microblob a -> Microblob a -> Bool) -> (Microblob a -> Microblob a -> Bool) -> (Microblob a -> Microblob a -> Bool) -> (Microblob a -> Microblob a -> Bool) -> (Microblob a -> Microblob a -> Microblob a) -> (Microblob a -> Microblob a -> Microblob a) -> Ord (Microblob a) Microblob a -> Microblob a -> Bool Microblob a -> Microblob a -> Ordering Microblob a -> Microblob a -> Microblob 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 (Microblob a) forall a. Ord a => Microblob a -> Microblob a -> Bool forall a. Ord a => Microblob a -> Microblob a -> Ordering forall a. Ord a => Microblob a -> Microblob a -> Microblob a min :: Microblob a -> Microblob a -> Microblob a $cmin :: forall a. Ord a => Microblob a -> Microblob a -> Microblob a max :: Microblob a -> Microblob a -> Microblob a $cmax :: forall a. Ord a => Microblob a -> Microblob a -> Microblob a >= :: Microblob a -> Microblob a -> Bool $c>= :: forall a. Ord a => Microblob a -> Microblob a -> Bool > :: Microblob a -> Microblob a -> Bool $c> :: forall a. Ord a => Microblob a -> Microblob a -> Bool <= :: Microblob a -> Microblob a -> Bool $c<= :: forall a. Ord a => Microblob a -> Microblob a -> Bool < :: Microblob a -> Microblob a -> Bool $c< :: forall a. Ord a => Microblob a -> Microblob a -> Bool compare :: Microblob a -> Microblob a -> Ordering $ccompare :: forall a. Ord a => Microblob a -> Microblob a -> Ordering Ord, Int -> Microblob a -> ShowS [Microblob a] -> ShowS Microblob a -> String (Int -> Microblob a -> ShowS) -> (Microblob a -> String) -> ([Microblob a] -> ShowS) -> Show (Microblob a) forall a. Show a => Int -> Microblob a -> ShowS forall a. Show a => [Microblob a] -> ShowS forall a. Show a => Microblob a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Microblob a] -> ShowS $cshowList :: forall a. Show a => [Microblob a] -> ShowS show :: Microblob a -> String $cshow :: forall a. Show a => Microblob a -> String showsPrec :: Int -> Microblob a -> ShowS $cshowsPrec :: forall a. Show a => Int -> Microblob a -> ShowS Show, (forall a b. (a -> b) -> Microblob a -> Microblob b) -> (forall a b. a -> Microblob b -> Microblob a) -> Functor Microblob forall a b. a -> Microblob b -> Microblob a forall a b. (a -> b) -> Microblob a -> Microblob 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 -> Microblob b -> Microblob a $c<$ :: forall a b. a -> Microblob b -> Microblob a fmap :: forall a b. (a -> b) -> Microblob a -> Microblob b $cfmap :: forall a b. (a -> b) -> Microblob a -> Microblob b Functor, (forall m. Monoid m => Microblob m -> m) -> (forall m a. Monoid m => (a -> m) -> Microblob a -> m) -> (forall m a. Monoid m => (a -> m) -> Microblob a -> m) -> (forall a b. (a -> b -> b) -> b -> Microblob a -> b) -> (forall a b. (a -> b -> b) -> b -> Microblob a -> b) -> (forall b a. (b -> a -> b) -> b -> Microblob a -> b) -> (forall b a. (b -> a -> b) -> b -> Microblob a -> b) -> (forall a. (a -> a -> a) -> Microblob a -> a) -> (forall a. (a -> a -> a) -> Microblob a -> a) -> (forall a. Microblob a -> [a]) -> (forall a. Microblob a -> Bool) -> (forall a. Microblob a -> Int) -> (forall a. Eq a => a -> Microblob a -> Bool) -> (forall a. Ord a => Microblob a -> a) -> (forall a. Ord a => Microblob a -> a) -> (forall a. Num a => Microblob a -> a) -> (forall a. Num a => Microblob a -> a) -> Foldable Microblob forall a. Eq a => a -> Microblob a -> Bool forall a. Num a => Microblob a -> a forall a. Ord a => Microblob a -> a forall m. Monoid m => Microblob m -> m forall a. Microblob a -> Bool forall a. Microblob a -> Int forall a. Microblob a -> [a] forall a. (a -> a -> a) -> Microblob a -> a forall m a. Monoid m => (a -> m) -> Microblob a -> m forall b a. (b -> a -> b) -> b -> Microblob a -> b forall a b. (a -> b -> b) -> b -> Microblob 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 => Microblob a -> a $cproduct :: forall a. Num a => Microblob a -> a sum :: forall a. Num a => Microblob a -> a $csum :: forall a. Num a => Microblob a -> a minimum :: forall a. Ord a => Microblob a -> a $cminimum :: forall a. Ord a => Microblob a -> a maximum :: forall a. Ord a => Microblob a -> a $cmaximum :: forall a. Ord a => Microblob a -> a elem :: forall a. Eq a => a -> Microblob a -> Bool $celem :: forall a. Eq a => a -> Microblob a -> Bool length :: forall a. Microblob a -> Int $clength :: forall a. Microblob a -> Int null :: forall a. Microblob a -> Bool $cnull :: forall a. Microblob a -> Bool toList :: forall a. Microblob a -> [a] $ctoList :: forall a. Microblob a -> [a] foldl1 :: forall a. (a -> a -> a) -> Microblob a -> a $cfoldl1 :: forall a. (a -> a -> a) -> Microblob a -> a foldr1 :: forall a. (a -> a -> a) -> Microblob a -> a $cfoldr1 :: forall a. (a -> a -> a) -> Microblob a -> a foldl' :: forall b a. (b -> a -> b) -> b -> Microblob a -> b $cfoldl' :: forall b a. (b -> a -> b) -> b -> Microblob a -> b foldl :: forall b a. (b -> a -> b) -> b -> Microblob a -> b $cfoldl :: forall b a. (b -> a -> b) -> b -> Microblob a -> b foldr' :: forall a b. (a -> b -> b) -> b -> Microblob a -> b $cfoldr' :: forall a b. (a -> b -> b) -> b -> Microblob a -> b foldr :: forall a b. (a -> b -> b) -> b -> Microblob a -> b $cfoldr :: forall a b. (a -> b -> b) -> b -> Microblob a -> b foldMap' :: forall m a. Monoid m => (a -> m) -> Microblob a -> m $cfoldMap' :: forall m a. Monoid m => (a -> m) -> Microblob a -> m foldMap :: forall m a. Monoid m => (a -> m) -> Microblob a -> m $cfoldMap :: forall m a. Monoid m => (a -> m) -> Microblob a -> m fold :: forall m. Monoid m => Microblob m -> m $cfold :: forall m. Monoid m => Microblob m -> m Foldable, Functor Microblob Foldable Microblob Functor Microblob -> Foldable Microblob -> (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Microblob a -> f (Microblob b)) -> (forall (f :: * -> *) a. Applicative f => Microblob (f a) -> f (Microblob a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> Microblob a -> m (Microblob b)) -> (forall (m :: * -> *) a. Monad m => Microblob (m a) -> m (Microblob a)) -> Traversable Microblob 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 => Microblob (m a) -> m (Microblob a) forall (f :: * -> *) a. Applicative f => Microblob (f a) -> f (Microblob a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> Microblob a -> m (Microblob b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Microblob a -> f (Microblob b) sequence :: forall (m :: * -> *) a. Monad m => Microblob (m a) -> m (Microblob a) $csequence :: forall (m :: * -> *) a. Monad m => Microblob (m a) -> m (Microblob a) mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Microblob a -> m (Microblob b) $cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Microblob a -> m (Microblob b) sequenceA :: forall (f :: * -> *) a. Applicative f => Microblob (f a) -> f (Microblob a) $csequenceA :: forall (f :: * -> *) a. Applicative f => Microblob (f a) -> f (Microblob a) traverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Microblob a -> f (Microblob b) $ctraverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Microblob a -> f (Microblob b) Traversable, (forall a. Microblob a -> Rep1 Microblob a) -> (forall a. Rep1 Microblob a -> Microblob a) -> Generic1 Microblob forall a. Rep1 Microblob a -> Microblob a forall a. Microblob a -> Rep1 Microblob 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 Microblob a -> Microblob a $cfrom1 :: forall a. Microblob a -> Rep1 Microblob a Generic1) deriving Functor Microblob Functor Microblob -> (forall a. a -> Microblob a) -> (forall a b. Microblob (a -> b) -> Microblob a -> Microblob b) -> (forall a b c. (a -> b -> c) -> Microblob a -> Microblob b -> Microblob c) -> (forall a b. Microblob a -> Microblob b -> Microblob b) -> (forall a b. Microblob a -> Microblob b -> Microblob a) -> Applicative Microblob forall a. a -> Microblob a forall a b. Microblob a -> Microblob b -> Microblob a forall a b. Microblob a -> Microblob b -> Microblob b forall a b. Microblob (a -> b) -> Microblob a -> Microblob b forall a b c. (a -> b -> c) -> Microblob a -> Microblob b -> Microblob 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. Microblob a -> Microblob b -> Microblob a $c<* :: forall a b. Microblob a -> Microblob b -> Microblob a *> :: forall a b. Microblob a -> Microblob b -> Microblob b $c*> :: forall a b. Microblob a -> Microblob b -> Microblob b liftA2 :: forall a b c. (a -> b -> c) -> Microblob a -> Microblob b -> Microblob c $cliftA2 :: forall a b c. (a -> b -> c) -> Microblob a -> Microblob b -> Microblob c <*> :: forall a b. Microblob (a -> b) -> Microblob a -> Microblob b $c<*> :: forall a b. Microblob (a -> b) -> Microblob a -> Microblob b pure :: forall a. a -> Microblob a $cpure :: forall a. a -> Microblob a Applicative via Generically1 Microblob indices :: Microblob Int indices :: Microblob Int indices = ((Int, ()) -> Int) -> Microblob (Int, ()) -> Microblob Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Int, ()) -> Int forall a b. (a, b) -> a fst (Microblob (Int, ()) -> Microblob Int) -> (Microblob () -> Microblob (Int, ())) -> Microblob () -> Microblob Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Microblob () -> Microblob (Int, ()) forall (t :: * -> *) ix a. (Traversable t, Num ix) => t a -> t (ix, a) enumerate (Microblob () -> Microblob Int) -> Microblob () -> Microblob Int forall a b. (a -> b) -> a -> b $ () -> Microblob () forall (f :: * -> *) a. Applicative f => a -> f a pure () names :: Microblob Text names :: Microblob Text names = Microblob :: forall a. a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> a -> Microblob a Microblob { $sel:brCornerInner:Microblob :: Text brCornerInner = Text "brCornerInner" , $sel:blCornerInner:Microblob :: Text blCornerInner = Text "blCornerInner" , $sel:trCornerInner:Microblob :: Text trCornerInner = Text "trCornerInner" , $sel:tlCornerInner:Microblob :: Text tlCornerInner = Text "tlCornerInner" , $sel:tlCornerOuter:Microblob :: Text tlCornerOuter = Text "tlCornerOuter" , $sel:ttEdgeHorizontal:Microblob :: Text ttEdgeHorizontal = Text "ttEdgeHorizontal" , $sel:trCornerOuter:Microblob :: Text trCornerOuter = Text "trCornerOuter" , $sel:llEdgeVertical:Microblob :: Text llEdgeVertical = Text "llEdgeVertical" , $sel:full:Microblob :: Text full = Text "full" , $sel:rrEdgeVertical:Microblob :: Text rrEdgeVertical = Text "rrEdgeVertical" , $sel:blCornerOuter:Microblob :: Text blCornerOuter = Text "blCornerOuter" , $sel:bbEdgeHorizontal:Microblob :: Text bbEdgeHorizontal = Text "bbEdgeHorizontal" , $sel:brCornerOuter:Microblob :: Text brCornerOuter = Text "brCornerOuter" } quad :: Neighbors Int -> Microblob a -> Int -> Quad a quad :: forall a. Neighbors Int -> Microblob a -> Int -> Quad a quad Neighbors{Int $sel:west:Neighbors :: forall a. Neighbors a -> a $sel:southWest:Neighbors :: forall a. Neighbors a -> a $sel:south:Neighbors :: forall a. Neighbors a -> a $sel:southEast:Neighbors :: forall a. Neighbors a -> a $sel:east:Neighbors :: forall a. Neighbors a -> a $sel:northEast:Neighbors :: forall a. Neighbors a -> a $sel:north:Neighbors :: forall a. Neighbors a -> a $sel:northWest:Neighbors :: forall a. Neighbors a -> a west :: Int southWest :: Int south :: Int southEast :: Int east :: Int northEast :: Int north :: Int northWest :: Int ..} Microblob{a brCornerOuter :: a bbEdgeHorizontal :: a blCornerOuter :: a rrEdgeVertical :: a full :: a llEdgeVertical :: a trCornerOuter :: a ttEdgeHorizontal :: a tlCornerOuter :: a tlCornerInner :: a trCornerInner :: a blCornerInner :: a brCornerInner :: a $sel:brCornerOuter:Microblob :: forall a. Microblob a -> a $sel:bbEdgeHorizontal:Microblob :: forall a. Microblob a -> a $sel:blCornerOuter:Microblob :: forall a. Microblob a -> a $sel:rrEdgeVertical:Microblob :: forall a. Microblob a -> a $sel:full:Microblob :: forall a. Microblob a -> a $sel:llEdgeVertical:Microblob :: forall a. Microblob a -> a $sel:trCornerOuter:Microblob :: forall a. Microblob a -> a $sel:ttEdgeHorizontal:Microblob :: forall a. Microblob a -> a $sel:tlCornerOuter:Microblob :: forall a. Microblob a -> a $sel:tlCornerInner:Microblob :: forall a. Microblob a -> a $sel:trCornerInner:Microblob :: forall a. Microblob a -> a $sel:blCornerInner:Microblob :: forall a. Microblob a -> a $sel:brCornerInner:Microblob :: forall a. Microblob a -> a ..} Int index = Quad :: forall a. a -> a -> a -> a -> Quad a Quad { $sel:quadLT:Quad :: a quadLT = if Bool iNorth Bool -> Bool -> Bool && Bool iWest then if Int -> Int -> Bool forall a. Bits a => a -> Int -> Bool testBit Int index Int northWest then a full else a tlCornerInner else if Bool iNorth then a llEdgeVertical else if Bool iWest then a ttEdgeHorizontal else a tlCornerOuter , $sel:quadRT:Quad :: a quadRT = if Bool iNorth Bool -> Bool -> Bool && Bool iEast then if Int -> Int -> Bool forall a. Bits a => a -> Int -> Bool testBit Int index Int northEast then a full else a trCornerInner else if Bool iNorth then a rrEdgeVertical else if Bool iEast then a ttEdgeHorizontal else a trCornerOuter , $sel:quadLB:Quad :: a quadLB = if Bool iSouth Bool -> Bool -> Bool && Bool iWest then if Int -> Int -> Bool forall a. Bits a => a -> Int -> Bool testBit Int index Int southWest then a full else a blCornerInner else if Bool iSouth then a llEdgeVertical else if Bool iWest then a bbEdgeHorizontal else a blCornerOuter , $sel:quadRB:Quad :: a quadRB = if Bool iSouth Bool -> Bool -> Bool && Bool iEast then if Int -> Int -> Bool forall a. Bits a => a -> Int -> Bool testBit Int index Int southEast then a full else a brCornerInner else if Bool iSouth then a rrEdgeVertical else if Bool iEast then a bbEdgeHorizontal else a brCornerOuter } where iNorth :: Bool iNorth = Int -> Int -> Bool forall a. Bits a => a -> Int -> Bool testBit Int index Int north iWest :: Bool iWest = Int -> Int -> Bool forall a. Bits a => a -> Int -> Bool testBit Int index Int west iEast :: Bool iEast = Int -> Int -> Bool forall a. Bits a => a -> Int -> Bool testBit Int index Int east iSouth :: Bool iSouth = Int -> Int -> Bool forall a. Bits a => a -> Int -> Bool testBit Int index Int south genSets :: Neighbors Int -> (Set Int, Map Int Int) genSets :: Neighbors Int -> (Set Int, Map Int Int) genSets Neighbors Int bits = forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' @[] (Set Int, Map Int Int) -> Int -> (Set Int, Map Int Int) f (Set Int forall a. Set a Set.empty, Map Int Int forall k a. Map k a Map.empty) [Int 0..Int 255] where Neighbors{Int west :: Int southWest :: Int south :: Int southEast :: Int east :: Int northEast :: Int north :: Int northWest :: Int $sel:west:Neighbors :: forall a. Neighbors a -> a $sel:southWest:Neighbors :: forall a. Neighbors a -> a $sel:south:Neighbors :: forall a. Neighbors a -> a $sel:southEast:Neighbors :: forall a. Neighbors a -> a $sel:east:Neighbors :: forall a. Neighbors a -> a $sel:northEast:Neighbors :: forall a. Neighbors a -> a $sel:north:Neighbors :: forall a. Neighbors a -> a $sel:northWest:Neighbors :: forall a. Neighbors a -> a ..} = Neighbors Int bits f :: (Set Int, Map Int Int) -> Int -> (Set Int, Map Int Int) f (Set Int uniq, Map Int Int dups) Int i = ( Int -> Set Int -> Set Int forall a. Ord a => a -> Set a -> Set a Set.insert Int index Set Int uniq , Int -> Int -> Map Int Int -> Map Int Int forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert Int i Int index Map Int Int dups ) where index :: Int index = Int i Int -> (Int -> Int) -> Int forall a b. a -> (a -> b) -> b & (Int -> Int) -> (Int -> Int) -> Bool -> Int -> Int forall a. a -> a -> Bool -> a bool (Int -> Int -> Int forall a. Bits a => a -> Int -> a clearBit Int northWest) Int -> Int forall a. a -> a id (Bool iNorth Bool -> Bool -> Bool && Bool iWest) Int -> (Int -> Int) -> Int forall a b. a -> (a -> b) -> b & (Int -> Int) -> (Int -> Int) -> Bool -> Int -> Int forall a. a -> a -> Bool -> a bool (Int -> Int -> Int forall a. Bits a => a -> Int -> a clearBit Int northEast) Int -> Int forall a. a -> a id (Bool iNorth Bool -> Bool -> Bool && Bool iEast) Int -> (Int -> Int) -> Int forall a b. a -> (a -> b) -> b & (Int -> Int) -> (Int -> Int) -> Bool -> Int -> Int forall a. a -> a -> Bool -> a bool (Int -> Int -> Int forall a. Bits a => a -> Int -> a clearBit Int southWest) Int -> Int forall a. a -> a id (Bool iSouth Bool -> Bool -> Bool && Bool iWest) Int -> (Int -> Int) -> Int forall a b. a -> (a -> b) -> b & (Int -> Int) -> (Int -> Int) -> Bool -> Int -> Int forall a. a -> a -> Bool -> a bool (Int -> Int -> Int forall a. Bits a => a -> Int -> a clearBit Int southEast) Int -> Int forall a. a -> a id (Bool iSouth Bool -> Bool -> Bool && Bool iEast) iNorth :: Bool iNorth = Int -> Int -> Bool forall a. Bits a => a -> Int -> Bool testBit Int i Int north iWest :: Bool iWest = Int -> Int -> Bool forall a. Bits a => a -> Int -> Bool testBit Int i Int west iEast :: Bool iEast = Int -> Int -> Bool forall a. Bits a => a -> Int -> Bool testBit Int i Int east iSouth :: Bool iSouth = Int -> Int -> Bool forall a. Bits a => a -> Int -> Bool testBit Int i Int south