IcoGrid-0.1: Data/IcoGrid.hs
module Data.IcoGrid (all_cells, all_triads, neighbors, coord_to_vec, triad_vecs)
where
import Data.GlomeVec
import qualified Data.Array as Arr
-- | Icosahedron-based hex coordinate system. Based on 20 triangles of
-- hexes, with pentagons where five triangles meet. "Size" is the length
-- of the sides of one of the triangles. Size 0 has 12 cells (all pentagons),
-- size 1 has 12 pentagons + 20 trinagles, size 2 is 12 pentagons + 60
-- triangles, etc..
-- | (We don't support size 0, though.)
-- | We're either at the north pole, the south pole, one of the other 10
-- pentagonal corners, or we're in a hexagon. North/south triangle pairs
-- form 10 parallelograms of hexagon grids.
-- IcoHex coordinates are (parallelogram, x, y) where
-- x is to the northeast, and y is to the southeast. 0,0 is the west corner.
-- Even numbered parallolograms are in the north, odd in the south.
-- | IcoCoord is our internal representation. Our external interface uses
-- integers as cell identifiers.
data IcoCoord =
IcoNP | IcoSP | IcoHex Int Int Int | IcoPent Int
deriving (Eq, Ord, Show)
-- | Convert coordinates to a range of contiguous integers.
-- properties: range is from 0-(n-1) for a grid with n cells,
-- conversion works the same regardless of grid size
ico_coord_to_int :: IcoCoord -> Int
ico_coord_to_int (IcoHex section x y) = ((coord*10) + section) + 12
where coord =
if x>y
then (x*x)+y
else ((y*y)+y) + (y-x)
ico_coord_to_int (IcoPent n) = n+2
ico_coord_to_int IcoNP = 0
ico_coord_to_int IcoSP = 1
-- we need an integer square root for the next function...
isqrt :: Int -> Int
isqrt a = go 1 3
where go square delta =
if square <= a
then go (square+delta) (delta+2)
else (div delta 2) - 1
-- | Convert an integer coordinate to an IcoCoord.
ico_int_to_coord :: Int -> IcoCoord
ico_int_to_coord n
| n >= 12 =
let n' = n - 12
section = mod n' 10
n'' = div n' 10
size = isqrt n''
rem = n'' - (size*size)
(x,y) = if rem < size
then (size, rem)
else ((2*size)-rem ,size)
in IcoHex section x y
| n >= 2 = IcoPent (n-2)
| n == 1 = IcoSP
| n == 0 = IcoNP
ico_triad_to_int :: (IcoCoord, IcoCoord, IcoCoord) -> (Int,Int,Int)
ico_triad_to_int (a,b,c) =
(ico_coord_to_int a, ico_coord_to_int b, ico_coord_to_int c)
-- helper functions for normalizing an out-of-range coordinate
ico_rot_east_north :: Int -> Int -> Int -> Int -> IcoCoord
ico_rot_east_north size section x y =
if x == (size+1)
then IcoHex (mod (section+2) 10) ((size-y)+1) 0
else error "unexpected offset 1"
ico_rot_west_north :: Int -> Int -> Int -> Int -> IcoCoord
ico_rot_west_north size section x y =
if y == (-1)
then IcoHex (mod (section-2) 10) (size) (size-x)
else error "unexpected offset 2"
ico_rot_east_south :: Int -> Int -> Int -> Int -> IcoCoord
ico_rot_east_south size section x y =
if y == size
then IcoHex (mod (section+2) 10) 0 ((size-x)-1)
else error "unexpected offset 3"
ico_rot_west_south :: Int -> Int -> Int -> Int -> IcoCoord
ico_rot_west_south size section x y =
if (x == (-1))
then IcoHex (mod (section-2) 10) ((size-y)-2) (size-1)
else error "unexpected offset 4"
ico_shift_east :: Int -> Int -> Int -> Int -> IcoCoord
ico_shift_east size section x y =
if mod section 2 == 0
then IcoHex (mod (section+1) 10) (x+1) 0
else IcoHex (mod (section+1) 10) 0 (y-1)
ico_shift_west :: Int -> Int -> Int -> Int -> IcoCoord
ico_shift_west size section x y =
if mod section 2 == 0
then IcoHex (mod (section-1) 10) (size) (y+1)
else IcoHex (mod (section-1) 10) (x-1) (size-1)
ico_ne :: Int -> Int -> Int -> Int -> IcoCoord
ico_ne size section x y =
if mod section 2 == 0
then ico_rot_east_north size section x y
else ico_shift_east size section x y
ico_se :: Int -> Int -> Int -> Int -> IcoCoord
ico_se size section x y =
if mod section 2 == 0
then ico_shift_east size section x y
else ico_rot_east_south size section x y
ico_sw :: Int -> Int -> Int -> Int -> IcoCoord
ico_sw size section x y =
if mod section 2 == 0
then ico_shift_west size section x y
else ico_rot_west_south size section x y
ico_nw :: Int -> Int -> Int -> Int -> IcoCoord
ico_nw size section x y =
if mod section 2 == 0
then ico_rot_west_north size section x y
else ico_shift_west size section x y
-- Fixes a coordinate that my lie outside the valid range.
-- only defined within a radius one hex outside a parallelogram
ico_normalize :: Int -> Int -> Int -> Int -> IcoCoord
ico_normalize size section x y
| x >= 0 && x <= size && y>= 0 && y < size = IcoHex section x y
| x == size+1 =
if y==0
then
if mod section 2 == 0
then IcoNP
else IcoPent (mod (section+1) 10)
else
if y <= size && y > 0
then ico_ne size section x y
else error "coordinates out of bounds 1"
| y == size =
if x==size
then IcoPent (mod (section+2) 10)
else
if x >= 0 && x < size
then ico_se size section x y
else error $ "coordinates out of bounds 2 " ++ (show (IcoHex section x y))
| x == (-1) =
if y==size-1
then
if mod section 2 == 0
then IcoPent (mod (section+1) 10)
else IcoSP
else
if y >= (-1) && y < (size-1)
then ico_sw size section x y
else error "coordinates out of bounds 3"
| y == (-1) =
if x==0
then IcoPent section
else
if x <= size && x > 0
then ico_nw size section x y
else error $ "coordinates out of bounds 4 " ++ (show (IcoHex section x y))
-- Find all the neighbors of the given coordinate.
-- The 12 corners will have five neighbors, the rest will have six.
ico_neighbors :: Int -> IcoCoord -> [IcoCoord]
-- North pole has decresing values so we always have clockwise neighbors.
ico_neighbors size IcoNP = [IcoHex section size 0 | section <- [8,6..0]]
ico_neighbors size IcoSP = [IcoHex section 0 (size-1) | section <- [1,3..9]]
ico_neighbors size (IcoPent section) =
if mod section 2 == 0
then
[ IcoHex section 1 0
, IcoHex section 0 0
, IcoHex (mod (section-1) 10) size 0
, IcoHex (mod (section-2) 10) (size-1) (size-1)
, IcoHex (mod (section-2) 10) size (size-1)
]
else
[ IcoHex section 1 0
, IcoHex section 0 0
, IcoHex (mod (section-2) 10) (size-1) (size-1)
, IcoHex (mod (section-2) 10) size (size-1)
, IcoHex (mod (section-1) 10) 0 (size-1)
]
ico_neighbors size (IcoHex section x y) =
[ ico_normalize size section (x+1) y
, ico_normalize size section (x+1) (y+1)
, ico_normalize size section x (y+1)
, ico_normalize size section (x-1) y
, ico_normalize size section (x-1) (y-1)
, ico_normalize size section x (y-1)
]
ico_neighbors_check :: Int -> IcoCoord -> [IcoCoord]
ico_neighbors_check size coord =
let neighbors = ico_neighbors size coord
check_neighbor other =
if elem coord (ico_neighbors size other)
then other
else error $ "bogus coordinate neighbor " ++ (show coord)
in
map check_neighbor neighbors
ico_all_cells :: Int -> [IcoCoord]
ico_all_cells size =
( [IcoNP, IcoSP] ++
[IcoPent section | section <- [0..9]] ++
[IcoHex section x y | section <- [0..9], x <- [0..size], y <- [0..(size-1)]] )
-- all intersection of three cells that are adjacent to a particular cell
ico_triads :: Int -> IcoCoord -> [(IcoCoord, IcoCoord, IcoCoord)]
ico_triads size coord =
let neighbors = ico_neighbors_check size coord
in
zip3 neighbors (tail $ cycle neighbors) (repeat coord)
-- If we run "ico_triads" on all of the cells, we get repeats. This filters
-- some of those out. I have no proof that this is right.
ico_triads_monotonic :: Int -> IcoCoord -> [(IcoCoord, IcoCoord, IcoCoord)]
ico_triads_monotonic size coord =
filter (\(x,y,z) -> x>y && y>z) $ ico_triads size coord
-- All cell intersections.
ico_all_triads :: Int -> [(IcoCoord, IcoCoord, IcoCoord)]
ico_all_triads size =
concatMap (ico_triads size) (ico_all_cells size)
-- Convert a coordinate to an x,y,z vector.
--
-- This part is tricky. We can assign the corners to the positions
-- given by the formula for icosohedron verticies. Our coordinate system is
-- skewed a little bit relative to the corners, though, so we need to do a bit
-- of algebra to find the real 0,0 position and neighbor displacements.
-- Once we have that, we can create a map of IcoCoord -> Vec. (The Vecs should
-- be normalized.)
-- To do the reverse lookup to match a vector with its nearest coordinate, we
-- can normalize the vector and then do a nearest-neighbor match against an octree.
-- (Not implemented yet)
gr = (1+(sqrt 5))/2 -- golden ratio, 1.618033988749895
-- "top" and "bottom" refer to the north and south triangle of a section
ico_origin_vec :: Int -> Int -> Vec
ico_origin_vec size section =
ico_coord_to_vec size (IcoPent section)
ico_x_vec_top :: Int -> Int -> Vec
ico_x_vec_top size section =
if mod section 2 == 0
then
vsub (ico_coord_to_vec size (IcoNP))
(ico_coord_to_vec size (IcoPent section))
else
vsub (ico_coord_to_vec size (IcoPent (mod (section +1) 10)))
(ico_coord_to_vec size (IcoPent section))
ico_x_vec_bottom :: Int -> Int -> Vec
ico_x_vec_bottom size section =
if mod section 2 == 0
then
vsub (ico_coord_to_vec size (IcoPent (mod (section+2) 10)))
(ico_coord_to_vec size (IcoPent (mod (section+1) 10)))
else
vsub (ico_coord_to_vec size (IcoPent (mod (section+2) 10)))
(ico_coord_to_vec size (IcoSP))
ico_y_vec_top :: Int -> Int -> Vec
ico_y_vec_top size section =
if mod section 2 == 0
then
vsub (ico_coord_to_vec size (IcoPent (mod (section+2) 10)))
(ico_coord_to_vec size (IcoNP))
else
vsub (ico_coord_to_vec size (IcoPent (mod (section+2) 10)))
(ico_coord_to_vec size (IcoPent (mod (section+1) 10)))
ico_y_vec_bottom :: Int -> Int -> Vec
ico_y_vec_bottom size section =
if mod section 2 == 0
then
vsub (ico_coord_to_vec size (IcoPent (mod (section+1) 10)))
(ico_coord_to_vec size (IcoPent section))
else
vsub (ico_coord_to_vec size (IcoSP))
(ico_coord_to_vec size (IcoPent section))
ico_coord_to_vec :: Int -> IcoCoord -> Vec
ico_coord_to_vec size (IcoHex section x y) =
let origin = ico_origin_vec size section
xf = fromIntegral x
yf = fromIntegral y
sizef = fromIntegral size
xvec = if x>y
then ico_x_vec_top size section
else ico_x_vec_bottom size section
yvec = if x>y
then ico_y_vec_top size section
else ico_y_vec_bottom size section
--diagvec = ico_coord_to_vec size (IcoPent (mod (section+2) 10))
xscale = (xf / (sizef+1))
yscale = ((yf+1) / (sizef))
xadj = yscale / sizef
yadj = (-xscale) / sizef
unround_vec = vadd3 origin
(vscale xvec (xscale+xadj))
(vscale yvec (yscale+yadj))
--center_vec = if x>y
-- then vnorm $ vadd3 origin xvec diagvec
-- else vnorm $ vadd3 origin diagvec yvec
--round_adj = 1-(vlen unround_vec)
--round_vec = vscaleadd unround_vec center_vec round_adj
round_vec = vnorm unround_vec
in
round_vec
--vscale round_vec (0.6 + (0.4 * (perlin (vscale round_vec 1))))
ico_coord_to_vec _ IcoNP =
vnorm $ Vec 0 gr (-1)
ico_coord_to_vec _ IcoSP =
vnorm $ Vec 0 (-gr) 1
ico_coord_to_vec _ (IcoPent section) =
vnorm $
case section of
0 -> Vec 0 gr 1
2 -> Vec gr 1 0
4 -> Vec 1 0 (-gr)
6 -> Vec (-1) 0 (-gr)
8 -> Vec (-gr) 1 0
1 -> Vec 1 0 gr
3 -> Vec gr (-1) 0
5-> Vec 0 (-gr) (-1)
7 -> Vec (-gr) (-1) 0
9 -> Vec (-1) 0 gr
_ -> error "unexpected section number"
{-
ico_coord_to_vec_perlin :: Int -> IcoCoord -> Vec
ico_coord_to_vec_perlin size coord =
let vec = ico_coord_to_vec size coord
in vscale vec (0.6 + (0.4 * (perlin (vscale vec 1.5))))
-}
-- fundamentally flawed...
ico_trifan :: Int -> IcoCoord -> [Vec]
ico_trifan size coord =
let center = ico_coord_to_vec size coord
midpoint other =
let dir = vsub other center
in vscaleadd center dir 0.45
in
center : map (midpoint . ico_coord_to_vec size) (ico_neighbors size coord)
-- Generate center vertex, vertex between center and first neighbor,
-- vertex in the middle, and a vertex between the center and the second
-- neighbor. To be drawn with a triangle fan.
ico_triad_vecs :: Int -> (IcoCoord, IcoCoord, IcoCoord) -> [Vec]
ico_triad_vecs size (a,b,c) =
let center = ico_coord_to_vec size a
n1 = ico_coord_to_vec size b
n2 = ico_coord_to_vec size c
to_n1 = vsub n1 center
to_n2 = vsub n2 center
mid3 = vscale (vadd3 center n1 n2) (1/3)
to_mid3 = vsub mid3 center
to_mid = vsub mid3 center
in
[ center
, vscaleadd center to_n1 0.45
, vscaleadd center to_mid3 0.9
, vscaleadd center to_n2 0.45 ]
ico_corner_vecs :: Int -> [Vec]
ico_corner_vecs size =
map (\x -> vscale x 1)
( (ico_coord_to_vec size IcoNP) : (
(ico_coord_to_vec size IcoSP) :
(map (ico_coord_to_vec size) [IcoPent section | section <- [0..9] ] )) )
-- | An IcoCell is composed of an integer identifier, a list of neighbors,
-- a list of triads it's a member of, and a vector.
data IcoCell = IcoCell Int [Int] [(Int,Int,Int)] Vec
-- | Gridmap is a lazy array of arrays that holds everything we care to know
-- about any particular cell, at a given grid size. This way we only have to
-- compute relevant information the first time. The lazy array deals with
-- grid sizes from 1 to 1024.
gridmap :: Arr.Array Int (Arr.Array Int IcoCell)
gridmap = Arr.array (1,1024)
[(size,gridarray size) | size <- [1..1024]]
where
gridarray size =
let cells = ico_all_cells size
len = length cells
in Arr.array (0, len-1)
[ (ico_coord_to_int x,
IcoCell (ico_coord_to_int x)
(map ico_coord_to_int (ico_neighbors size x))
(map ico_triad_to_int (ico_triads size x))
(ico_coord_to_vec size x)) | x <- cells]
gridmap_size :: Int -> (Arr.Array Int IcoCell)
gridmap_size size = (Arr.!) gridmap size
-- | Get a list of all cells in a grid of a given size. The length of this
-- list is the number of cells, and they are numberd from 0 to n-1.
all_cells :: Int -> [Int]
all_cells size = Arr.indices (gridmap_size size)
-- | Get a list of neighbors of a particular cell, assuming a grid of a certain
-- size.
neighbors :: Int -> Int -> [Int]
neighbors size coord =
case (Arr.!) (gridmap_size size) coord of
IcoCell _ xs _ _ -> xs
-- | Get all groups of 3 cells that meet at a point and are adjacent to a
-- particular cell, assuming a grid of a certain size.
triads :: Int -> Int -> [(Int,Int,Int)]
triads size coord =
case (Arr.!) (gridmap_size size) coord of
IcoCell _ _ xs _ -> xs
-- | Get all groups of 3 cells that meet at a point in the whole grid (of a
-- given size).
-- Each triad is repeated 3 times, with a different cell as the first one in
-- the list.
all_triads :: Int -> [(Int, Int, Int)]
all_triads size =
concatMap (triads size) (all_cells size)
-- | Get the center of a cell as a point in 3-space, assuming a
-- grid of a certain size. I have not yet implemented the reverse function,
-- which is to find the closest cell to a given point.
coord_to_vec :: Int -> Int -> Vec
coord_to_vec size coord =
case (Arr.!) (gridmap_size size) coord of
IcoCell _ _ _ v -> v
-- | Return list of vectors with the center vertex as head, and then the vertex
-- between center and first neighbor,
-- vertex in the middle, and a vertex between the center and the second
-- neighbor. Can be drawn with a triangle fan. By drawing all the triads in
-- this fashion, one can draw the whole grid. I left a little bit of a gap
-- between cells to make the edges easier to see.
triad_vecs :: Int -> (Int, Int, Int) -> [Vec]
triad_vecs size (a,b,c) =
let center = coord_to_vec size a
n1 = coord_to_vec size b
n2 = coord_to_vec size c
to_n1 = vsub n1 center
to_n2 = vsub n2 center
mid3 = vscale (vadd3 center n1 n2) (1/3)
to_mid3 = vsub mid3 center
to_mid = vsub mid3 center
in
[ center
, vscaleadd center to_n1 0.45
, vscaleadd center to_mid3 0.9
, vscaleadd center to_n2 0.45 ]
--main :: IO ()
--main = undefined