```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_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)]
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)]
filter (\(x,y,z) -> x>y && y>z) \$ ico_triads size coord

-- All cell intersections.
ico_all_triads :: Int -> [(IcoCoord, IcoCoord, IcoCoord)]

-- 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))
--center_vec = if x>y
--             then vnorm \$ vadd3 origin xvec diagvec
--             else vnorm \$ vadd3 origin diagvec yvec
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
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]
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_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))
(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)]
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)]

-- | 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]
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