------------------------------------------------------------------------
-- |
-- Module      :  Math.Geometry.SquareGridInternal
-- Copyright   :  (c) Amy de Buitléir 2012-2019
-- License     :  BSD-style
-- 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 (Int -> SquareDirection -> ShowS
[SquareDirection] -> ShowS
SquareDirection -> String
(Int -> SquareDirection -> ShowS)
-> (SquareDirection -> String)
-> ([SquareDirection] -> ShowS)
-> Show SquareDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SquareDirection] -> ShowS
$cshowList :: [SquareDirection] -> ShowS
show :: SquareDirection -> String
$cshow :: SquareDirection -> String
showsPrec :: Int -> SquareDirection -> ShowS
$cshowsPrec :: Int -> SquareDirection -> ShowS
Show, SquareDirection -> SquareDirection -> Bool
(SquareDirection -> SquareDirection -> Bool)
-> (SquareDirection -> SquareDirection -> Bool)
-> Eq SquareDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SquareDirection -> SquareDirection -> Bool
$c/= :: SquareDirection -> SquareDirection -> Bool
== :: SquareDirection -> SquareDirection -> Bool
$c== :: SquareDirection -> SquareDirection -> Bool
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 (UnboundedSquareGrid -> UnboundedSquareGrid -> Bool
(UnboundedSquareGrid -> UnboundedSquareGrid -> Bool)
-> (UnboundedSquareGrid -> UnboundedSquareGrid -> Bool)
-> Eq UnboundedSquareGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnboundedSquareGrid -> UnboundedSquareGrid -> Bool
$c/= :: UnboundedSquareGrid -> UnboundedSquareGrid -> Bool
== :: UnboundedSquareGrid -> UnboundedSquareGrid -> Bool
$c== :: UnboundedSquareGrid -> UnboundedSquareGrid -> Bool
Eq, Int -> UnboundedSquareGrid -> ShowS
[UnboundedSquareGrid] -> ShowS
UnboundedSquareGrid -> String
(Int -> UnboundedSquareGrid -> ShowS)
-> (UnboundedSquareGrid -> String)
-> ([UnboundedSquareGrid] -> ShowS)
-> Show UnboundedSquareGrid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnboundedSquareGrid] -> ShowS
$cshowList :: [UnboundedSquareGrid] -> ShowS
show :: UnboundedSquareGrid -> String
$cshow :: UnboundedSquareGrid -> String
showsPrec :: Int -> UnboundedSquareGrid -> ShowS
$cshowsPrec :: Int -> UnboundedSquareGrid -> ShowS
Show, (forall x. UnboundedSquareGrid -> Rep UnboundedSquareGrid x)
-> (forall x. Rep UnboundedSquareGrid x -> UnboundedSquareGrid)
-> Generic UnboundedSquareGrid
forall x. Rep UnboundedSquareGrid x -> UnboundedSquareGrid
forall x. UnboundedSquareGrid -> Rep UnboundedSquareGrid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnboundedSquareGrid x -> UnboundedSquareGrid
$cfrom :: forall x. UnboundedSquareGrid -> Rep UnboundedSquareGrid x
Generic)

instance Grid UnboundedSquareGrid where
  type Index UnboundedSquareGrid = (Int, Int)
  type Direction UnboundedSquareGrid = SquareDirection
  indices :: UnboundedSquareGrid -> [Index UnboundedSquareGrid]
indices UnboundedSquareGrid
_ = [Index UnboundedSquareGrid]
forall a. HasCallStack => a
undefined
  neighbours :: UnboundedSquareGrid
-> Index UnboundedSquareGrid -> [Index UnboundedSquareGrid]
neighbours UnboundedSquareGrid
_ (x,y) = [(Int
x,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1), (Int
x,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1), (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
y), (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
y)]
  distance :: UnboundedSquareGrid
-> Index UnboundedSquareGrid -> Index UnboundedSquareGrid -> Int
distance UnboundedSquareGrid
_ (x1, y1) (x2, y2) = Int -> Int
forall a. Num a => a -> a
abs (Int
x2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Num a => a -> a
abs (Int
y2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
y1)
  contains :: UnboundedSquareGrid -> Index UnboundedSquareGrid -> Bool
contains UnboundedSquareGrid
_ Index UnboundedSquareGrid
_ = Bool
True
  directionTo :: UnboundedSquareGrid
-> Index UnboundedSquareGrid
-> Index UnboundedSquareGrid
-> [Direction UnboundedSquareGrid]
directionTo UnboundedSquareGrid
_ (x1, y1) (x2, y2) = [SquareDirection] -> [SquareDirection]
f1 ([SquareDirection] -> [SquareDirection])
-> ([SquareDirection] -> [SquareDirection])
-> [SquareDirection]
-> [SquareDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SquareDirection] -> [SquareDirection]
f2 ([SquareDirection] -> [SquareDirection])
-> ([SquareDirection] -> [SquareDirection])
-> [SquareDirection]
-> [SquareDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SquareDirection] -> [SquareDirection]
f3 ([SquareDirection] -> [SquareDirection])
-> ([SquareDirection] -> [SquareDirection])
-> [SquareDirection]
-> [SquareDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SquareDirection] -> [SquareDirection]
f4 ([SquareDirection] -> [SquareDirection])
-> [SquareDirection] -> [SquareDirection]
forall a b. (a -> b) -> a -> b
$ []
    where f1 :: [SquareDirection] -> [SquareDirection]
f1 [SquareDirection]
ds =  if Int
y2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y1 then SquareDirection
NorthSquareDirection -> [SquareDirection] -> [SquareDirection]
forall a. a -> [a] -> [a]
:[SquareDirection]
ds else [SquareDirection]
ds
          f2 :: [SquareDirection] -> [SquareDirection]
f2 [SquareDirection]
ds =  if Int
y2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y1 then SquareDirection
SouthSquareDirection -> [SquareDirection] -> [SquareDirection]
forall a. a -> [a] -> [a]
:[SquareDirection]
ds else [SquareDirection]
ds
          f3 :: [SquareDirection] -> [SquareDirection]
f3 [SquareDirection]
ds =  if Int
x2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
x1 then SquareDirection
EastSquareDirection -> [SquareDirection] -> [SquareDirection]
forall a. a -> [a] -> [a]
:[SquareDirection]
ds else [SquareDirection]
ds
          f4 :: [SquareDirection] -> [SquareDirection]
f4 [SquareDirection]
ds =  if Int
x2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x1 then SquareDirection
WestSquareDirection -> [SquareDirection] -> [SquareDirection]
forall a. a -> [a] -> [a]
:[SquareDirection]
ds else [SquareDirection]
ds
  null :: UnboundedSquareGrid -> Bool
null UnboundedSquareGrid
_ = Bool
False
  nonNull :: UnboundedSquareGrid -> Bool
nonNull UnboundedSquareGrid
_ = Bool
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  (RectSquareGrid -> RectSquareGrid -> Bool
(RectSquareGrid -> RectSquareGrid -> Bool)
-> (RectSquareGrid -> RectSquareGrid -> Bool) -> Eq RectSquareGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RectSquareGrid -> RectSquareGrid -> Bool
$c/= :: RectSquareGrid -> RectSquareGrid -> Bool
== :: RectSquareGrid -> RectSquareGrid -> Bool
$c== :: RectSquareGrid -> RectSquareGrid -> Bool
Eq, (forall x. RectSquareGrid -> Rep RectSquareGrid x)
-> (forall x. Rep RectSquareGrid x -> RectSquareGrid)
-> Generic RectSquareGrid
forall x. Rep RectSquareGrid x -> RectSquareGrid
forall x. RectSquareGrid -> Rep RectSquareGrid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RectSquareGrid x -> RectSquareGrid
$cfrom :: forall x. RectSquareGrid -> Rep RectSquareGrid x
Generic)

instance Show RectSquareGrid where 
  show :: RectSquareGrid -> String
show (RectSquareGrid (Int
r,Int
c) [(Int, Int)]
_) = 
    String
"rectSquareGrid " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c

instance Grid RectSquareGrid where
  type Index RectSquareGrid = (Int, Int)
  type Direction RectSquareGrid = SquareDirection
  indices :: RectSquareGrid -> [Index RectSquareGrid]
indices (RectSquareGrid (Int, Int)
_ [(Int, Int)]
xs) = [(Int, Int)]
[Index RectSquareGrid]
xs
  neighbours :: RectSquareGrid -> Index RectSquareGrid -> [Index RectSquareGrid]
neighbours = UnboundedSquareGrid
-> RectSquareGrid -> Index RectSquareGrid -> [Index RectSquareGrid]
forall u g.
(Eq (Index u), Grid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> [Index g]
neighboursBasedOn UnboundedSquareGrid
UnboundedSquareGrid
  distance :: RectSquareGrid
-> Index RectSquareGrid -> Index RectSquareGrid -> Int
distance = UnboundedSquareGrid
-> RectSquareGrid
-> Index RectSquareGrid
-> Index RectSquareGrid
-> Int
forall g u.
(Eq (Index g), Grid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> Index g -> Int
distanceBasedOn UnboundedSquareGrid
UnboundedSquareGrid
  adjacentTilesToward :: RectSquareGrid
-> Index RectSquareGrid
-> Index RectSquareGrid
-> [Index RectSquareGrid]
adjacentTilesToward RectSquareGrid
g a :: Index RectSquareGrid
a@(x1, y1) (x2, y2) = 
    ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int, Int)
i -> RectSquareGrid
g RectSquareGrid -> Index RectSquareGrid -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains` (Int, Int)
Index RectSquareGrid
i Bool -> Bool -> Bool
&& (Int, Int)
i (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int, Int)
Index RectSquareGrid
a) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a]
nub [(Int
x1,Int
y1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dy),(Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dx,Int
y1)]
      where dx :: Int
dx = Int -> Int
forall a. Num a => a -> a
signum (Int
x2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x1)
            dy :: Int
dy = Int -> Int
forall a. Num a => a -> a
signum (Int
y2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
y1)
  directionTo :: RectSquareGrid
-> Index RectSquareGrid
-> Index RectSquareGrid
-> [Direction RectSquareGrid]
directionTo RectSquareGrid
g Index RectSquareGrid
x Index RectSquareGrid
y = if RectSquareGrid
g RectSquareGrid -> Index RectSquareGrid -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains` Index RectSquareGrid
x Bool -> Bool -> Bool
&& RectSquareGrid
g RectSquareGrid -> Index RectSquareGrid -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains` Index RectSquareGrid
y
                        then UnboundedSquareGrid
-> Index UnboundedSquareGrid
-> Index UnboundedSquareGrid
-> [Direction UnboundedSquareGrid]
forall g. Grid g => g -> Index g -> Index g -> [Direction g]
directionTo UnboundedSquareGrid
UnboundedSquareGrid Index RectSquareGrid
Index UnboundedSquareGrid
x Index RectSquareGrid
Index UnboundedSquareGrid
y
                        else []
  contains :: RectSquareGrid -> Index RectSquareGrid -> Bool
contains RectSquareGrid
g (x,y) = Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
c Bool -> Bool -> Bool
&& Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
y Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
r
    where (Int
r, Int
c) = RectSquareGrid -> Size RectSquareGrid
forall g. FiniteGrid g => g -> Size g
size RectSquareGrid
g

instance FiniteGrid RectSquareGrid where
  type Size RectSquareGrid = (Int, Int)
  size :: RectSquareGrid -> Size RectSquareGrid
size (RectSquareGrid (Int, Int)
s [(Int, Int)]
_) = (Int, Int)
Size RectSquareGrid
s
  maxPossibleDistance :: RectSquareGrid -> Int
maxPossibleDistance g :: RectSquareGrid
g@(RectSquareGrid (Int
r,Int
c) [(Int, Int)]
_) = 
    RectSquareGrid
-> Index RectSquareGrid -> Index RectSquareGrid -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance RectSquareGrid
g (Int
0,Int
0) (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

instance BoundedGrid RectSquareGrid where
  tileSideCount :: RectSquareGrid -> Int
tileSideCount RectSquareGrid
_ = Int
4
  boundary :: RectSquareGrid -> [Index RectSquareGrid]
boundary RectSquareGrid
g = (Int, Int) -> [(Int, Int)]
forall r c.
(Enum r, Enum c, Num r, Num c, Ord r, Ord c) =>
(r, c) -> [(c, r)]
cartesianIndices ((Int, Int) -> [(Int, Int)])
-> (RectSquareGrid -> (Int, Int)) -> RectSquareGrid -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RectSquareGrid -> (Int, Int)
forall g. FiniteGrid g => g -> Size g
size (RectSquareGrid -> [(Int, Int)]) -> RectSquareGrid -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ RectSquareGrid
g
  centre :: RectSquareGrid -> [Index RectSquareGrid]
centre RectSquareGrid
g = (Int, Int) -> [(Int, Int)]
cartesianCentre ((Int, Int) -> [(Int, Int)])
-> (RectSquareGrid -> (Int, Int)) -> RectSquareGrid -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RectSquareGrid -> (Int, Int)
forall g. FiniteGrid g => g -> Size g
size (RectSquareGrid -> [(Int, Int)]) -> RectSquareGrid -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ RectSquareGrid
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 :: Int -> Int -> RectSquareGrid
rectSquareGrid Int
r Int
c = 
  (Int, Int) -> [(Int, Int)] -> RectSquareGrid
RectSquareGrid (Int
r,Int
c) [(Int
x,Int
y) | Int
x <- [Int
0..Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1], Int
y <- [Int
0..Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
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  (TorSquareGrid -> TorSquareGrid -> Bool
(TorSquareGrid -> TorSquareGrid -> Bool)
-> (TorSquareGrid -> TorSquareGrid -> Bool) -> Eq TorSquareGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TorSquareGrid -> TorSquareGrid -> Bool
$c/= :: TorSquareGrid -> TorSquareGrid -> Bool
== :: TorSquareGrid -> TorSquareGrid -> Bool
$c== :: TorSquareGrid -> TorSquareGrid -> Bool
Eq, (forall x. TorSquareGrid -> Rep TorSquareGrid x)
-> (forall x. Rep TorSquareGrid x -> TorSquareGrid)
-> Generic TorSquareGrid
forall x. Rep TorSquareGrid x -> TorSquareGrid
forall x. TorSquareGrid -> Rep TorSquareGrid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TorSquareGrid x -> TorSquareGrid
$cfrom :: forall x. TorSquareGrid -> Rep TorSquareGrid x
Generic)

instance Show TorSquareGrid where 
  show :: TorSquareGrid -> String
show (TorSquareGrid (Int
r,Int
c) [(Int, Int)]
_) = String
"torSquareGrid " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c

instance Grid TorSquareGrid where
  type Index TorSquareGrid = (Int, Int)
  type Direction TorSquareGrid = SquareDirection
  indices :: TorSquareGrid -> [Index TorSquareGrid]
indices (TorSquareGrid (Int, Int)
_ [(Int, Int)]
xs) = [(Int, Int)]
[Index TorSquareGrid]
xs
  neighbours :: TorSquareGrid -> Index TorSquareGrid -> [Index TorSquareGrid]
neighbours = UnboundedSquareGrid
-> TorSquareGrid -> Index TorSquareGrid -> [Index TorSquareGrid]
forall g u.
(Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> [Index g]
neighboursWrappedBasedOn UnboundedSquareGrid
UnboundedSquareGrid
  neighbour :: TorSquareGrid
-> Index TorSquareGrid
-> Direction TorSquareGrid
-> Maybe (Index TorSquareGrid)
neighbour = UnboundedSquareGrid
-> TorSquareGrid
-> Index TorSquareGrid
-> Direction TorSquareGrid
-> Maybe (Index TorSquareGrid)
forall g u.
(Eq (Index g), Eq (Direction g), WrappedGrid g, Grid u,
 Index g ~ Index u, Direction g ~ Direction u) =>
u -> g -> Index g -> Direction g -> Maybe (Index g)
neighbourWrappedBasedOn UnboundedSquareGrid
UnboundedSquareGrid
  distance :: TorSquareGrid -> Index TorSquareGrid -> Index TorSquareGrid -> Int
distance = UnboundedSquareGrid
-> TorSquareGrid
-> Index TorSquareGrid
-> Index TorSquareGrid
-> Int
forall g u.
(Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> Index g -> Int
distanceWrappedBasedOn UnboundedSquareGrid
UnboundedSquareGrid
  directionTo :: TorSquareGrid
-> Index TorSquareGrid
-> Index TorSquareGrid
-> [Direction TorSquareGrid]
directionTo = UnboundedSquareGrid
-> TorSquareGrid
-> Index TorSquareGrid
-> Index TorSquareGrid
-> [Direction TorSquareGrid]
forall g u.
(Eq (Index g), Eq (Direction g), WrappedGrid g, Grid u,
 Index g ~ Index u, Direction g ~ Direction u) =>
u -> g -> Index g -> Index g -> [Direction g]
directionToWrappedBasedOn UnboundedSquareGrid
UnboundedSquareGrid
  isAdjacent :: TorSquareGrid -> Index TorSquareGrid -> Index TorSquareGrid -> Bool
isAdjacent TorSquareGrid
g Index TorSquareGrid
a Index TorSquareGrid
b = TorSquareGrid -> Index TorSquareGrid -> Index TorSquareGrid -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance TorSquareGrid
g Index TorSquareGrid
a Index TorSquareGrid
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
  contains :: TorSquareGrid -> Index TorSquareGrid -> Bool
contains TorSquareGrid
_ Index TorSquareGrid
_ = Bool
True

instance FiniteGrid TorSquareGrid where
  type Size TorSquareGrid = (Int, Int)
  size :: TorSquareGrid -> Size TorSquareGrid
size (TorSquareGrid (Int, Int)
s [(Int, Int)]
_) = (Int, Int)
Size TorSquareGrid
s
  maxPossibleDistance :: TorSquareGrid -> Int
maxPossibleDistance g :: TorSquareGrid
g@(TorSquareGrid (Int
r,Int
c) [(Int, Int)]
_) =
    TorSquareGrid -> Index TorSquareGrid -> Index TorSquareGrid -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance TorSquareGrid
g (Int
0,Int
0) (Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2, Int
r Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)

instance WrappedGrid TorSquareGrid where
  normalise :: TorSquareGrid -> Index TorSquareGrid -> Index TorSquareGrid
normalise TorSquareGrid
g (x,y) = (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
c, Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
r)
    where (Int
r, Int
c) = TorSquareGrid -> Size TorSquareGrid
forall g. FiniteGrid g => g -> Size g
size TorSquareGrid
g
  denormalise :: TorSquareGrid -> Index TorSquareGrid -> [Index TorSquareGrid]
denormalise TorSquareGrid
g Index TorSquareGrid
b = [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a]
nub [ (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
c,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
r), (Int
x,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
r), (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
c,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
r),
                          (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
c,Int
y),   (Int
x,Int
y),   (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
c,Int
y),
                          (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
c,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r), (Int
x,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r), (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
c,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r) ]
    where (Int
r, Int
c) = TorSquareGrid -> Size TorSquareGrid
forall g. FiniteGrid g => g -> Size g
size TorSquareGrid
g
          (Int
x, Int
y) = TorSquareGrid -> Index TorSquareGrid -> Index TorSquareGrid
forall g. WrappedGrid g => g -> Index g -> Index g
normalise TorSquareGrid
g Index TorSquareGrid
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 :: Int -> Int -> TorSquareGrid
torSquareGrid Int
r Int
c = (Int, Int) -> [(Int, Int)] -> TorSquareGrid
TorSquareGrid (Int
r,Int
c) [(Int
x, Int
y) | Int
x <- [Int
0..Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1], Int
y <- [Int
0..Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]