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

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

Substitution tiling API.
-}
module Data.Tiling.Class where

import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.List (partition)

-- | Substitution tilings.  Instances must obey the following laws:
--
--     > parent root == Nothing
--     > all (== Just t) . map parent . children $ t
--     > t `inside`   exterior t
--     > t `encloses` interior t
--     > interior t `insideR` exterior t
--     > t `inside` r  ==>  t `overlaps` r
--     > t `encloses` r  ==>  t `overlaps` r
--     > t `overlaps` r  ==> not (t `outside` r)
--     > t `encloses` r && n >= 0  ==>  not $ any (`outside` r) (tile t r n)
--
--  Minimal complete definition: all except 'tile'.
class Tiling t where
  -- | The largest tile to start from.
  root     :: t
  -- | The smaller children of a tile.
  children :: t -> [t]
  -- | The unique parent of a tile.
  parent :: t -> Maybe t
  -- | A rectangle that completely encloses the tile.
  exterior :: t -> Rectangle
  -- | A rectangle that is completely enclosed by the tile.
  interior :: t -> Rectangle
  -- | Test if a rectangle completely encloses the tile.
  inside   :: t -> Rectangle -> Bool
  -- | Test if a rectangle is completely enclosed by the tile.
  encloses :: t -> Rectangle -> Bool
  -- | Test if a rectangle is completely disjoint from the tile.
  outside  :: t -> Rectangle -> Bool
  -- | Test if a rectangle has any overlap with the tile.
  overlaps :: t -> Rectangle -> Bool
  -- | Generate a tiling that completely fills the given rectangle.
  --
  --   Preconditions:
  --
  --     > t `encloses` r
  --     > n >= 0
  --
  tile     :: t -> Rectangle -> Int  -> [t]
  tile     =  tileDefault

-- | Default implementation for 'tile'.
tileDefault :: Tiling t => t -> Rectangle -> Int -> [t]
tileDefault t r n
  | n >= 0 = uncurry (++) $ iterate step ([t], []) !! n
  | otherwise = error "Data.Tiling.Class.tileDefault: not (n >= 0)"
  where
    step (es, is) =
      let is' = concatMap children is
          es' = concatMap children es
          (is'', es'') = partition (`inside` r) . filter (`overlaps` r) $ es'
      in (es'', is'' ++ is')

-- | An axis-aligned rectangle with 'Rational' coordinates.
--
--   Invariant:
--
--   > westEdge r <= eastEdge r && southEdge r <= northEdge r
--
--   For substitution tilings that contain irrational lengths and/or scale
--   factors, the intention is that the implementations of 'exterior'
--   and 'interior' provide reasonably tight bounds, within a percent
--   or two, say, while the data type maintains full precision internally
--   (perhaps using algebraic field extensions over 'Rational').
data Rectangle = Rectangle{ northEdge, southEdge, eastEdge, westEdge :: !Rational }
  deriving (Eq, Ord, Read, Show, Data, Typeable)

-- | Create a valid rectangle, sorting the edges to meet the invariant.
rectangle :: Rational {- ^ x0 -} -> Rational {- ^ x1 -} -> Rational {- ^ y0 -} -> Rational {- ^ y1 -} -> Rectangle {- ^ rectangle -}
rectangle x0 x1 y0 y1 = Rectangle
  { northEdge = y0 `max` y1, southEdge = y0 `min` y1
  , eastEdge  = x0 `max` x1, westEdge  = x0 `min` x1
  }

-- | Check if a rectangle is inside another rectangle.  The comparison
--   is not strict, so that a rectangle is inside itself.
insideR :: Rectangle -> Rectangle -> Bool
insideR p q
  =  northEdge p <= northEdge q
  && southEdge p >= southEdge q
  && eastEdge  p <= eastEdge  q
  && westEdge  p >= westEdge  q

-- | Check if a rectangle is disjoint from another rectangle.  The comparison
--   is strict, so that neighbouring rectangles that share an edge will
--   not be outside each other.
outsideR :: Rectangle -> Rectangle -> Bool
outsideR p q
  =  northEdge p < southEdge q
  || southEdge p > northEdge q
  || eastEdge  p < westEdge  q
  || westEdge  p > eastEdge  q

-- | Check if a rectangle overlaps with another rectangle.  The comparison
--   is not strict, so that neighbouring rectangles that share an edge
--   will overlap each other.
overlapsR :: Rectangle -> Rectangle -> Bool
overlapsR p q = not (p `outsideR` q)