module Data.IcoGrid (all_cells, all_triads, neighbors, coord_to_vec, triad_vecs)
where
import Data.Glome.Vec
import qualified Data.Array as Arr
data IcoCoord =
IcoNP | IcoSP | IcoHex Int Int Int | IcoPent Int
deriving (Eq, Ord, Show)
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) + (yx)
ico_coord_to_int (IcoPent n) = n+2
ico_coord_to_int IcoNP = 0
ico_coord_to_int IcoSP = 1
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
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 (n2)
| 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)
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) ((sizey)+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 (section2) 10) (size) (sizex)
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 ((sizex)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 (section2) 10) ((sizey)2) (size1)
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 (y1)
ico_shift_west :: Int -> Int -> Int -> Int -> IcoCoord
ico_shift_west size section x y =
if mod section 2 == 0
then IcoHex (mod (section1) 10) (size) (y+1)
else IcoHex (mod (section1) 10) (x1) (size1)
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
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==size1
then
if mod section 2 == 0
then IcoPent (mod (section+1) 10)
else IcoSP
else
if y >= (1) && y < (size1)
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))
ico_neighbors :: Int -> IcoCoord -> [IcoCoord]
ico_neighbors size IcoNP = [IcoHex section size 0 | section <- [8,6..0]]
ico_neighbors size IcoSP = [IcoHex section 0 (size1) | 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 (section1) 10) size 0
, IcoHex (mod (section2) 10) (size1) (size1)
, IcoHex (mod (section2) 10) size (size1)
]
else
[ IcoHex section 1 0
, IcoHex section 0 0
, IcoHex (mod (section2) 10) (size1) (size1)
, IcoHex (mod (section2) 10) size (size1)
, IcoHex (mod (section1) 10) 0 (size1)
]
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 (x1) y
, ico_normalize size section (x1) (y1)
, ico_normalize size section x (y1)
]
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..(size1)]] )
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)
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
ico_all_triads :: Int -> [(IcoCoord, IcoCoord, IcoCoord)]
ico_all_triads size =
concatMap (ico_triads size) (ico_all_cells size)
gr = (1+(sqrt 5))/2
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
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))
round_vec = vnorm unround_vec
in
round_vec
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_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)
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] ] )) )
data IcoCell = IcoCell Int [Int] [(Int,Int,Int)] Vec
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, len1)
[ (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
all_cells :: Int -> [Int]
all_cells size = Arr.indices (gridmap_size size)
neighbors :: Int -> Int -> [Int]
neighbors size coord =
case (Arr.!) (gridmap_size size) coord of
IcoCell _ xs _ _ -> xs
triads :: Int -> Int -> [(Int,Int,Int)]
triads size coord =
case (Arr.!) (gridmap_size size) coord of
IcoCell _ _ xs _ -> xs
all_triads :: Int -> [(Int, Int, Int)]
all_triads size =
concatMap (triads size) (all_cells size)
coord_to_vec :: Int -> Int -> Vec
coord_to_vec size coord =
case (Arr.!) (gridmap_size size) coord of
IcoCell _ _ _ v -> v
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 ]