module Math.Geometry.GridInternal
(
Grid(..),
TriTriGrid,
triTriGrid,
ParaTriGrid,
paraTriGrid,
RectSquareGrid,
rectSquareGrid,
TorSquareGrid,
torSquareGrid,
HexHexGrid,
hexHexGrid,
ParaHexGrid,
paraHexGrid
) where
import Data.Eq.Unicode ((≡))
import Data.List (nub, nubBy)
import Data.Ord.Unicode ((≤), (≥))
class Eq x ⇒ Grid g s x | g → s, g → x where
indices ∷ g → [x]
distance ∷ x → x → g → Int
size ∷ g → s
neighbours ∷ x → g → [x]
neighbours x g = filter (\a -> distance x a g ≡ 1 ) $ indices g
inGrid ∷ x → g → Bool
inGrid x g = x `elem` indices g
viewpoint ∷ x → g → [(x, Int)]
viewpoint p g = map f (indices g)
where f x = (x, distance p x g)
tileCount ∷ g → Int
tileCount = length . indices
empty ∷ g → Bool
empty g = tileCount g ≡ 0
nonEmpty ∷ g → Bool
nonEmpty = not . empty
edges ∷ g → [(x,x)]
edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g
sameEdge :: Eq t => (t, t) -> (t, t) -> Bool
sameEdge (a,b) (c,d) = (a,b) == (c,d) || (a,b) == (d,c)
adjacentEdges :: Grid g s t => t -> g -> [(t, t)]
adjacentEdges i g = map (\j -> (i,j)) $ i `neighbours` g
triZ ∷ Int → Int → Int
triZ x y | even y = x y
| otherwise = x y + 1
triDistance ∷ Grid g s (Int, Int) ⇒ (Int, Int) → (Int, Int) → g → Int
triDistance (x1, y1) (x2, y2) g =
if (x1, y1) `inGrid` g && (x2, y2) `inGrid` g
then maximum [abs (x2x1), abs (y2y1), abs(z2z1)]
else undefined
where z1 = triZ x1 y1
z2 = triZ x2 y2
triNeighbours :: Grid g s (Int, Int) ⇒ (Int, Int) → g → [(Int, Int)]
triNeighbours (x,y) g = filter (`inGrid` g) xs
where xs | even y = [(x1,y+1), (x+1,y+1), (x+1,y1)]
| otherwise = [(x1,y1), (x1,y+1), (x+1,y1)]
data TriTriGrid = TriTriGrid Int [(Int, Int)] deriving Eq
instance Show TriTriGrid where show (TriTriGrid s _) = "triTriGrid " ++ show s
instance Grid TriTriGrid Int (Int, Int) where
indices (TriTriGrid _ xs) = xs
neighbours = triNeighbours
distance = triDistance
inGrid (x, y) (TriTriGrid s _) = inTriGrid (x,y) s
size (TriTriGrid s _) = s
inTriGrid ∷ (Int, Int) → Int → Bool
inTriGrid (x, y) s = x ≥ 0 && y ≥ 0 && even (x+y) && abs z ≤ 2*s2
where z = triZ x y
triTriGrid ∷ Int → TriTriGrid
triTriGrid s =
TriTriGrid s [(xx,yy) | xx ← [0..2*(s1)],
yy ← [0..2*(s1)],
inTriGrid (xx,yy) s]
data ParaTriGrid = ParaTriGrid (Int, Int) [(Int, Int)] deriving Eq
instance Show ParaTriGrid where
show (ParaTriGrid (r,c) _) = "paraTriGrid " ++ show r ++ " " ++ show c
instance Grid ParaTriGrid (Int, Int) (Int, Int) where
indices (ParaTriGrid _ xs) = xs
neighbours = triNeighbours
distance = triDistance
size (ParaTriGrid s _) = s
paraTriGrid ∷ Int → Int → ParaTriGrid
paraTriGrid r c =
ParaTriGrid (r,c) [(x,y) | x ← [0..2*c1], y ← [0..2*r1], even (x+y)]
data RectSquareGrid = RectSquareGrid (Int, Int) [(Int, Int)] deriving Eq
instance Show RectSquareGrid where
show (RectSquareGrid (r,c) _) = "rectSquareGrid " ++ show r ++ " " ++ show c
instance Grid RectSquareGrid (Int, Int) (Int, Int) where
indices (RectSquareGrid _ xs) = xs
neighbours (x, y) g = filter (`inGrid` g) [(x1,y), (x,y+1), (x+1,y), (x,y1)]
distance (x1, y1) (x2, y2) g =
if (x1, y1) `inGrid` g && (x2, y2) `inGrid` g
then abs (x2x1) + abs (y2y1)
else undefined
size (RectSquareGrid s _) = s
rectSquareGrid ∷ Int → Int → RectSquareGrid
rectSquareGrid r c = RectSquareGrid (r,c) [(x,y) | x ← [0..c1], y ← [0..r1]]
data TorSquareGrid = TorSquareGrid (Int, Int) [(Int, Int)] deriving Eq
instance Show TorSquareGrid where
show (TorSquareGrid (r,c) _) = "torSquareGrid " ++ show r ++ " " ++ show c
instance Grid TorSquareGrid (Int, Int) (Int, Int) where
indices (TorSquareGrid _ xs) = xs
neighbours (x,y) (TorSquareGrid (r,c) _) =
nub $ filter (\(xx,yy) → xx /= x || yy /= y)
[((x1) `mod` c,y), (x,(y+1) `mod` r), ((x+1) `mod` c,y),
(x,(y1) `mod` r)]
distance (x1, y1) (x2, y2) g@(TorSquareGrid (r,c) _) =
if (x1, y1) `inGrid` g && (x2, y2) `inGrid` g
then min adx (abs (cadx)) + min ady (abs (rady))
else undefined
where adx = abs (x2 x1)
ady = abs (y2 y1)
size (TorSquareGrid s _) = s
torSquareGrid ∷ Int → Int → TorSquareGrid
torSquareGrid r c = TorSquareGrid (r,c) [(x, y) | x ← [0..c1], y ← [0..r1]]
hexDistance ∷ Grid g s (Int, Int) ⇒ (Int, Int) → (Int, Int) → g → Int
hexDistance (x1, y1) (x2, y2) g =
if (x1, y1) `inGrid` g && (x2, y2) `inGrid` g
then maximum [abs (x2x1), abs (y2y1), abs(z2z1)]
else undefined
where z1 = x1 y1
z2 = x2 y2
data HexHexGrid = HexHexGrid Int [(Int, Int)] deriving Eq
instance Show HexHexGrid where show (HexHexGrid s _) = "hexHexGrid " ++ show s
instance Grid HexHexGrid Int (Int, Int) where
indices (HexHexGrid _ xs) = xs
neighbours (x,y) g = filter (`inGrid` g)
[(x1,y), (x1,y+1), (x,y+1), (x+1,y), (x+1,y1), (x,y1)]
distance = hexDistance
size (HexHexGrid s _) = s
hexHexGrid ∷ Int → HexHexGrid
hexHexGrid r = HexHexGrid r [(x, y) | x ← [r+1..r1], y ← f x]
where f x = if x < 0 then [1rx .. r1] else [1r .. r1x]
data ParaHexGrid = ParaHexGrid (Int, Int) [(Int, Int)] deriving Eq
instance Show ParaHexGrid where
show (ParaHexGrid (r,c) _) = "paraHexGrid " ++ show r ++ " " ++ show c
instance Grid ParaHexGrid (Int, Int) (Int, Int) where
indices (ParaHexGrid _ xs) = xs
neighbours (x,y) g = filter (`inGrid` g)
[(x1,y), (x1,y+1), (x,y+1), (x+1,y), (x+1,y1), (x,y1)]
distance = hexDistance
size (ParaHexGrid s _) = s
paraHexGrid ∷ Int → Int → ParaHexGrid
paraHexGrid r c =
ParaHexGrid (r,c) [(x, y) | x ← [0..c1], y ← [0..r1]]