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

module Math.Geometry.Grid.SquareInternal where

import Prelude hiding (null)

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

data SquareDirection = North | East | South | West
deriving (Show, Eq)

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

instance Grid UnboundedSquareGrid where
type Index UnboundedSquareGrid = (Int, Int)
type Direction UnboundedSquareGrid = SquareDirection
indices _ = undefined
neighbours _ (x,y) = [(x,y+1), (x,y-1), (x+1,y), (x-1,y)]
distance _ (x1, y1) (x2, y2) = abs (x2-x1) + abs (y2-y1)
contains _ _ = True
directionTo _ (x1, y1) (x2, y2) = f1 . f2 . f3 . f4 \$ []
where f1 ds =  if y2 > y1 then North:ds else ds
f2 ds =  if y2 < y1 then South:ds else ds
f3 ds =  if x2 > x1 then East:ds else ds
f4 ds =  if x2 < x1 then West:ds else ds
null _ = False
nonNull _ = True

--
-- Rectangular grids with square tiles
--

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

instance Show RectSquareGrid where
show (RectSquareGrid (r,c) _) =
"rectSquareGrid " ++ show r ++ " " ++ show c

instance Grid RectSquareGrid where
type Index RectSquareGrid = (Int, Int)
type Direction RectSquareGrid = SquareDirection
indices (RectSquareGrid _ xs) = xs
neighbours = neighboursBasedOn UnboundedSquareGrid
distance = distanceBasedOn UnboundedSquareGrid
adjacentTilesToward g a@(x1, y1) (x2, y2) =
filter (\i -> g `contains` i && i /= a) \$ nub [(x1,y1+dy),(x1+dx,y1)]
where dx = signum (x2-x1)
dy = signum (y2-y1)
directionTo g x y = if g `contains` x && g `contains` y
then directionTo UnboundedSquareGrid x y
else []
contains g (x,y) = 0 <= x && x < c && 0 <= y && y < r
where (r, c) = size g

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

instance BoundedGrid RectSquareGrid where
tileSideCount _ = 4
boundary g = cartesianIndices . size \$ g
centre g = cartesianCentre . size \$ g

-- | @'rectSquareGrid' r c@ produces a rectangular grid with @r@ rows
--   and @c@ columns, using square tiles. If @r@ and @c@ are both
--   nonnegative, the resulting grid will have @r*c@ tiles. Otherwise,
--   the resulting grid will be null and the list of indices will be
--   null.
rectSquareGrid :: Int -> Int -> RectSquareGrid
rectSquareGrid r c =
RectSquareGrid (r,c) [(x,y) | x <- [0..c-1], y <- [0..r-1]]

--
-- Toroidal grids with square tiles.
--

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

instance Show TorSquareGrid where
show (TorSquareGrid (r,c) _) = "torSquareGrid " ++ show r ++ " " ++ show c

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

instance FiniteGrid TorSquareGrid where
type Size TorSquareGrid = (Int, Int)
size (TorSquareGrid s _) = s
maxPossibleDistance g@(TorSquareGrid (r,c) _) =
distance g (0,0) (c `div` 2, r `div` 2)

instance WrappedGrid TorSquareGrid where
normalise g (x,y) = (x `mod` c, y `mod` r)
where (r, c) = size g
denormalise g b = nub [ (x-c,y+r), (x,y+r), (x+c,y+r),
(x-c,y),   (x,y),   (x+c,y),
(x-c,y-r), (x,y-r), (x+c,y-r) ]
where (r, c) = size g
(x, y) = normalise g b

-- | @'torSquareGrid' r c@ returns a toroidal grid with @r@
--   rows and @c@ columns, using square tiles. If @r@ and @c@ are
--   both nonnegative, the resulting grid will have @r*c@ tiles. Otherwise,
--   the resulting grid will be null and the list of indices will be null.
torSquareGrid :: Int -> Int -> TorSquareGrid
torSquareGrid r c = TorSquareGrid (r,c) [(x, y) | x <- [0..c-1], y <- [0..r-1]]

```