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