------------------------------------------------------------------------ -- | -- Module : Math.Geometry.HexGridInternal -- Copyright : (c) Amy de BuitlĂ©ir 2012-2017 -- License : BSD-style -- Maintainer : amy@nualeargais.ie -- Stability : experimental -- Portability : portable -- -- A module containing private @HexGrid2@ internals. Most developers -- should use @HexGrid2@ instead. This module is subject to change -- without notice. -- ------------------------------------------------------------------------ {-# LANGUAGE TypeFamilies, FlexibleContexts, DeriveGeneric #-} module Math.Geometry.Grid.HexagonalInternal2 where import Prelude hiding (null) import GHC.Generics (Generic) import Math.Geometry.GridInternal data HexDirection = Northwest | North | Northeast | Southeast | South | Southwest deriving (Show, Eq, Generic) -- | An unbounded grid with hexagonal tiles -- The grid and its indexing scheme are illustrated in the user guide, -- available at . data UnboundedHexGrid = UnboundedHexGrid deriving (Eq, Show, Generic) instance Grid UnboundedHexGrid where type Index UnboundedHexGrid = (Int, Int) type Direction UnboundedHexGrid = HexDirection indices _ = undefined neighbours _ (x,y) = [(x-1,y), (x-1,y+1), (x,y+1), (x+1,y), (x+1,y-1), (x,y-1)] distance _ (x1, y1) (x2, y2) = maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)] where z1 = -x1 - y1 z2 = -x2 - y2 directionTo _ (x1, y1) (x2, y2) = f1 . f2 . f3 . f4 . f5 . f6 \$ [] where f1 ds = if dy > 0 && dz < 0 then North:ds else ds f2 ds = if dy < 0 && dz > 0 then South:ds else ds f3 ds = if dx > 0 && dz < 0 then Northeast:ds else ds f4 ds = if dx < 0 && dy > 0 then Northwest:ds else ds f5 ds = if dx > 0 && dy < 0 then Southeast:ds else ds f6 ds = if dx < 0 && dz > 0 then Southwest:ds else ds dx = x2 - x1 dy = y2 - y1 z1 = -x1 - y1 z2 = -x2 - y2 dz = z2 - z1 contains _ _ = True null _ = False nonNull _ = True -- -- Hexagonal grids with hexagonal tiles -- -- | A hexagonal grid with hexagonal tiles -- The grid and its indexing scheme are illustrated in the user guide, -- available at . data HexHexGrid = HexHexGrid Int [(Int, Int)] deriving (Eq, Generic) instance Show HexHexGrid where show (HexHexGrid s _) = "hexHexGrid " ++ show s instance Grid HexHexGrid where type Index HexHexGrid = (Int, Int) type Direction HexHexGrid = HexDirection indices (HexHexGrid _ xs) = xs neighbours = neighboursBasedOn UnboundedHexGrid distance = distanceBasedOn UnboundedHexGrid directionTo = directionToBasedOn UnboundedHexGrid contains g (x,y) = -s < x && x < s && check where s = size g check = if x < 0 then -s-x < y && y < s else -s < y && y < s-x instance FiniteGrid HexHexGrid where type Size HexHexGrid = Int size (HexHexGrid s _) = s maxPossibleDistance g@(HexHexGrid s _) = distance g (-s+1,0) (s-1,0) instance BoundedGrid HexHexGrid where tileSideCount _ = 6 boundary g = northwest ++ northeast ++ east ++ southeast ++ southwest ++ west where s = size g northwest = [(k,s-1) | k <- [-s+1,-s+2..0]] northeast = [(k,s-1-k) | k <- [1,2..s-1]] east = [(s-1,k) | k <- [-1,-2..(-s)+1]] southeast = [(k,(-s)+1) | k <- [s-2,s-3..0]] southwest = [(k,(-s)+1-k) | k <- [-1,-2..(-s)+1]] west = [(-s+1,k) | k <- [1,2..s-2]] centre _ = [(0,0)] -- | @'hexHexGrid' s@ returns a grid of hexagonal shape, with -- sides of length @s@, using hexagonal tiles. If @s@ is nonnegative, the -- resulting grid will have @3*s*(s-1) + 1@ tiles. Otherwise, the resulting -- grid will be null and the list of indices will be null. hexHexGrid :: Int -> HexHexGrid hexHexGrid r = HexHexGrid r [(x, y) | x <- [-r+1..r-1], y <- f x] where f x = if x < 0 then [1-r-x .. r-1] else [1-r .. r-1-x] -- -- Rectangular grids with hexagonal tiles -- -- | A rectangular grid with hexagonal tiles -- The grid and its indexing scheme are illustrated in the user guide, -- available at . data RectHexGrid = RectHexGrid (Int, Int) [(Int, Int)] deriving (Eq, Generic) instance Show RectHexGrid where show (RectHexGrid (r,c) _) = "rectHexGrid " ++ show r ++ " " ++ show c instance Grid RectHexGrid where type Index RectHexGrid = (Int, Int) type Direction RectHexGrid = HexDirection indices (RectHexGrid _ xs) = xs neighbours = neighboursBasedOn UnboundedHexGrid distance = distanceBasedOn UnboundedHexGrid directionTo = directionToBasedOn UnboundedHexGrid contains g (x,y) = 0 <= x && x < c && y0 <= y && y <= y1 where (r,c) = size g y0 = rectHexGridY x 0 y1 = rectHexGridY x (r-1) -- (y0,y1) = rectHexGridYEndpoints r x instance FiniteGrid RectHexGrid where type Size RectHexGrid = (Int, Int) size (RectHexGrid s _) = s maxPossibleDistance g@(RectHexGrid (r,c) _) = distance g (0,0) (c-1,r-(c `div` 2)) instance BoundedGrid RectHexGrid where tileSideCount _ = 6 boundary g = [(0,rectHexGridY 0 j) | j <- [0..r-1], c>0] -- West ++ [(x,rectHexGridY x (r-1)) | x <- [1..c-1], r>0] -- North ++ [(c-1,rectHexGridY (c-1) j) | j <- [r-2,r-3..0], c>1] -- East ++ [(x,rectHexGridY x 0) | x <- [c-2,c-3..1], r>1] -- South where (r,c) = size g -- | @'rectHexGrid' r c@ returns a grid in the shape of a -- parallelogram with @r@ rows and @c@ columns, using hexagonal 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. rectHexGrid :: Int -> Int -> RectHexGrid rectHexGrid r c = RectHexGrid (r,c) [(x,rectHexGridY x j) | x <- [0..c-1], j <- [0..r-1]] rectHexGridY :: Int -> Int -> Int rectHexGridY x j = j - x `div` 2