module Data.Tiling.Quad
( Quadrant(..), isNorth, isSouth, isWest, isEast, quadrants
, Quad(..), quadChild, quadParent, quadPath, quadFile
, module Data.Tiling.Class
) where
import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.Bits (bit, shiftL, shiftR, testBit, (.|.))
import Data.List (unfoldr)
import Data.Ratio ((%))
import Data.Tiling.Class
data Quad = Quad{ quadLevel :: !Int, quadWest, quadNorth :: !Integer }
deriving (Read, Show, Eq, Ord, Data, Typeable)
instance Tiling Quad where
root = Quad 0 0 0
children q = map (`quadChild` q) quadrants
parent q = snd `fmap` quadParent q
exterior (Quad l x y) =
let d = bit l
in rectangle (x % d) ((x + 1) % d) (y % d) ((y + 1) % d)
interior = exterior
inside q r = exterior q `insideR` r
encloses q r = r `insideR` interior q
outside q r = exterior q `outsideR` r
overlaps q r = exterior q `overlapsR` r
data Quadrant = NorthWest | NorthEast | SouthWest | SouthEast
deriving (Read, Show, Eq, Ord, Enum, Bounded, Data, Typeable)
isNorth, isSouth, isWest, isEast :: Quadrant -> Bool
isEast c = fromEnum c `testBit` 0
isSouth c = fromEnum c `testBit` 1
isNorth = not . isSouth
isWest = not . isEast
quadrants :: [Quadrant]
quadrants = [minBound .. maxBound]
quadChild :: Quadrant -> Quad -> Quad
quadChild c Quad{ quadLevel = l, quadWest = x, quadNorth = y } = Quad
{ quadLevel = l + 1
, quadWest = x `shiftL` 1 .|. (fromIntegral . fromEnum . isEast ) c
, quadNorth = y `shiftL` 1 .|. (fromIntegral . fromEnum . isSouth) c
}
quadParent :: Quad -> Maybe (Quadrant, Quad)
quadParent Quad{ quadLevel = l, quadWest = x, quadNorth = y }
| l > 0 = Just
( toEnum (fromEnum (y `testBit` 0) `shiftL` 1 .|. fromEnum (x `testBit` 0))
, Quad{ quadLevel = l 1, quadWest = x `shiftR` 1, quadNorth = y `shiftR` 1 }
)
| otherwise = Nothing
quadPath :: Quad -> [Quadrant]
quadPath = unfoldr quadParent
quadFile :: Quad -> Maybe ([FilePath], FilePath)
quadFile q
| null cs = Nothing
| otherwise = Just (init cs, last cs)
where
cs = chunk 2 . map unsafeName . chunk 2 . reverse . quadPath $ q
unsafeName :: [Quadrant] -> Char
unsafeName [c] = ['a'..'d'] !! (fromEnum c)
unsafeName [c,d] = ['e'..'t'] !! (fromEnum c `shiftL` 2 .|. fromEnum d)
unsafeName _ = error "Data.Tiling.Quad.quadFile.unsafeName"
chunk :: Int -> [a] -> [[a]]
chunk _ [] = []
chunk n xs = let (ys, zs) = splitAt n xs in ys : chunk n zs