{-# 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)