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 { brCornerInner :: a , blCornerInner :: a , trCornerInner :: a , tlCornerInner :: a , tlCornerOuter :: a , ttEdgeHorizontal :: a , trCornerOuter :: a , llEdgeVertical :: a , full :: a , rrEdgeVertical :: a , blCornerOuter :: a , bbEdgeHorizontal :: a , brCornerOuter :: a } deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable, Generic1) deriving Applicative via Generically1 Microblob indices :: Microblob Int indices = fmap fst . enumerate $ pure () names :: Microblob Text names = Microblob { brCornerInner = "brCornerInner" , blCornerInner = "blCornerInner" , trCornerInner = "trCornerInner" , tlCornerInner = "tlCornerInner" , tlCornerOuter = "tlCornerOuter" , ttEdgeHorizontal = "ttEdgeHorizontal" , trCornerOuter = "trCornerOuter" , llEdgeVertical = "llEdgeVertical" , full = "full" , rrEdgeVertical = "rrEdgeVertical" , blCornerOuter = "blCornerOuter" , bbEdgeHorizontal = "bbEdgeHorizontal" , brCornerOuter = "brCornerOuter" } quad :: Neighbors Int -> Microblob a -> Int -> Quad a quad Neighbors{..} Microblob{..} index = Quad { quadLT = if iNorth && iWest then if testBit index northWest then full else tlCornerInner else if iNorth then llEdgeVertical else if iWest then ttEdgeHorizontal else tlCornerOuter , quadRT = if iNorth && iEast then if testBit index northEast then full else trCornerInner else if iNorth then rrEdgeVertical else if iEast then ttEdgeHorizontal else trCornerOuter , quadLB = if iSouth && iWest then if testBit index southWest then full else blCornerInner else if iSouth then llEdgeVertical else if iWest then bbEdgeHorizontal else blCornerOuter , quadRB = if iSouth && iEast then if testBit index southEast then full else brCornerInner else if iSouth then rrEdgeVertical else if iEast then bbEdgeHorizontal else brCornerOuter } where iNorth = testBit index north iWest = testBit index west iEast = testBit index east iSouth = testBit index south genSets :: Neighbors Int -> (Set Int, Map Int Int) genSets bits = foldl' @[] f (Set.empty, Map.empty) [0..255] where Neighbors{..} = bits f (uniq, dups) i = ( Set.insert index uniq , Map.insert i index dups ) where index = i & bool (clearBit northWest) id (iNorth && iWest) & bool (clearBit northEast) id (iNorth && iEast) & bool (clearBit southWest) id (iSouth && iWest) & bool (clearBit southEast) id (iSouth && iEast) iNorth = testBit i north iWest = testBit i west iEast = testBit i east iSouth = testBit i south