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

module Math.Geometry.Grid.OctagonalInternal where

import Prelude hiding (null)

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

data OctDirection = West | Northwest | North | Northeast | East | 
                      Southeast | South | Southwest
                        deriving (Int -> OctDirection -> ShowS
[OctDirection] -> ShowS
OctDirection -> String
(Int -> OctDirection -> ShowS)
-> (OctDirection -> String)
-> ([OctDirection] -> ShowS)
-> Show OctDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OctDirection] -> ShowS
$cshowList :: [OctDirection] -> ShowS
show :: OctDirection -> String
$cshow :: OctDirection -> String
showsPrec :: Int -> OctDirection -> ShowS
$cshowsPrec :: Int -> OctDirection -> ShowS
Show, OctDirection -> OctDirection -> Bool
(OctDirection -> OctDirection -> Bool)
-> (OctDirection -> OctDirection -> Bool) -> Eq OctDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OctDirection -> OctDirection -> Bool
$c/= :: OctDirection -> OctDirection -> Bool
== :: OctDirection -> OctDirection -> Bool
$c== :: OctDirection -> OctDirection -> Bool
Eq, (forall x. OctDirection -> Rep OctDirection x)
-> (forall x. Rep OctDirection x -> OctDirection)
-> Generic OctDirection
forall x. Rep OctDirection x -> OctDirection
forall x. OctDirection -> Rep OctDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OctDirection x -> OctDirection
$cfrom :: forall x. OctDirection -> Rep OctDirection x
Generic)

-- | An unbounded grid with octagonal tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data UnboundedOctGrid = UnboundedOctGrid deriving (UnboundedOctGrid -> UnboundedOctGrid -> Bool
(UnboundedOctGrid -> UnboundedOctGrid -> Bool)
-> (UnboundedOctGrid -> UnboundedOctGrid -> Bool)
-> Eq UnboundedOctGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnboundedOctGrid -> UnboundedOctGrid -> Bool
$c/= :: UnboundedOctGrid -> UnboundedOctGrid -> Bool
== :: UnboundedOctGrid -> UnboundedOctGrid -> Bool
$c== :: UnboundedOctGrid -> UnboundedOctGrid -> Bool
Eq, Int -> UnboundedOctGrid -> ShowS
[UnboundedOctGrid] -> ShowS
UnboundedOctGrid -> String
(Int -> UnboundedOctGrid -> ShowS)
-> (UnboundedOctGrid -> String)
-> ([UnboundedOctGrid] -> ShowS)
-> Show UnboundedOctGrid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnboundedOctGrid] -> ShowS
$cshowList :: [UnboundedOctGrid] -> ShowS
show :: UnboundedOctGrid -> String
$cshow :: UnboundedOctGrid -> String
showsPrec :: Int -> UnboundedOctGrid -> ShowS
$cshowsPrec :: Int -> UnboundedOctGrid -> ShowS
Show, (forall x. UnboundedOctGrid -> Rep UnboundedOctGrid x)
-> (forall x. Rep UnboundedOctGrid x -> UnboundedOctGrid)
-> Generic UnboundedOctGrid
forall x. Rep UnboundedOctGrid x -> UnboundedOctGrid
forall x. UnboundedOctGrid -> Rep UnboundedOctGrid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnboundedOctGrid x -> UnboundedOctGrid
$cfrom :: forall x. UnboundedOctGrid -> Rep UnboundedOctGrid x
Generic)

instance Grid UnboundedOctGrid where
  type Index UnboundedOctGrid = (Int, Int)
  type Direction UnboundedOctGrid = OctDirection
  indices :: UnboundedOctGrid -> [Index UnboundedOctGrid]
indices UnboundedOctGrid
_ = [Index UnboundedOctGrid]
forall a. HasCallStack => a
undefined
  neighbours :: UnboundedOctGrid
-> Index UnboundedOctGrid -> [Index UnboundedOctGrid]
neighbours UnboundedOctGrid
_ (x,y) = [(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
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
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
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
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)]
  distance :: UnboundedOctGrid
-> Index UnboundedOctGrid -> Index UnboundedOctGrid -> Int
distance UnboundedOctGrid
_ (x1, y1) (x2, y2) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (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))
  contains :: UnboundedOctGrid -> Index UnboundedOctGrid -> Bool
contains UnboundedOctGrid
_ Index UnboundedOctGrid
_ = Bool
True
  directionTo :: UnboundedOctGrid
-> Index UnboundedOctGrid
-> Index UnboundedOctGrid
-> [Direction UnboundedOctGrid]
directionTo UnboundedOctGrid
_ (x1, y1) (x2, y2) = 
    [OctDirection] -> [OctDirection]
f1 ([OctDirection] -> [OctDirection])
-> ([OctDirection] -> [OctDirection])
-> [OctDirection]
-> [OctDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OctDirection] -> [OctDirection]
f2 ([OctDirection] -> [OctDirection])
-> ([OctDirection] -> [OctDirection])
-> [OctDirection]
-> [OctDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OctDirection] -> [OctDirection]
f3 ([OctDirection] -> [OctDirection])
-> ([OctDirection] -> [OctDirection])
-> [OctDirection]
-> [OctDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OctDirection] -> [OctDirection]
f4 ([OctDirection] -> [OctDirection])
-> ([OctDirection] -> [OctDirection])
-> [OctDirection]
-> [OctDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OctDirection] -> [OctDirection]
f5 ([OctDirection] -> [OctDirection])
-> ([OctDirection] -> [OctDirection])
-> [OctDirection]
-> [OctDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OctDirection] -> [OctDirection]
f6 ([OctDirection] -> [OctDirection])
-> ([OctDirection] -> [OctDirection])
-> [OctDirection]
-> [OctDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OctDirection] -> [OctDirection]
f7 ([OctDirection] -> [OctDirection])
-> ([OctDirection] -> [OctDirection])
-> [OctDirection]
-> [OctDirection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OctDirection] -> [OctDirection]
f8 ([OctDirection] -> [OctDirection])
-> [OctDirection] -> [OctDirection]
forall a b. (a -> b) -> a -> b
$ []
    where f1 :: [OctDirection] -> [OctDirection]
f1 [OctDirection]
ds =  if  Int
dy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall a. Num a => a -> a
abs Int
dx then OctDirection
NorthOctDirection -> [OctDirection] -> [OctDirection]
forall a. a -> [a] -> [a]
:[OctDirection]
ds else [OctDirection]
ds
          f2 :: [OctDirection] -> [OctDirection]
f2 [OctDirection]
ds =  if -Int
dy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall a. Num a => a -> a
abs Int
dx then OctDirection
SouthOctDirection -> [OctDirection] -> [OctDirection]
forall a. a -> [a] -> [a]
:[OctDirection]
ds else [OctDirection]
ds
          f3 :: [OctDirection] -> [OctDirection]
f3 [OctDirection]
ds =  if  Int
dx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall a. Num a => a -> a
abs Int
dy then OctDirection
EastOctDirection -> [OctDirection] -> [OctDirection]
forall a. a -> [a] -> [a]
:[OctDirection]
ds else [OctDirection]
ds
          f4 :: [OctDirection] -> [OctDirection]
f4 [OctDirection]
ds =  if -Int
dx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall a. Num a => a -> a
abs Int
dy then OctDirection
WestOctDirection -> [OctDirection] -> [OctDirection]
forall a. a -> [a] -> [a]
:[OctDirection]
ds else [OctDirection]
ds
          f5 :: [OctDirection] -> [OctDirection]
f5 [OctDirection]
ds =  if Int
dx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
dy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then OctDirection
NortheastOctDirection -> [OctDirection] -> [OctDirection]
forall a. a -> [a] -> [a]
:[OctDirection]
ds else [OctDirection]
ds
          f6 :: [OctDirection] -> [OctDirection]
f6 [OctDirection]
ds =  if Int
dx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
dy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then OctDirection
SoutheastOctDirection -> [OctDirection] -> [OctDirection]
forall a. a -> [a] -> [a]
:[OctDirection]
ds else [OctDirection]
ds
          f7 :: [OctDirection] -> [OctDirection]
f7 [OctDirection]
ds =  if Int
dx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
dy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then OctDirection
SouthwestOctDirection -> [OctDirection] -> [OctDirection]
forall a. a -> [a] -> [a]
:[OctDirection]
ds else [OctDirection]
ds
          f8 :: [OctDirection] -> [OctDirection]
f8 [OctDirection]
ds =  if Int
dx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
&& Int
dy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then OctDirection
NorthwestOctDirection -> [OctDirection] -> [OctDirection]
forall a. a -> [a] -> [a]
:[OctDirection]
ds else [OctDirection]
ds
          dx :: Int
dx = Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x1
          dy :: Int
dy = Int
y2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y1
  null :: UnboundedOctGrid -> Bool
null UnboundedOctGrid
_ = Bool
False
  nonNull :: UnboundedOctGrid -> Bool
nonNull UnboundedOctGrid
_ = Bool
True

--
-- Rectangular grids with octagonal tiles
--

-- | A rectangular grid with octagonal tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data RectOctGrid = RectOctGrid (Int, Int) [(Int, Int)]
  deriving (RectOctGrid -> RectOctGrid -> Bool
(RectOctGrid -> RectOctGrid -> Bool)
-> (RectOctGrid -> RectOctGrid -> Bool) -> Eq RectOctGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RectOctGrid -> RectOctGrid -> Bool
$c/= :: RectOctGrid -> RectOctGrid -> Bool
== :: RectOctGrid -> RectOctGrid -> Bool
$c== :: RectOctGrid -> RectOctGrid -> Bool
Eq, (forall x. RectOctGrid -> Rep RectOctGrid x)
-> (forall x. Rep RectOctGrid x -> RectOctGrid)
-> Generic RectOctGrid
forall x. Rep RectOctGrid x -> RectOctGrid
forall x. RectOctGrid -> Rep RectOctGrid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RectOctGrid x -> RectOctGrid
$cfrom :: forall x. RectOctGrid -> Rep RectOctGrid x
Generic)

instance Show RectOctGrid where 
  show :: RectOctGrid -> String
show (RectOctGrid (Int
r,Int
c) [(Int, Int)]
_) = 
    String
"rectOctGrid " 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 RectOctGrid where
  type Index RectOctGrid = (Int, Int)
  type Direction RectOctGrid = OctDirection
  indices :: RectOctGrid -> [Index RectOctGrid]
indices (RectOctGrid (Int, Int)
_ [(Int, Int)]
xs) = [(Int, Int)]
[Index RectOctGrid]
xs
  neighbours :: RectOctGrid -> Index RectOctGrid -> [Index RectOctGrid]
neighbours = UnboundedOctGrid
-> RectOctGrid -> Index RectOctGrid -> [Index RectOctGrid]
forall u g.
(Eq (Index u), Grid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> [Index g]
neighboursBasedOn UnboundedOctGrid
UnboundedOctGrid
  distance :: RectOctGrid -> Index RectOctGrid -> Index RectOctGrid -> Int
distance = UnboundedOctGrid
-> RectOctGrid -> Index RectOctGrid -> Index RectOctGrid -> Int
forall g u.
(Eq (Index g), Grid g, Grid u, Index g ~ Index u) =>
u -> g -> Index g -> Index g -> Int
distanceBasedOn UnboundedOctGrid
UnboundedOctGrid
  directionTo :: RectOctGrid
-> Index RectOctGrid
-> Index RectOctGrid
-> [Direction RectOctGrid]
directionTo = UnboundedOctGrid
-> RectOctGrid
-> Index RectOctGrid
-> Index RectOctGrid
-> [Direction RectOctGrid]
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 UnboundedOctGrid
UnboundedOctGrid
  contains :: RectOctGrid -> Index RectOctGrid -> Bool
contains RectOctGrid
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) = RectOctGrid -> Size RectOctGrid
forall g. FiniteGrid g => g -> Size g
size RectOctGrid
g

instance FiniteGrid RectOctGrid where
  type Size RectOctGrid = (Int, Int)
  size :: RectOctGrid -> Size RectOctGrid
size (RectOctGrid (Int, Int)
s [(Int, Int)]
_) = (Int, Int)
Size RectOctGrid
s
  maxPossibleDistance :: RectOctGrid -> Int
maxPossibleDistance g :: RectOctGrid
g@(RectOctGrid (Int
r,Int
c) [(Int, Int)]
_) = 
    RectOctGrid -> Index RectOctGrid -> Index RectOctGrid -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance RectOctGrid
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 RectOctGrid where
  tileSideCount :: RectOctGrid -> Int
tileSideCount RectOctGrid
_ = Int
8
  boundary :: RectOctGrid -> [Index RectOctGrid]
boundary RectOctGrid
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)])
-> (RectOctGrid -> (Int, Int)) -> RectOctGrid -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RectOctGrid -> (Int, Int)
forall g. FiniteGrid g => g -> Size g
size (RectOctGrid -> [(Int, Int)]) -> RectOctGrid -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ RectOctGrid
g
  centre :: RectOctGrid -> [Index RectOctGrid]
centre RectOctGrid
g = (Int, Int) -> [(Int, Int)]
cartesianCentre ((Int, Int) -> [(Int, Int)])
-> (RectOctGrid -> (Int, Int)) -> RectOctGrid -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RectOctGrid -> (Int, Int)
forall g. FiniteGrid g => g -> Size g
size (RectOctGrid -> [(Int, Int)]) -> RectOctGrid -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ RectOctGrid
g

-- | @'rectOctGrid' r c@ produces a rectangular grid with @r@ rows
--   and @c@ columns, using octagonal 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.
rectOctGrid :: Int -> Int -> RectOctGrid
rectOctGrid :: Int -> Int -> RectOctGrid
rectOctGrid Int
r Int
c = 
  (Int, Int) -> [(Int, Int)] -> RectOctGrid
RectOctGrid (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 octagonal tiles.
--

-- | A toroidal grid with octagonal tiles.
--   The grid and its indexing scheme are illustrated in the user guide,
--   available at <https://github.com/mhwombat/grid/wiki>.
data TorOctGrid = TorOctGrid (Int, Int) [(Int, Int)]
  deriving (TorOctGrid -> TorOctGrid -> Bool
(TorOctGrid -> TorOctGrid -> Bool)
-> (TorOctGrid -> TorOctGrid -> Bool) -> Eq TorOctGrid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TorOctGrid -> TorOctGrid -> Bool
$c/= :: TorOctGrid -> TorOctGrid -> Bool
== :: TorOctGrid -> TorOctGrid -> Bool
$c== :: TorOctGrid -> TorOctGrid -> Bool
Eq, (forall x. TorOctGrid -> Rep TorOctGrid x)
-> (forall x. Rep TorOctGrid x -> TorOctGrid) -> Generic TorOctGrid
forall x. Rep TorOctGrid x -> TorOctGrid
forall x. TorOctGrid -> Rep TorOctGrid x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TorOctGrid x -> TorOctGrid
$cfrom :: forall x. TorOctGrid -> Rep TorOctGrid x
Generic)

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

instance FiniteGrid TorOctGrid where
  type Size TorOctGrid = (Int, Int)
  size :: TorOctGrid -> Size TorOctGrid
size (TorOctGrid (Int, Int)
s [(Int, Int)]
_) = (Int, Int)
Size TorOctGrid
s
  maxPossibleDistance :: TorOctGrid -> Int
maxPossibleDistance g :: TorOctGrid
g@(TorOctGrid (Int
r,Int
c) [(Int, Int)]
_) =
    TorOctGrid -> Index TorOctGrid -> Index TorOctGrid -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance TorOctGrid
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 TorOctGrid where
  normalise :: TorOctGrid -> Index TorOctGrid -> Index TorOctGrid
normalise TorOctGrid
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) = TorOctGrid -> Size TorOctGrid
forall g. FiniteGrid g => g -> Size g
size TorOctGrid
g
  denormalise :: TorOctGrid -> Index TorOctGrid -> [Index TorOctGrid]
denormalise TorOctGrid
g Index TorOctGrid
a = [(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) = TorOctGrid -> Size TorOctGrid
forall g. FiniteGrid g => g -> Size g
size TorOctGrid
g
          (Int
x, Int
y) = TorOctGrid -> Index TorOctGrid -> Index TorOctGrid
forall g. WrappedGrid g => g -> Index g -> Index g
normalise TorOctGrid
g Index TorOctGrid
a

-- | @'torOctGrid' r c@ returns a toroidal grid with @r@ 
--   rows and @c@ columns, using octagonal 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.
torOctGrid :: Int -> Int -> TorOctGrid
torOctGrid :: Int -> Int -> TorOctGrid
torOctGrid Int
r Int
c = (Int, Int) -> [(Int, Int)] -> TorOctGrid
TorOctGrid (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]]