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

instance Grid UnboundedTriGrid where
  type Index UnboundedTriGrid = (Int, Int)
  type Direction UnboundedTriGrid = TriDirection
  indices :: UnboundedTriGrid -> [Index UnboundedTriGrid]
indices UnboundedTriGrid
_ = [Index UnboundedTriGrid]
forall a. HasCallStack => a
undefined
  neighbours :: UnboundedTriGrid
-> Index UnboundedTriGrid -> [Index UnboundedTriGrid]
neighbours UnboundedTriGrid
_ (x,y) = if Int -> Bool
forall a. Integral a => a -> Bool
even Int
y
                         then [(Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,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
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
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
                         else [(Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,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
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
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)]
  distance :: UnboundedTriGrid
-> Index UnboundedTriGrid -> Index UnboundedTriGrid -> Int
distance UnboundedTriGrid
_ (x1, y1) (x2, y2) =
    [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int -> Int
forall a. Num a => a -> a
abs (Int
x2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x1), Int -> Int
forall a. Num a => a -> a
abs (Int
y2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
y1), Int -> Int
forall a. Num a => a -> a
abs(Int
z2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
z1)]
      where z1 :: Int
z1 = Int -> Int -> Int
triZ Int
x1 Int
y1
            z2 :: Int
z2 = Int -> Int -> Int
triZ Int
x2 Int
y2
  contains :: UnboundedTriGrid -> Index UnboundedTriGrid -> Bool
contains UnboundedTriGrid
_ Index UnboundedTriGrid
_ = Bool
True
  null :: UnboundedTriGrid -> Bool
null UnboundedTriGrid
_ = Bool
False
  nonNull :: UnboundedTriGrid -> Bool
nonNull UnboundedTriGrid
_ = Bool
True
  directionTo :: UnboundedTriGrid
-> Index UnboundedTriGrid
-> Index UnboundedTriGrid
-> [Direction UnboundedTriGrid]
directionTo UnboundedTriGrid
_ (x1, y1) (x2, y2) = 
    if Int -> Bool
forall a. Integral a => a -> Bool
even Int
y1
      then [TriDirection] -> [TriDirection]
f1 ([TriDirection] -> [TriDirection])
-> ([TriDirection] -> [TriDirection])
-> [TriDirection]
-> [TriDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TriDirection] -> [TriDirection]
f2 ([TriDirection] -> [TriDirection])
-> ([TriDirection] -> [TriDirection])
-> [TriDirection]
-> [TriDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TriDirection] -> [TriDirection]
f3 ([TriDirection] -> [TriDirection])
-> [TriDirection] -> [TriDirection]
forall a b. (a -> b) -> a -> b
$ []
      else [TriDirection] -> [TriDirection]
f4 ([TriDirection] -> [TriDirection])
-> ([TriDirection] -> [TriDirection])
-> [TriDirection]
-> [TriDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TriDirection] -> [TriDirection]
f5 ([TriDirection] -> [TriDirection])
-> ([TriDirection] -> [TriDirection])
-> [TriDirection]
-> [TriDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TriDirection] -> [TriDirection]
f6 ([TriDirection] -> [TriDirection])
-> [TriDirection] -> [TriDirection]
forall a b. (a -> b) -> a -> b
$ []
    where f1 :: [TriDirection] -> [TriDirection]
f1 [TriDirection]
ds =  if Int
y2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y1 then TriDirection
SouthTriDirection -> [TriDirection] -> [TriDirection]
forall a. a -> [a] -> [a]
:[TriDirection]
ds else [TriDirection]
ds
          f2 :: [TriDirection] -> [TriDirection]
f2 [TriDirection]
ds =  if Int
x2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x1 then TriDirection
NorthwestTriDirection -> [TriDirection] -> [TriDirection]
forall a. a -> [a] -> [a]
:[TriDirection]
ds else [TriDirection]
ds
          f3 :: [TriDirection] -> [TriDirection]
f3 [TriDirection]
ds =  if Int
z2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
z1 then TriDirection
NortheastTriDirection -> [TriDirection] -> [TriDirection]
forall a. a -> [a] -> [a]
:[TriDirection]
ds else [TriDirection]
ds
          f4 :: [TriDirection] -> [TriDirection]
f4 [TriDirection]
ds =  if Int
y2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y1 then TriDirection
NorthTriDirection -> [TriDirection] -> [TriDirection]
forall a. a -> [a] -> [a]
:[TriDirection]
ds else [TriDirection]
ds
          f5 :: [TriDirection] -> [TriDirection]
f5 [TriDirection]
ds =  if Int
x2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
x1 then TriDirection
SoutheastTriDirection -> [TriDirection] -> [TriDirection]
forall a. a -> [a] -> [a]
:[TriDirection]
ds else [TriDirection]
ds
          f6 :: [TriDirection] -> [TriDirection]
f6 [TriDirection]
ds =  if Int
z2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
z1 then TriDirection
SouthwestTriDirection -> [TriDirection] -> [TriDirection]
forall a. a -> [a] -> [a]
:[TriDirection]
ds else [TriDirection]
ds
          z1 :: Int
z1 = Int -> Int -> Int
triZ Int
x1 Int
y1
          z2 :: Int
z2 = Int -> Int -> Int
triZ Int
x2 Int
y2
          

-- | For triangular tiles, it is convenient to define a third component 
--   z.
triZ :: Int -> Int -> Int            
triZ :: Int -> Int -> Int
triZ Int
x Int
y = if Int -> Bool
forall a. Integral a => a -> Bool
even Int
y then -Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y else -Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 (TriTriGrid -> TriTriGrid -> Bool
(TriTriGrid -> TriTriGrid -> Bool)
-> (TriTriGrid -> TriTriGrid -> Bool) -> Eq TriTriGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TriTriGrid -> TriTriGrid -> Bool
$c/= :: TriTriGrid -> TriTriGrid -> Bool
== :: TriTriGrid -> TriTriGrid -> Bool
$c== :: TriTriGrid -> TriTriGrid -> Bool
Eq, (forall x. TriTriGrid -> Rep TriTriGrid x)
-> (forall x. Rep TriTriGrid x -> TriTriGrid) -> Generic TriTriGrid
forall x. Rep TriTriGrid x -> TriTriGrid
forall x. TriTriGrid -> Rep TriTriGrid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TriTriGrid x -> TriTriGrid
$cfrom :: forall x. TriTriGrid -> Rep TriTriGrid x
Generic)

instance Show TriTriGrid where 
  show :: TriTriGrid -> String
show (TriTriGrid Int
s [(Int, Int)]
_) = String
"triTriGrid " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s

instance Grid TriTriGrid where
  type Index TriTriGrid = (Int, Int)
  type Direction TriTriGrid = TriDirection
  indices :: TriTriGrid -> [Index TriTriGrid]
indices (TriTriGrid Int
_ [(Int, Int)]
xs) = [(Int, Int)]
[Index TriTriGrid]
xs
  neighbours :: TriTriGrid -> Index TriTriGrid -> [Index TriTriGrid]
neighbours = UnboundedTriGrid
-> TriTriGrid -> Index TriTriGrid -> [Index TriTriGrid]
forall u g.
(Eq (Index u), Grid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> [Index g]
neighboursBasedOn UnboundedTriGrid
UnboundedTriGrid
  distance :: TriTriGrid -> Index TriTriGrid -> Index TriTriGrid -> Int
distance = UnboundedTriGrid
-> TriTriGrid -> Index TriTriGrid -> Index TriTriGrid -> Int
forall g u.
(Eq (Index g), Grid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> Index g -> Int
distanceBasedOn UnboundedTriGrid
UnboundedTriGrid
  contains :: TriTriGrid -> Index TriTriGrid -> Bool
contains (TriTriGrid Int
s [(Int, Int)]
_) (x, y) = (Int, Int) -> Int -> Bool
inTriTriGrid (Int
x,Int
y) Int
s
  directionTo :: TriTriGrid
-> Index TriTriGrid -> Index TriTriGrid -> [Direction TriTriGrid]
directionTo = UnboundedTriGrid
-> TriTriGrid
-> Index TriTriGrid
-> Index TriTriGrid
-> [Direction TriTriGrid]
forall g u.
(Eq (Index g), Eq (Direction g), Grid g, Grid u, Index g ~ Index u,
 Direction g ~ Direction u) =>
u -> g -> Index g -> Index g -> [Direction g]
directionToBasedOn UnboundedTriGrid
UnboundedTriGrid

inTriTriGrid :: (Int, Int) -> Int -> Bool
inTriTriGrid :: (Int, Int) -> Int -> Bool
inTriTriGrid (Int
x, Int
y) Int
s = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
even (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y) Bool -> Bool -> Bool
&& Int -> Int
forall a. Num a => a -> a
abs Int
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2
  where z :: Int
z = Int -> Int -> Int
triZ Int
x Int
y

instance FiniteGrid TriTriGrid where
  type Size TriTriGrid = Int
  size :: TriTriGrid -> Size TriTriGrid
size (TriTriGrid Int
s [(Int, Int)]
_) = Int
Size TriTriGrid
s
  maxPossibleDistance :: TriTriGrid -> Int
maxPossibleDistance g :: TriTriGrid
g@(TriTriGrid Int
s [(Int, Int)]
_) = TriTriGrid -> Index TriTriGrid -> Index TriTriGrid -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance TriTriGrid
g (Int
0,Int
0) (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2,Int
0)

instance BoundedGrid TriTriGrid where
  tileSideCount :: TriTriGrid -> Int
tileSideCount TriTriGrid
_ = Int
3
  boundary :: TriTriGrid -> [Index TriTriGrid]
boundary TriTriGrid
g = [(Int, Int)]
west [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int, Int)]
east [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int, Int)]
south
    where s :: Size TriTriGrid
s = TriTriGrid -> Size TriTriGrid
forall g. FiniteGrid g => g -> Size g
size TriTriGrid
g
          west :: [(Int, Int)]
west = [(Int
0,Int
k) | Int
k <- [Int
0,Int
2..Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
Size TriTriGrid
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2]]
          east :: [(Int, Int)]
east = [(Int
k,Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
Size TriTriGrid
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) | Int
k <- [Int
2,Int
4..Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
Size TriTriGrid
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2]]
          south :: [(Int, Int)]
south = [(Int
k,Int
0) | Int
k <- [Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
Size TriTriGrid
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
4,Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
Size TriTriGrid
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
6..Int
2]]
  centre :: TriTriGrid -> [Index TriTriGrid]
centre TriTriGrid
g = case Int
Size TriTriGrid
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 of
    Int
0 -> (Int, Int) -> [(Int, Int)]
forall a a. (Num a, Num a) => (a, a) -> [(a, a)]
trefoilWithTop (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) where k :: Int
k = (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
Size TriTriGrid
s) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3
    Int
1 -> [(Int
k,Int
k)] where k :: Int
k = (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
Size TriTriGrid
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3
    Int
2 -> [(Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)] where k :: Int
k = (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
Size TriTriGrid
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3
    Int
_ -> String -> [(Int, Int)]
forall a. HasCallStack => String -> a
error String
"This will never happen."
    where s :: Size TriTriGrid
s = TriTriGrid -> Size TriTriGrid
forall g. FiniteGrid g => g -> Size g
size TriTriGrid
g
          trefoilWithTop :: (a, a) -> [(a, a)]
trefoilWithTop (a
i,a
j) = [(a
i,a
j), (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
2, a
ja -> a -> a
forall a. Num a => a -> a -> a
-a
2), (a
i,a
ja -> a -> a
forall a. Num a => a -> a -> a
-a
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 :: Int -> TriTriGrid
triTriGrid Int
s = 
  Int -> [(Int, Int)] -> TriTriGrid
TriTriGrid Int
s [(Int
xx,Int
yy) | Int
xx <- [Int
0..Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)], 
                          Int
yy <- [Int
0..Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)], 
                          (Int
xx,Int
yy) (Int, Int) -> Int -> Bool
`inTriTriGrid` Int
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  (ParaTriGrid -> ParaTriGrid -> Bool
(ParaTriGrid -> ParaTriGrid -> Bool)
-> (ParaTriGrid -> ParaTriGrid -> Bool) -> Eq ParaTriGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParaTriGrid -> ParaTriGrid -> Bool
$c/= :: ParaTriGrid -> ParaTriGrid -> Bool
== :: ParaTriGrid -> ParaTriGrid -> Bool
$c== :: ParaTriGrid -> ParaTriGrid -> Bool
Eq, (forall x. ParaTriGrid -> Rep ParaTriGrid x)
-> (forall x. Rep ParaTriGrid x -> ParaTriGrid)
-> Generic ParaTriGrid
forall x. Rep ParaTriGrid x -> ParaTriGrid
forall x. ParaTriGrid -> Rep ParaTriGrid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParaTriGrid x -> ParaTriGrid
$cfrom :: forall x. ParaTriGrid -> Rep ParaTriGrid x
Generic)

instance Show ParaTriGrid where 
  show :: ParaTriGrid -> String
show (ParaTriGrid (Int
r,Int
c) [(Int, Int)]
_) = String
"paraTriGrid " 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 ParaTriGrid where
  type Index ParaTriGrid = (Int, Int)
  type Direction ParaTriGrid = TriDirection
  indices :: ParaTriGrid -> [Index ParaTriGrid]
indices (ParaTriGrid (Int, Int)
_ [(Int, Int)]
xs) = [(Int, Int)]
[Index ParaTriGrid]
xs
  neighbours :: ParaTriGrid -> Index ParaTriGrid -> [Index ParaTriGrid]
neighbours = UnboundedTriGrid
-> ParaTriGrid -> Index ParaTriGrid -> [Index ParaTriGrid]
forall u g.
(Eq (Index u), Grid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> [Index g]
neighboursBasedOn UnboundedTriGrid
UnboundedTriGrid
  distance :: ParaTriGrid -> Index ParaTriGrid -> Index ParaTriGrid -> Int
distance = UnboundedTriGrid
-> ParaTriGrid -> Index ParaTriGrid -> Index ParaTriGrid -> Int
forall g u.
(Eq (Index g), Grid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> Index g -> Int
distanceBasedOn UnboundedTriGrid
UnboundedTriGrid
  directionTo :: ParaTriGrid
-> Index ParaTriGrid
-> Index ParaTriGrid
-> [Direction ParaTriGrid]
directionTo = UnboundedTriGrid
-> ParaTriGrid
-> Index ParaTriGrid
-> Index ParaTriGrid
-> [Direction ParaTriGrid]
forall g u.
(Eq (Index g), Eq (Direction g), Grid g, Grid u, Index g ~ Index u,
 Direction g ~ Direction u) =>
u -> g -> Index g -> Index g -> [Direction g]
directionToBasedOn UnboundedTriGrid
UnboundedTriGrid
  contains :: ParaTriGrid -> Index ParaTriGrid -> Bool
contains ParaTriGrid
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
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*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
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
even (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y)
    where (Int
r,Int
c) = ParaTriGrid -> Size ParaTriGrid
forall g. FiniteGrid g => g -> Size g
size ParaTriGrid
g

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

instance BoundedGrid ParaTriGrid where
  tileSideCount :: ParaTriGrid -> Int
tileSideCount ParaTriGrid
_ = Int
3
  boundary :: ParaTriGrid -> [Index ParaTriGrid]
boundary ParaTriGrid
g = [(Int, Int)]
west [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int, Int)]
north [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int, Int)]
east [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Int, Int)]
south
    where (Int
r,Int
c) = ParaTriGrid -> Size ParaTriGrid
forall g. FiniteGrid g => g -> Size g
size ParaTriGrid
g
          west :: [(Int, Int)]
west = [(Int
0,Int
k) | Int
k <- [Int
0,Int
2..Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2], Int
cInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0]
          north :: [(Int, Int)]
north = [(Int
k,Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) | Int
k <- [Int
1,Int
3..Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1], Int
rInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0]
          east :: [(Int, Int)]
east = [(Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
k) | Int
k <- [Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3,Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
5..Int
1], Int
cInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0]
          south :: [(Int, Int)]
south = [(Int
k,Int
0) | Int
k <- [Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2,Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
4..Int
2], Int
rInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0]
  centre :: ParaTriGrid -> [Index ParaTriGrid]
centre ParaTriGrid
g = (Int, Int) -> [(Int, Int)]
forall a. Integral a => (a, a) -> [(a, a)]
f ((Int, Int) -> [(Int, Int)])
-> (ParaTriGrid -> (Int, Int)) -> ParaTriGrid -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParaTriGrid -> (Int, Int)
forall g. FiniteGrid g => g -> Size g
size (ParaTriGrid -> [(Int, Int)]) -> ParaTriGrid -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ ParaTriGrid
g
    where f :: (a, a) -> [(a, a)]
f (a
r,a
c)
            | a -> Bool
forall a. Integral a => a -> Bool
odd a
r Bool -> Bool -> Bool
&& a -> Bool
forall a. Integral a => a -> Bool
odd a
c             
                = [(a
ca -> a -> a
forall a. Num a => a -> a -> a
-a
1,a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
1), (a
c,a
r)]
            | a -> Bool
forall a. Integral a => a -> Bool
even a
r Bool -> Bool -> Bool
&& a -> Bool
forall a. Integral a => a -> Bool
even a
c Bool -> Bool -> Bool
&& a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c 
                = (a, a) -> [(a, a)]
forall a a. (Num a, Num a) => (a, a) -> [(a, a)]
bowtie (a
ca -> a -> a
forall a. Num a => a -> a -> a
-a
1,a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
1)
            | a -> Bool
forall a. Integral a => a -> Bool
even a
r Bool -> Bool -> Bool
&& a -> Bool
forall a. Integral a => a -> Bool
even a
c Bool -> Bool -> Bool
&& a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
c  
                = (a, a) -> [(a, a)]
forall a a. (Num a, Num a) => (a, a) -> [(a, a)]
bowtie (a
ca -> a -> a
forall a. Num a => a -> a -> a
-a
1,a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
3) [(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++ (a, a) -> [(a, a)]
forall a a. (Num a, Num a) => (a, a) -> [(a, a)]
bowtie (a
ca -> a -> a
forall a. Num a => a -> a -> a
-a
1,a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
1) [(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++ (a, a) -> [(a, a)]
forall a a. (Num a, Num a) => (a, a) -> [(a, a)]
bowtie (a
ca -> a -> a
forall a. Num a => a -> a -> a
-a
1,a
ra -> a -> a
forall a. Num a => a -> a -> a
+a
1)
            | a -> Bool
forall a. Integral a => a -> Bool
even a
r Bool -> Bool -> Bool
&& a -> Bool
forall a. Integral a => a -> Bool
even a
c Bool -> Bool -> Bool
&& a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
c  
                = (a, a) -> [(a, a)]
forall a a. (Num a, Num a) => (a, a) -> [(a, a)]
bowtie (a
ca -> a -> a
forall a. Num a => a -> a -> a
-a
3,a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
1) [(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++ (a, a) -> [(a, a)]
forall a a. (Num a, Num a) => (a, a) -> [(a, a)]
bowtie (a
ca -> a -> a
forall a. Num a => a -> a -> a
-a
1,a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
1) [(a, a)] -> [(a, a)] -> [(a, a)]
forall a. [a] -> [a] -> [a]
++ (a, a) -> [(a, a)]
forall a a. (Num a, Num a) => (a, a) -> [(a, a)]
bowtie (a
ca -> a -> a
forall a. Num a => a -> a -> a
+a
1,a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
1)
            | Bool
otherwise                  
                = [(a
ca -> a -> a
forall a. Num a => a -> a -> a
-a
1,a
r), (a
c,a
ra -> a -> a
forall a. Num a => a -> a -> a
-a
1)]
          bowtie :: (a, a) -> [(a, a)]
bowtie (a
i,a
j) = [(a
i,a
j), (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1,a
ja -> a -> a
forall a. Num a => a -> a -> a
+a
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 :: Int -> Int -> ParaTriGrid
paraTriGrid Int
r Int
c = 
  (Int, Int) -> [(Int, Int)] -> ParaTriGrid
ParaTriGrid (Int
r,Int
c) (Int -> Int -> [(Int, Int)]
parallelogramIndices Int
r Int
c)

parallelogramIndices :: Int -> Int -> [(Int, Int)]
parallelogramIndices :: Int -> Int -> [(Int, Int)]
parallelogramIndices Int
r Int
c = 
  [(Int
x,Int
y) | Int
x <- [Int
0..Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1], Int
y <- [Int
0..Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1], Int -> Bool
forall a. Integral a => a -> Bool
even (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
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  (RectTriGrid -> RectTriGrid -> Bool
(RectTriGrid -> RectTriGrid -> Bool)
-> (RectTriGrid -> RectTriGrid -> Bool) -> Eq RectTriGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RectTriGrid -> RectTriGrid -> Bool
$c/= :: RectTriGrid -> RectTriGrid -> Bool
== :: RectTriGrid -> RectTriGrid -> Bool
$c== :: RectTriGrid -> RectTriGrid -> Bool
Eq, (forall x. RectTriGrid -> Rep RectTriGrid x)
-> (forall x. Rep RectTriGrid x -> RectTriGrid)
-> Generic RectTriGrid
forall x. Rep RectTriGrid x -> RectTriGrid
forall x. RectTriGrid -> Rep RectTriGrid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RectTriGrid x -> RectTriGrid
$cfrom :: forall x. RectTriGrid -> Rep RectTriGrid x
Generic)

instance Show RectTriGrid where 
  show :: RectTriGrid -> String
show (RectTriGrid (Int
r,Int
c) [(Int, Int)]
_) = String
"rectTriGrid " 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 RectTriGrid where
  type Index RectTriGrid = (Int, Int)
  type Direction RectTriGrid = TriDirection
  indices :: RectTriGrid -> [Index RectTriGrid]
indices (RectTriGrid (Int, Int)
_ [(Int, Int)]
xs) = [(Int, Int)]
[Index RectTriGrid]
xs
  neighbours :: RectTriGrid -> Index RectTriGrid -> [Index RectTriGrid]
neighbours = UnboundedTriGrid
-> RectTriGrid -> Index RectTriGrid -> [Index RectTriGrid]
forall u g.
(Eq (Index u), Grid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> [Index g]
neighboursBasedOn UnboundedTriGrid
UnboundedTriGrid
  distance :: RectTriGrid -> Index RectTriGrid -> Index RectTriGrid -> Int
distance = UnboundedTriGrid
-> RectTriGrid -> Index RectTriGrid -> Index RectTriGrid -> Int
forall g u.
(Eq (Index g), Grid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> Index g -> Int
distanceBasedOn UnboundedTriGrid
UnboundedTriGrid
  directionTo :: RectTriGrid
-> Index RectTriGrid
-> Index RectTriGrid
-> [Direction RectTriGrid]
directionTo = UnboundedTriGrid
-> RectTriGrid
-> Index RectTriGrid
-> Index RectTriGrid
-> [Direction RectTriGrid]
forall g u.
(Eq (Index g), Eq (Direction g), Grid g, Grid u, Index g ~ Index u,
 Direction g ~ Direction u) =>
u -> g -> Index g -> Index g -> [Direction g]
directionToBasedOn UnboundedTriGrid
UnboundedTriGrid
  -- TODO Implement faster "contains"

instance FiniteGrid RectTriGrid where
  type Size RectTriGrid = (Int, Int)
  size :: RectTriGrid -> Size RectTriGrid
size (RectTriGrid (Int, Int)
s [(Int, Int)]
_) = (Int, Int)
Size RectTriGrid
s
  maxPossibleDistance :: RectTriGrid -> Int
maxPossibleDistance RectTriGrid
g = -- TODO: make more efficient
    [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (RectTriGrid -> [Int]) -> RectTriGrid -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (RectTriGrid -> Index RectTriGrid -> Index RectTriGrid -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance RectTriGrid
g (Int
0,Int
0)) ([(Int, Int)] -> [Int])
-> (RectTriGrid -> [(Int, Int)]) -> RectTriGrid -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RectTriGrid -> [(Int, Int)]
forall g. Grid g => g -> [Index g]
indices (RectTriGrid -> Int) -> RectTriGrid -> Int
forall a b. (a -> b) -> a -> b
$ RectTriGrid
g

instance BoundedGrid RectTriGrid where
  tileSideCount :: RectTriGrid -> Int
tileSideCount RectTriGrid
_ = Int
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 :: Int -> Int -> RectTriGrid
rectTriGrid Int
r Int
c = (Int, Int) -> [(Int, Int)] -> RectTriGrid
RectTriGrid (Int
r,Int
c) [(Int
x,Int
y) | Int
y <- [Int
0..Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1], Int
x <- [Int -> Int
forall a. Integral a => a -> a
xMin Int
y .. Int -> Int -> Int
forall a. Integral a => a -> a -> a
xMax Int
c Int
y], Int -> Bool
forall a. Integral a => a -> Bool
even (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y)]
  where xMin :: a -> a
xMin a
y = if a -> Bool
forall a. Integral a => a -> Bool
even a
y then a
w else a
wa -> a -> a
forall a. Num a => a -> a -> a
+a
1
          where w :: a
w = -a
2a -> a -> a
forall a. Num a => a -> a -> a
*((a
ya -> a -> a
forall a. Num a => a -> a -> a
+a
1) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
4)
        xMax :: a -> a -> a
xMax a
c2 a
y = a -> a
forall a. Integral a => a -> a
xMin a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
2a -> a -> a
forall a. Num a => a -> a -> a
*(a
c2a -> a -> a
forall a. Num a => a -> a -> a
-a
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  (TorTriGrid -> TorTriGrid -> Bool
(TorTriGrid -> TorTriGrid -> Bool)
-> (TorTriGrid -> TorTriGrid -> Bool) -> Eq TorTriGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TorTriGrid -> TorTriGrid -> Bool
$c/= :: TorTriGrid -> TorTriGrid -> Bool
== :: TorTriGrid -> TorTriGrid -> Bool
$c== :: TorTriGrid -> TorTriGrid -> Bool
Eq, (forall x. TorTriGrid -> Rep TorTriGrid x)
-> (forall x. Rep TorTriGrid x -> TorTriGrid) -> Generic TorTriGrid
forall x. Rep TorTriGrid x -> TorTriGrid
forall x. TorTriGrid -> Rep TorTriGrid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TorTriGrid x -> TorTriGrid
$cfrom :: forall x. TorTriGrid -> Rep TorTriGrid x
Generic)

instance Show TorTriGrid where 
  show :: TorTriGrid -> String
show (TorTriGrid (Int
r,Int
c) [(Int, Int)]
_) = String
"torTriGrid " 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 TorTriGrid where
  type Index TorTriGrid = (Int, Int)
  type Direction TorTriGrid = TriDirection
  indices :: TorTriGrid -> [Index TorTriGrid]
indices (TorTriGrid (Int, Int)
_ [(Int, Int)]
xs) = [(Int, Int)]
[Index TorTriGrid]
xs
  neighbours :: TorTriGrid -> Index TorTriGrid -> [Index TorTriGrid]
neighbours = UnboundedTriGrid
-> TorTriGrid -> Index TorTriGrid -> [Index TorTriGrid]
forall g u.
(Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> [Index g]
neighboursWrappedBasedOn UnboundedTriGrid
UnboundedTriGrid
  neighbour :: TorTriGrid
-> Index TorTriGrid
-> Direction TorTriGrid
-> Maybe (Index TorTriGrid)
neighbour = UnboundedTriGrid
-> TorTriGrid
-> Index TorTriGrid
-> Direction TorTriGrid
-> Maybe (Index TorTriGrid)
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 UnboundedTriGrid
UnboundedTriGrid
  distance :: TorTriGrid -> Index TorTriGrid -> Index TorTriGrid -> Int
distance = UnboundedTriGrid
-> TorTriGrid -> Index TorTriGrid -> Index TorTriGrid -> Int
forall g u.
(Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> Index g -> Int
distanceWrappedBasedOn UnboundedTriGrid
UnboundedTriGrid
  directionTo :: TorTriGrid
-> Index TorTriGrid -> Index TorTriGrid -> [Direction TorTriGrid]
directionTo = UnboundedTriGrid
-> TorTriGrid
-> Index TorTriGrid
-> Index TorTriGrid
-> [Direction TorTriGrid]
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 UnboundedTriGrid
UnboundedTriGrid
  isAdjacent :: TorTriGrid -> Index TorTriGrid -> Index TorTriGrid -> Bool
isAdjacent TorTriGrid
g Index TorTriGrid
a Index TorTriGrid
b = TorTriGrid -> Index TorTriGrid -> Index TorTriGrid -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance TorTriGrid
g Index TorTriGrid
a Index TorTriGrid
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
  contains :: TorTriGrid -> Index TorTriGrid -> Bool
contains TorTriGrid
_ Index TorTriGrid
_ = Bool
True

instance FiniteGrid TorTriGrid where
  type Size TorTriGrid = (Int, Int)
  size :: TorTriGrid -> Size TorTriGrid
size (TorTriGrid (Int, Int)
s [(Int, Int)]
_) = (Int, Int)
Size TorTriGrid
s
  maxPossibleDistance :: TorTriGrid -> Int
maxPossibleDistance TorTriGrid
g = -- TODO: make more efficient
    [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (TorTriGrid -> [Int]) -> TorTriGrid -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (TorTriGrid -> Index TorTriGrid -> Index TorTriGrid -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance TorTriGrid
g (Int
0,Int
0)) ([(Int, Int)] -> [Int])
-> (TorTriGrid -> [(Int, Int)]) -> TorTriGrid -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TorTriGrid -> [(Int, Int)]
forall g. Grid g => g -> [Index g]
indices (TorTriGrid -> Int) -> TorTriGrid -> Int
forall a b. (a -> b) -> a -> b
$ TorTriGrid
g

instance WrappedGrid TorTriGrid where
  normalise :: TorTriGrid -> Index TorTriGrid -> Index TorTriGrid
normalise TorTriGrid
g (x,y) | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = TorTriGrid -> Index TorTriGrid -> Index TorTriGrid
forall g. WrappedGrid g => g -> Index g -> Index g
normalise TorTriGrid
g (Int
x,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r)
                    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 = TorTriGrid -> Index TorTriGrid -> Index TorTriGrid
forall g. WrappedGrid g => g -> Index g -> Index g
normalise TorTriGrid
g (Int
x,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r)
                    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = TorTriGrid -> Index TorTriGrid -> Index TorTriGrid
forall g. WrappedGrid g => g -> Index g -> Index g
normalise TorTriGrid
g (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c,Int
y)
                    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 = TorTriGrid -> Index TorTriGrid -> Index TorTriGrid
forall g. WrappedGrid g => g -> Index g -> Index g
normalise TorTriGrid
g (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c,Int
y)
                    | Bool
otherwise = (Int
x,Int
y)
    where (Int
r, Int
c) = TorTriGrid -> Size TorTriGrid
forall g. FiniteGrid g => g -> Size g
size TorTriGrid
g
  denormalise :: TorTriGrid -> Index TorTriGrid -> [Index TorTriGrid]
denormalise TorTriGrid
g Index TorTriGrid
a = [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a]
nub [ (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> 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
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r), (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r),
                          (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2Int -> 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
2Int -> 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
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2Int -> 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
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r), (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r) ]
    where (Int
r, Int
c) = TorTriGrid -> Size TorTriGrid
forall g. FiniteGrid g => g -> Size g
size TorTriGrid
g
          (Int
x, Int
y) = TorTriGrid -> Index TorTriGrid -> Index TorTriGrid
forall g. WrappedGrid g => g -> Index g -> Index g
normalise TorTriGrid
g Index TorTriGrid
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 :: Int -> Int -> TorTriGrid
torTriGrid Int
r Int
c = (Int, Int) -> [(Int, Int)] -> TorTriGrid
TorTriGrid (Int
r,Int
c) (Int -> Int -> [(Int, Int)]
parallelogramIndices Int
r Int
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  (YCylTriGrid -> YCylTriGrid -> Bool
(YCylTriGrid -> YCylTriGrid -> Bool)
-> (YCylTriGrid -> YCylTriGrid -> Bool) -> Eq YCylTriGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: YCylTriGrid -> YCylTriGrid -> Bool
$c/= :: YCylTriGrid -> YCylTriGrid -> Bool
== :: YCylTriGrid -> YCylTriGrid -> Bool
$c== :: YCylTriGrid -> YCylTriGrid -> Bool
Eq, (forall x. YCylTriGrid -> Rep YCylTriGrid x)
-> (forall x. Rep YCylTriGrid x -> YCylTriGrid)
-> Generic YCylTriGrid
forall x. Rep YCylTriGrid x -> YCylTriGrid
forall x. YCylTriGrid -> Rep YCylTriGrid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep YCylTriGrid x -> YCylTriGrid
$cfrom :: forall x. YCylTriGrid -> Rep YCylTriGrid x
Generic)

instance Show YCylTriGrid where 
  show :: YCylTriGrid -> String
show (YCylTriGrid (Int
r,Int
c) [(Int, Int)]
_) = String
"yCylTriGrid " 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 YCylTriGrid where
  type Index YCylTriGrid = (Int, Int)
  type Direction YCylTriGrid = TriDirection
  indices :: YCylTriGrid -> [Index YCylTriGrid]
indices (YCylTriGrid (Int, Int)
_ [(Int, Int)]
xs) = [(Int, Int)]
[Index YCylTriGrid]
xs
  neighbours :: YCylTriGrid -> Index YCylTriGrid -> [Index YCylTriGrid]
neighbours = UnboundedTriGrid
-> YCylTriGrid -> Index YCylTriGrid -> [Index YCylTriGrid]
forall g u.
(Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> [Index g]
neighboursWrappedBasedOn UnboundedTriGrid
UnboundedTriGrid
  neighbour :: YCylTriGrid
-> Index YCylTriGrid
-> Direction YCylTriGrid
-> Maybe (Index YCylTriGrid)
neighbour = UnboundedTriGrid
-> YCylTriGrid
-> Index YCylTriGrid
-> Direction YCylTriGrid
-> Maybe (Index YCylTriGrid)
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 UnboundedTriGrid
UnboundedTriGrid
  distance :: YCylTriGrid -> Index YCylTriGrid -> Index YCylTriGrid -> Int
distance = UnboundedTriGrid
-> YCylTriGrid -> Index YCylTriGrid -> Index YCylTriGrid -> Int
forall g u.
(Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> Index g -> Int
distanceWrappedBasedOn UnboundedTriGrid
UnboundedTriGrid
  directionTo :: YCylTriGrid
-> Index YCylTriGrid
-> Index YCylTriGrid
-> [Direction YCylTriGrid]
directionTo = UnboundedTriGrid
-> YCylTriGrid
-> Index YCylTriGrid
-> Index YCylTriGrid
-> [Direction YCylTriGrid]
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 UnboundedTriGrid
UnboundedTriGrid
  isAdjacent :: YCylTriGrid -> Index YCylTriGrid -> Index YCylTriGrid -> Bool
isAdjacent YCylTriGrid
g Index YCylTriGrid
a Index YCylTriGrid
b = YCylTriGrid -> Index YCylTriGrid -> Index YCylTriGrid -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance YCylTriGrid
g Index YCylTriGrid
a Index YCylTriGrid
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
  contains :: YCylTriGrid -> Index YCylTriGrid -> Bool
contains YCylTriGrid
g (x, y) = 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
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
even (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y) 
    where (Int
r, Int
_) = YCylTriGrid -> Size YCylTriGrid
forall g. FiniteGrid g => g -> Size g
size YCylTriGrid
g

instance FiniteGrid YCylTriGrid where
  type Size YCylTriGrid = (Int, Int)
  size :: YCylTriGrid -> Size YCylTriGrid
size (YCylTriGrid (Int, Int)
s [(Int, Int)]
_) = (Int, Int)
Size YCylTriGrid
s
  maxPossibleDistance :: YCylTriGrid -> Int
maxPossibleDistance YCylTriGrid
g = -- TODO: make more efficient
    [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (YCylTriGrid -> [Int]) -> YCylTriGrid -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (YCylTriGrid -> Index YCylTriGrid -> Index YCylTriGrid -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance YCylTriGrid
g (Int
0,Int
0)) ([(Int, Int)] -> [Int])
-> (YCylTriGrid -> [(Int, Int)]) -> YCylTriGrid -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YCylTriGrid -> [(Int, Int)]
forall g. Grid g => g -> [Index g]
indices (YCylTriGrid -> Int) -> YCylTriGrid -> Int
forall a b. (a -> b) -> a -> b
$ YCylTriGrid
g

instance WrappedGrid YCylTriGrid where
  normalise :: YCylTriGrid -> Index YCylTriGrid -> Index YCylTriGrid
normalise YCylTriGrid
g (x,y) | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = YCylTriGrid -> Index YCylTriGrid -> Index YCylTriGrid
forall g. WrappedGrid g => g -> Index g -> Index g
normalise YCylTriGrid
g (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c,Int
y)
                    | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 = YCylTriGrid -> Index YCylTriGrid -> Index YCylTriGrid
forall g. WrappedGrid g => g -> Index g -> Index g
normalise YCylTriGrid
g (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c,Int
y)
                    | Bool
otherwise = (Int
x,Int
y)
    where (Int
_, Int
c) = YCylTriGrid -> Size YCylTriGrid
forall g. FiniteGrid g => g -> Size g
size YCylTriGrid
g
  denormalise :: YCylTriGrid -> Index YCylTriGrid -> [Index YCylTriGrid]
denormalise YCylTriGrid
g Index YCylTriGrid
a = [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a]
nub [ (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2Int -> 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
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c,Int
y) ]
    where (Int
_, Int
c) = YCylTriGrid -> Size YCylTriGrid
forall g. FiniteGrid g => g -> Size g
size YCylTriGrid
g
          (Int
x, Int
y) = YCylTriGrid -> Index YCylTriGrid -> Index YCylTriGrid
forall g. WrappedGrid g => g -> Index g -> Index g
normalise YCylTriGrid
g Index YCylTriGrid
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 :: Int -> Int -> YCylTriGrid
yCylTriGrid Int
r Int
c = (Int, Int) -> [(Int, Int)] -> YCylTriGrid
YCylTriGrid (Int
r,Int
c) (Int -> Int -> [(Int, Int)]
parallelogramIndices Int
r Int
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  (XCylTriGrid -> XCylTriGrid -> Bool
(XCylTriGrid -> XCylTriGrid -> Bool)
-> (XCylTriGrid -> XCylTriGrid -> Bool) -> Eq XCylTriGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XCylTriGrid -> XCylTriGrid -> Bool
$c/= :: XCylTriGrid -> XCylTriGrid -> Bool
== :: XCylTriGrid -> XCylTriGrid -> Bool
$c== :: XCylTriGrid -> XCylTriGrid -> Bool
Eq, (forall x. XCylTriGrid -> Rep XCylTriGrid x)
-> (forall x. Rep XCylTriGrid x -> XCylTriGrid)
-> Generic XCylTriGrid
forall x. Rep XCylTriGrid x -> XCylTriGrid
forall x. XCylTriGrid -> Rep XCylTriGrid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XCylTriGrid x -> XCylTriGrid
$cfrom :: forall x. XCylTriGrid -> Rep XCylTriGrid x
Generic)

instance Show XCylTriGrid where 
  show :: XCylTriGrid -> String
show (XCylTriGrid (Int
r,Int
c) [(Int, Int)]
_) = String
"yCylTriGrid " 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 XCylTriGrid where
  type Index XCylTriGrid = (Int, Int)
  type Direction XCylTriGrid = TriDirection
  indices :: XCylTriGrid -> [Index XCylTriGrid]
indices (XCylTriGrid (Int, Int)
_ [(Int, Int)]
xs) = [(Int, Int)]
[Index XCylTriGrid]
xs
  neighbours :: XCylTriGrid -> Index XCylTriGrid -> [Index XCylTriGrid]
neighbours = UnboundedTriGrid
-> XCylTriGrid -> Index XCylTriGrid -> [Index XCylTriGrid]
forall g u.
(Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> [Index g]
neighboursWrappedBasedOn UnboundedTriGrid
UnboundedTriGrid
  neighbour :: XCylTriGrid
-> Index XCylTriGrid
-> Direction XCylTriGrid
-> Maybe (Index XCylTriGrid)
neighbour = UnboundedTriGrid
-> XCylTriGrid
-> Index XCylTriGrid
-> Direction XCylTriGrid
-> Maybe (Index XCylTriGrid)
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 UnboundedTriGrid
UnboundedTriGrid
  distance :: XCylTriGrid -> Index XCylTriGrid -> Index XCylTriGrid -> Int
distance = UnboundedTriGrid
-> XCylTriGrid -> Index XCylTriGrid -> Index XCylTriGrid -> Int
forall g u.
(Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> Index g -> Int
distanceWrappedBasedOn UnboundedTriGrid
UnboundedTriGrid
  directionTo :: XCylTriGrid
-> Index XCylTriGrid
-> Index XCylTriGrid
-> [Direction XCylTriGrid]
directionTo = UnboundedTriGrid
-> XCylTriGrid
-> Index XCylTriGrid
-> Index XCylTriGrid
-> [Direction XCylTriGrid]
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 UnboundedTriGrid
UnboundedTriGrid
  isAdjacent :: XCylTriGrid -> Index XCylTriGrid -> Index XCylTriGrid -> Bool
isAdjacent XCylTriGrid
g Index XCylTriGrid
a Index XCylTriGrid
b = XCylTriGrid -> Index XCylTriGrid -> Index XCylTriGrid -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance XCylTriGrid
g Index XCylTriGrid
a Index XCylTriGrid
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
  contains :: XCylTriGrid -> Index XCylTriGrid -> Bool
contains XCylTriGrid
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
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Bool -> Bool -> Bool
&& Int -> Bool
forall a. Integral a => a -> Bool
even (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y) 
    where (Int
_, Int
c) = XCylTriGrid -> Size XCylTriGrid
forall g. FiniteGrid g => g -> Size g
size XCylTriGrid
g

instance FiniteGrid XCylTriGrid where
  type Size XCylTriGrid = (Int, Int)
  size :: XCylTriGrid -> Size XCylTriGrid
size (XCylTriGrid (Int, Int)
s [(Int, Int)]
_) = (Int, Int)
Size XCylTriGrid
s
  maxPossibleDistance :: XCylTriGrid -> Int
maxPossibleDistance XCylTriGrid
g = -- TODO: make more efficient
    [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (XCylTriGrid -> [Int]) -> XCylTriGrid -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (XCylTriGrid -> Index XCylTriGrid -> Index XCylTriGrid -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance XCylTriGrid
g (Int
0,Int
0)) ([(Int, Int)] -> [Int])
-> (XCylTriGrid -> [(Int, Int)]) -> XCylTriGrid -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XCylTriGrid -> [(Int, Int)]
forall g. Grid g => g -> [Index g]
indices (XCylTriGrid -> Int) -> XCylTriGrid -> Int
forall a b. (a -> b) -> a -> b
$ XCylTriGrid
g

instance WrappedGrid XCylTriGrid where
  normalise :: XCylTriGrid -> Index XCylTriGrid -> Index XCylTriGrid
normalise XCylTriGrid
g (x,y) | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = XCylTriGrid -> Index XCylTriGrid -> Index XCylTriGrid
forall g. WrappedGrid g => g -> Index g -> Index g
normalise XCylTriGrid
g (Int
x,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r)
                    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 = XCylTriGrid -> Index XCylTriGrid -> Index XCylTriGrid
forall g. WrappedGrid g => g -> Index g -> Index g
normalise XCylTriGrid
g (Int
x,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r)
                    | Bool
otherwise = (Int
x,Int
y)
    where (Int
r, Int
_) = XCylTriGrid -> Size XCylTriGrid
forall g. FiniteGrid g => g -> Size g
size XCylTriGrid
g
  denormalise :: XCylTriGrid -> Index XCylTriGrid -> [Index XCylTriGrid]
denormalise XCylTriGrid
g Index XCylTriGrid
a = [(Int, Int)] -> [(Int, Int)]
forall a. Eq a => [a] -> [a]
nub [ (Int
x,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r), (Int
x,Int
y), (Int
x,Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r) ]
    where (Int
r, Int
_) = XCylTriGrid -> Size XCylTriGrid
forall g. FiniteGrid g => g -> Size g
size XCylTriGrid
g
          (Int
x, Int
y) = XCylTriGrid -> Index XCylTriGrid -> Index XCylTriGrid
forall g. WrappedGrid g => g -> Index g -> Index g
normalise XCylTriGrid
g Index XCylTriGrid
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 :: Int -> Int -> XCylTriGrid
xCylTriGrid Int
r Int
c = (Int, Int) -> [(Int, Int)] -> XCylTriGrid
XCylTriGrid (Int
r,Int
c) (Int -> Int -> [(Int, Int)]
parallelogramIndices Int
r Int
c)