import System.Exit
import Graphics.UI.GLUT
import Control.Monad
import Graphics.Rendering.OpenGL
import Data.List
import Control.Concurrent
import System.Random
import Data.IORef

text = "ursula"
s = 0.01
r = sqrt (3/4*s^2) :: GLdouble
sq = floor (1/(2*r))
initial = [(0,0),(-1,0),(1,0),(-1,-1),(0,-1),(-1,1),(0,1),(-2,0),(2,0),(-1,-2),(1,-2),(-1,2),(1,2)]

main = initialWindowSize $= Size 987 987 >>
    initialWindowPosition $= Position 0 0 >>
    createWindow text >>
    newIORef initial >>= \ior ->
    keyboardMouseCallback $= Just (\_ _ _ _ -> exitWith ExitSuccess) >>
    idleCallback $= Just (anime ior) >>
    displayCallback $= zaebashitSnezhinki ior >>
    mainLoop

zaebashitSnezhinki ior =
    readIORef ior >>= \soti ->
    clearColor $= Color4 1 1 1 1 >>
    clear [ColorBuffer] >>
    currentColor $= Color4 0 0 0 0 >>
    narisovatSoti soti >>
    flush

anime ior =
    randomRIO (1,9::Int) >>= \r ->
    modifyIORef ior (shag r) >>
    threadDelay 144888 >>
    postRedisplay Nothing

narisovatSexugolnik (x,y) = renderPrimitive TriangleFan (mapM_ vertex [Vertex2 (x+s*cos t) (y+s*sin t) | t <- take 6 [pi/6,pi/2..]])

narisovatSoti = mapM_ (narisovatSexugolnik . popravit)
----------------------------------------------------------------------------------------------------------------------------------------------------------------
popravit (x,y) = (x',y') where
    x' = 2*r*fromIntegral x + if odd y then r else 0
    y' = 3/2*s*fromIntegral y

sosedi (x,y)
    | odd y = [(x-1,y),(x+1,y),(x,y-1),(x+1,y-1),(x,y+1),(x+1,y+1)]
    | True = [(x-1,y),(x+1,y),(x-1,y-1),(x,y-1),(x-1,y+1),(x,y+1)]

shag r soti = [xy | xy <- soti', let dlina = length (sosedi xy `intersect` soti), odd dlina && dlina<=r] where
    soti' = map head $ group $ sort $ soti >>= \sota -> sota:sosedi sota