------------------------------------------------------------------------
-- |
-- Module      :  Math.Geometry.TriGridInternal
-- Copyright   :  (c) Amy de Buitléir 2012-2017
-- License     :  BSD-style
-- Maintainer  :  amy@nualeargais.ie
-- Stability   :  experimental
-- Portability :  portable
--
-- A module containing private @TriGrid@ internals. Most developers 
-- should use @TriGrid@ instead. This module is subject to change 
-- without notice.
--
------------------------------------------------------------------------
{-# LANGUAGE TypeFamilies, FlexibleContexts, DeriveGeneric #-}

module Math.Geometry.Grid.TriangularInternal where

import Prelude hiding (null)

import Data.List (nub)
import GHC.Generics (Generic)
import Math.Geometry.GridInternal

data TriDirection = South | Northwest | Northeast |
                      North | Southeast | Southwest
                        deriving (Show, Eq, Generic)

-- | An unbounded grid with triangular tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data UnboundedTriGrid = UnboundedTriGrid deriving (Eq, Show, Generic)

instance Grid UnboundedTriGrid where
  type Index UnboundedTriGrid = (Int, Int)
  type Direction UnboundedTriGrid = TriDirection
  indices _ = undefined
  neighbours _ (x,y) = if even y
                         then [(x-1,y+1), (x+1,y+1), (x+1,y-1)]
                         else [(x-1,y-1), (x-1,y+1), (x+1,y-1)]
  distance _ (x1, y1) (x2, y2) =
    maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)]
      where z1 = triZ x1 y1
            z2 = triZ x2 y2
  contains _ _ = True
  null _ = False
  nonNull _ = True
  directionTo _ (x1, y1) (x2, y2) =
    if even y1
      then f1 . f2 . f3 $ []
      else f4 . f5 . f6 $ []
    where f1 ds =  if y2 < y1 then South:ds else ds
          f2 ds =  if x2 < x1 then Northwest:ds else ds
          f3 ds =  if z2 < z1 then Northeast:ds else ds
          f4 ds =  if y2 > y1 then North:ds else ds
          f5 ds =  if x2 > x1 then Southeast:ds else ds
          f6 ds =  if z2 > z1 then Southwest:ds else ds
          z1 = triZ x1 y1
          z2 = triZ x2 y2


-- | For triangular tiles, it is convenient to define a third component 
--   z.
triZ :: Int -> Int -> Int
triZ x y = if even y then -x - y else -x - y + 1

--
-- Triangular grids with triangular tiles
--

-- | A triangular grid with triangular tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data TriTriGrid = TriTriGrid Int [(Int, Int)] deriving (Eq, Generic)

instance Show TriTriGrid where
  show (TriTriGrid s _) = "triTriGrid " ++ show s

instance Grid TriTriGrid where
  type Index TriTriGrid = (Int, Int)
  type Direction TriTriGrid = TriDirection
  indices (TriTriGrid _ xs) = xs
  neighbours = neighboursBasedOn UnboundedTriGrid
  distance = distanceBasedOn UnboundedTriGrid
  contains (TriTriGrid s _) (x, y) = inTriTriGrid (x,y) s
  directionTo = directionToBasedOn UnboundedTriGrid

inTriTriGrid :: (Int, Int) -> Int -> Bool
inTriTriGrid (x, y) s = x >= 0 && y >= 0 && even (x+y) && abs z <= 2*s-2
  where z = triZ x y

instance FiniteGrid TriTriGrid where
  type Size TriTriGrid = Int
  size (TriTriGrid s _) = s
  maxPossibleDistance g@(TriTriGrid s _) = distance g (0,0) (2*s-2,0)

instance BoundedGrid TriTriGrid where
  tileSideCount _ = 3
  boundary g = west ++ east ++ south
    where s = size g
          west = [(0,k) | k <- [0,2..2*s-2]]
          east = [(k,2*s-2-k) | k <- [2,4..2*s-2]]
          south = [(k,0) | k <- [2*s-4,2*s-6..2]]
  centre g = case s `mod` 3 of
    0 -> trefoilWithTop (k-1,k+1) where k = (2*s) `div` 3
    1 -> [(k,k)] where k = (2*(s-1)) `div` 3
    2 -> [(k+1,k+1)] where k = (2*(s-2)) `div` 3
    _ -> error "This will never happen."
    where s = size g
          trefoilWithTop (i,j) = [(i,j), (i+2, j-2), (i,j-2)]

-- | @'triTriGrid' s@ returns a triangular grid with sides of 
--   length @s@, using triangular tiles. If @s@ is nonnegative, the 
--   resulting grid will have @s^2@ tiles. Otherwise, the resulting grid
--   will be null and the list of indices will be null.
triTriGrid :: Int -> TriTriGrid
triTriGrid s =
  TriTriGrid s [(xx,yy) | xx <- [0..2*(s-1)],
                          yy <- [0..2*(s-1)],
                          (xx,yy) `inTriTriGrid` s]

--
-- Parallelogrammatical grids with triangular tiles
--

-- | A Parallelogrammatical grid with triangular tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data ParaTriGrid = ParaTriGrid (Int, Int) [(Int, Int)]
  deriving  (Eq, Generic)

instance Show ParaTriGrid where
  show (ParaTriGrid (r,c) _) = "paraTriGrid " ++ show r ++ " " ++ show c

instance Grid ParaTriGrid where
  type Index ParaTriGrid = (Int, Int)
  type Direction ParaTriGrid = TriDirection
  indices (ParaTriGrid _ xs) = xs
  neighbours = neighboursBasedOn UnboundedTriGrid
  distance = distanceBasedOn UnboundedTriGrid
  directionTo = directionToBasedOn UnboundedTriGrid
  contains g (x,y) = 0 <= x && x < 2*c && 0 <= y && y < 2*r && even (x+y)
    where (r,c) = size g

instance FiniteGrid ParaTriGrid where
  type Size ParaTriGrid = (Int, Int)
  size (ParaTriGrid s _) = s
  maxPossibleDistance g@(ParaTriGrid (r,c) _) =
    distance g (0,0) (2*c-1,2*r-1)

instance BoundedGrid ParaTriGrid where
  tileSideCount _ = 3
  boundary g = west ++ north ++ east ++ south
    where (r,c) = size g
          west = [(0,k) | k <- [0,2..2*r-2], c>0]
          north = [(k,2*r-1) | k <- [1,3..2*c-1], r>0]
          east = [(2*c-1,k) | k <- [2*r-3,2*r-5..1], c>0]
          south = [(k,0) | k <- [2*c-2,2*c-4..2], r>0]
  centre g = f . size $ g
    where f (r,c)
            | odd r && odd c
                = [(c-1,r-1), (c,r)]
            | even r && even c && r == c
                = bowtie (c-1,r-1)
            | even r && even c && r > c
                = bowtie (c-1,r-3) ++ bowtie (c-1,r-1) ++ bowtie (c-1,r+1)
            | even r && even c && r < c
                = bowtie (c-3,r-1) ++ bowtie (c-1,r-1) ++ bowtie (c+1,r-1)
            | otherwise
                = [(c-1,r), (c,r-1)]
          bowtie (i,j) = [(i,j), (i+1,j+1)]

-- | @'paraTriGrid' r c@ returns a grid in the shape of a 
--   parallelogram with @r@ rows and @c@ columns, using triangular 
--   tiles. If @r@ and @c@ are both nonnegative, the resulting grid will
--   have @2*r*c@ tiles. Otherwise, the resulting grid will be null and
--   the list of indices will be null.
paraTriGrid :: Int -> Int -> ParaTriGrid
paraTriGrid r c =
  ParaTriGrid (r,c) (parallelogramIndices r c)

parallelogramIndices :: Int -> Int -> [(Int, Int)]
parallelogramIndices r c =
  [(x,y) | x <- [0..2*c-1], y <- [0..2*r-1], even (x+y)]

--
-- Rectangular grids with triangular tiles
--

-- | A rectangular grid with triangular tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data RectTriGrid = RectTriGrid (Int, Int) [(Int, Int)]
  deriving  (Eq, Generic)

instance Show RectTriGrid where
  show (RectTriGrid (r,c) _) = "rectTriGrid " ++ show r ++ " " ++ show c

instance Grid RectTriGrid where
  type Index RectTriGrid = (Int, Int)
  type Direction RectTriGrid = TriDirection
  indices (RectTriGrid _ xs) = xs
  neighbours = neighboursBasedOn UnboundedTriGrid
  distance = distanceBasedOn UnboundedTriGrid
  directionTo = directionToBasedOn UnboundedTriGrid
  -- TODO Implement faster "contains"

instance FiniteGrid RectTriGrid where
  type Size RectTriGrid = (Int, Int)
  size (RectTriGrid s _) = s
  maxPossibleDistance g = -- TODO: make more efficient
    maximum . map (distance g (0,0)) . indices $ g

instance BoundedGrid RectTriGrid where
  tileSideCount _ = 3

-- | @'rectTriGrid' r c@ returns a grid in the shape of a 
--   rectangle (with jagged edges) that has @r@ rows and @c@ columns, 
--   using triangular tiles. If @r@ and @c@ are both nonnegative, the 
--   resulting grid will have @2*r*c@ tiles. Otherwise, the resulting grid will be null and
--   the list of indices will be null.
rectTriGrid :: Int -> Int -> RectTriGrid
rectTriGrid r c = RectTriGrid (r,c) [(x,y) | y <- [0..2*r-1], x <- [xMin y .. xMax c y], even (x+y)]
  where xMin y = if even y then w else w+1
          where w = -2*((y+1) `div` 4)
        xMax c2 y = xMin y + 2*(c2-1)


--
-- Toroidal grids with triangular tiles
--

-- | A toroidal grid with triangular tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data TorTriGrid = TorTriGrid (Int, Int) [(Int, Int)]
  deriving  (Eq, Generic)

instance Show TorTriGrid where
  show (TorTriGrid (r,c) _) = "torTriGrid " ++ show r ++ " " ++ show c

instance Grid TorTriGrid where
  type Index TorTriGrid = (Int, Int)
  type Direction TorTriGrid = TriDirection
  indices (TorTriGrid _ xs) = xs
  neighbours = neighboursWrappedBasedOn UnboundedTriGrid
  neighbour = neighbourWrappedBasedOn UnboundedTriGrid
  distance = distanceWrappedBasedOn UnboundedTriGrid
  directionTo = directionToWrappedBasedOn UnboundedTriGrid
  isAdjacent g a b = distance g a b <= 1
  contains _ _ = True

instance FiniteGrid TorTriGrid where
  type Size TorTriGrid = (Int, Int)
  size (TorTriGrid s _) = s
  maxPossibleDistance g = -- TODO: make more efficient
    maximum . map (distance g (0,0)) . indices $ g

instance WrappedGrid TorTriGrid where
  normalise g (x,y) | y < 0     = normalise g (x,y+2*r)
                    | y > 2*r-1 = normalise g (x,y-2*r)
                    | x < 0     = normalise g (x+2*c,y)
                    | x > 2*c-1 = normalise g (x-2*c,y)
                    | otherwise = (x,y)
    where (r, c) = size g
  denormalise g a = nub [ (x-2*c,y+2*r), (x,y+2*r), (x+2*c,y+2*r),
                          (x-2*c,y),     (x,y),     (x+2*c,y),
                          (x-2*c,y-2*r), (x,y-2*r), (x+2*c,y-2*r) ]
    where (r, c) = size g
          (x, y) = normalise g a

-- | @'torTriGrid' r c@ returns a toroidal grid with @r@ rows and @c@
--   columns, using triangular tiles. The indexing method is the same as
--   for @ParaTriGrid@. If @r@ and @c@ are both nonnegative, the 
--   resulting grid will have @2*r*c@ tiles. Otherwise, the resulting
--   grid will be null and the list of indices will be null.
torTriGrid :: Int -> Int -> TorTriGrid
torTriGrid r c = TorTriGrid (r,c) (parallelogramIndices r c)

--
-- Cylindrical grids with triangular tiles
--

-- | A cylindrical grid with triangular tiles, where the cylinder is
--   along the y-axis.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data YCylTriGrid = YCylTriGrid (Int, Int) [(Int, Int)]
  deriving  (Eq, Generic)

instance Show YCylTriGrid where
  show (YCylTriGrid (r,c) _) = "yCylTriGrid " ++ show r ++ " " ++ show c

instance Grid YCylTriGrid where
  type Index YCylTriGrid = (Int, Int)
  type Direction YCylTriGrid = TriDirection
  indices (YCylTriGrid _ xs) = xs
  neighbours = neighboursWrappedBasedOn UnboundedTriGrid
  neighbour = neighbourWrappedBasedOn UnboundedTriGrid
  distance = distanceWrappedBasedOn UnboundedTriGrid
  directionTo = directionToWrappedBasedOn UnboundedTriGrid
  isAdjacent g a b = distance g a b <= 1
  contains g (x, y) = 0 <= y && y <= 2*r-1 && even (x+y)
    where (r, _) = size g

instance FiniteGrid YCylTriGrid where
  type Size YCylTriGrid = (Int, Int)
  size (YCylTriGrid s _) = s
  maxPossibleDistance g = -- TODO: make more efficient
    maximum . map (distance g (0,0)) . indices $ g

instance WrappedGrid YCylTriGrid where
  normalise g (x,y) | x < 0     = normalise g (x+2*c,y)
                    | x > 2*c-1 = normalise g (x-2*c,y)
                    | otherwise = (x,y)
    where (_, c) = size g
  denormalise g a = nub [ (x-2*c,y), (x,y), (x+2*c,y) ]
    where (_, c) = size g
          (x, y) = normalise g a

-- | @'yCylTriGrid' r c@ returns a cylindrical grid with @r@ rows and 
--   @c@ columns, using triangular tiles, where the cylinder is along 
--   the y-axis. The indexing method is the same as for @ParaTriGrid@. 
--   If @r@ and @c@ are both nonnegative, the resulting grid will have 
--   @2*r*c@ tiles. Otherwise, the resulting grid will be null and the 
--   list of indices will be null.
yCylTriGrid :: Int -> Int -> YCylTriGrid
yCylTriGrid r c = YCylTriGrid (r,c) (parallelogramIndices r c)

-- | A cylindrical grid with triangular tiles, where the cylinder is
--   along the x-axis.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data XCylTriGrid = XCylTriGrid (Int, Int) [(Int, Int)]
  deriving  (Eq, Generic)

instance Show XCylTriGrid where
  show (XCylTriGrid (r,c) _) = "yCylTriGrid " ++ show r ++ " " ++ show c

instance Grid XCylTriGrid where
  type Index XCylTriGrid = (Int, Int)
  type Direction XCylTriGrid = TriDirection
  indices (XCylTriGrid _ xs) = xs
  neighbours = neighboursWrappedBasedOn UnboundedTriGrid
  neighbour = neighbourWrappedBasedOn UnboundedTriGrid
  distance = distanceWrappedBasedOn UnboundedTriGrid
  directionTo = directionToWrappedBasedOn UnboundedTriGrid
  isAdjacent g a b = distance g a b <= 1
  contains g (x, y) = 0 <= x && x <= 2*c-1 && even (x+y)
    where (_, c) = size g

instance FiniteGrid XCylTriGrid where
  type Size XCylTriGrid = (Int, Int)
  size (XCylTriGrid s _) = s
  maxPossibleDistance g = -- TODO: make more efficient
    maximum . map (distance g (0,0)) . indices $ g

instance WrappedGrid XCylTriGrid where
  normalise g (x,y) | y < 0     = normalise g (x,y+2*r)
                    | y > 2*r-1 = normalise g (x,y-2*r)
                    | otherwise = (x,y)
    where (r, _) = size g
  denormalise g a = nub [ (x,y-2*r), (x,y), (x,y+2*r) ]
    where (r, _) = size g
          (x, y) = normalise g a

-- | @'xCylTriGrid' r c@ returns a cylindrical grid with @r@ rows and 
--   @c@ columns, using triangular tiles, where the cylinder is along 
--   the y-axis. The indexing method is the same as for @ParaTriGrid@. 
--   If @r@ and @c@ are both nonnegative, the resulting grid will have 
--   @2*r*c@ tiles. Otherwise, the resulting grid will be null and the 
--   list of indices will be null.
xCylTriGrid :: Int -> Int -> XCylTriGrid
xCylTriGrid r c = XCylTriGrid (r,c) (parallelogramIndices r c)