{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module      :  Data.Tiling.Quad
Copyright   :  (c) Claude Heiland-Allen 2011
License     :  BSD3

Maintainer  :  claudiusmaximus@goto10.org
Stability   :  unstable
Portability :  portable

Simple substitution tiling with each square divided into four quadrants
(with no rotation).
-}
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

-- | A square tile.
data Quad = Quad{ quadLevel :: !Int, quadWest, quadNorth :: !Integer }
  deriving (Read, Show, Eq, Ord, Data, Typeable)

-- | Substitution tiling for square tiles.
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

-- | Which quadrant.
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

-- | All quadrants.
quadrants :: [Quadrant]
quadrants = [minBound .. maxBound]

-- | The child tile at a given quadrant.
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
  }

-- | The parent with quadrant information for the tile.  Satisfies:
--
-- > quadParent (quadChild c q) == Just (c, q)
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

-- | The path from this tile to the root.  Satisfies:
--
-- > foldr quadChild root (quadPath q) == q
quadPath :: Quad -> [Quadrant]
quadPath = unfoldr quadParent

-- | Suggested file system location for data pertaining to a 'Quad'.
quadFile :: Quad -> Maybe ([FilePath], FilePath)
quadFile q
  | null cs = Nothing
  | otherwise = Just (init cs, last cs)
  where
    -- based on a suggestion from Robert Munafo <http://mrob.com>.
    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