module Data.IcoGrid (all_cells, all_triads, neighbors, coord_to_vec, triad_vecs)
where
import Data.Glome.Vec
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