Skip to content

Instantly share code, notes, and snippets.

@kig
Created December 6, 2008 19:40
Show Gist options
  • Save kig/32942 to your computer and use it in GitHub Desktop.
Save kig/32942 to your computer and use it in GitHub Desktop.
hex.hs
import Graphics.UI.Gtk hiding (fill)
import Graphics.Rendering.Cairo
import Data.Time.Clock.POSIX
import Time
frac = snd . properFraction
modf a b = frac (a / b) * b
normalizeAngle a | a < 0 = 2*pi + (a `modf` (2*pi))
normalizeAngle a = a `modf` (2*pi)
floorf = fromInteger . fst . properFraction
angularDistance a b =
f (na - nb)
where na = normalizeAngle a
nb = normalizeAngle b
f a | a > pi = a - 2*pi
f a | a < -pi = a + 2*pi
f a = a
cylinderProjection r (x, y) = (r * sin (x/r), y)
scaleP f (x,y) = (x*f, y*f)
translateP u v (x,y) = (x+u, y+v)
rotateP a (x,y) = (cos a * x - sin a * y, sin a * x + cos a * y)
gon n =
map nrot [0..n-1]
where nrot i = let a = 2*pi*i/n in
(cos a, sin a)
hexagon = gon 6
drawHexagon col rot r rows i = do
let y = if (floor i) `mod` 2 == 0
then 0
else 1.732
let rhex = map (scaleP (2*pi*r/rows) . translateP (rows*rot/(2*pi) + i) (y+col*1.732*2) . rotateP (pi/2)) hexagon
let hex = map (cylinderProjection r) rhex
save
newPath
(uncurry moveTo) $ head hex
mapM_ (uncurry lineTo) hex
closePath
setLineWidth 1
if (floor (i+col)) `mod` 4 == 0
then fill
else stroke
restore
drawHexagons col rot r rows i = do
drawHexagon col rot r rows (i*2)
drawHexagon col rot r rows (i*2+1)
exposeHandler widget e = do
drawWin <- widgetGetDrawWindow widget
(wi,hi) <- widgetGetSize widget
let (w,h) = (realToFrac wi, realToFrac hi)
t <- getPOSIXTime
let rot = normalizeAngle ((realToFrac t) / 5)
let rows = 50
let columns = 20
let radius = 150
let hexagonRadius = 2*pi*radius / rows
renderWithDrawable drawWin $ do
save
setSourceRGBA 1 1 1 1
paint
setSourceRGBA 0 0 0 1
translate (w/2) (-3*hexagonRadius)
mapM_ (\i -> do
mapM_ (drawHexagons i (rot) radius rows) [i*2..i*2+rows/6-4])
[0..columns-1]
scale 0.5 0.5
mapM_ (\i -> do
mapM_ (drawHexagons i (-rot*4) radius rows) [i*2..i*2+rows/6-4])
[0..columns*2-1]
restore
widgetQueueDraw widget
return True
main = do
initGUI
window <- windowNew
da <- drawingAreaNew
set window [ containerChild := da ]
windowSetDefaultSize window 410 450
onExpose da (exposeHandler da)
onDestroy window mainQuit
widgetShowAll window
mainGUI
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment