```------------------------------------------------------------------------
-- |
-- Module      :  Math.Geometry.TriGridInternal
-- 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 #-}

module Math.Geometry.Grid.TriangularInternal where

import Prelude hiding (null)

import Data.List (nub)
import Math.Geometry.GridInternal

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

-- | 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 Show

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

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

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

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

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

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

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

```