IcoGrid (empty) → 0.1
raw patch · 5 files changed
+546/−0 lines, 5 filesdep +GlomeVecdep +arraydep +basesetup-changed
Dependencies added: GlomeVec, array, base
Files
- Data/IcoGrid.hs +498/−0
- IcoGrid.cabal +20/−0
- LICENSE +14/−0
- README.txt +8/−0
- Setup.hs +6/−0
+ Data/IcoGrid.hs view
@@ -0,0 +1,498 @@+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
+ IcoGrid.cabal view
@@ -0,0 +1,20 @@+Name: IcoGrid+Version: 0.1+Synopsis: Library for generating grids of hexagons and pentagons mapped to a sphere.+Description: Defines functions for dealing with a type of hexagon grid wrapped around a sphere. The full grid is composed of 20 smaller trianglular grids of hexagons, that fit together as an icosahedron with pentagons at the corners. Each grid cell is assigned an integer value, and we can get a list of the neighbors of a particular cell. We can also ask for a vector in 3d space that is the center of a particular cell. This would be well suited for a game played on a spherical world or a planetary environment simulator.+License: GPL+License-file: LICENSE+Author: Jim Snow+Maintainer: Jim Snow <jsnow@cs.pdx.edu>+Copyright: Copyright 2009 Jim Snow+Homepage: http://www.haskell.org/haskellwiki/IcoGrid+Stability: experimental+Category: graphics+build-type: Simple+Cabal-Version: >= 1.2+extra-source-files:+ README.txt++library+ exposed-modules: Data.IcoGrid+ build-depends: base >= 3 && < 4, array, GlomeVec >= 0.1
+ LICENSE view
@@ -0,0 +1,14 @@+ This library, IcoGrid, is copyright 2009 Jim Snow++ This program is free software; you can redistribute it and/or modify+ it under the terms of version 2 of the GNU General Public License as + published by the Free Software Foundation;++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+ README.txt view
@@ -0,0 +1,8 @@+This is a library for dealing with grids of hexagons and pentagons, wrapped around a sphere.++Send questions to Jim Snow (jsnow@cs.pdx.edu).++I will try to get some sensible documention up on the haskell wiki:+http://www.haskell.org/haskellwiki/IcoGrid++To generate the haddock documentation, run "runhaskell ./Setup.haskell configure; runhaskell ./Setup.hs haddock".
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain