
import Control.Monad
import Data.IORef
import Graphics.Rendering.Cairo
import Graphics.UI.Gtk hiding (fill)
import System.Random

update ref = do
    flakes' <- (filter (\(x, y, r) -> x >= 0 && x < 1 && y >= 0 && y < 1) .
                map (\(x, y, r) -> (x, y + 0.005, r))) `fmap` readIORef ref
    flakes <- if (length flakes' < 100)
                  then do
                      x <- randomIO
                      r <- randomRIO (0.002, 0.003)
                      return $ (x :: Double, 0, r) : flakes'
                  else return flakes'
    writeIORef ref flakes

main = do
    initGUI
    flakesRef <- newIORef []

    w <- windowNew
    w `onDestroy` mainQuit
    w `onKeyPress` \e -> do
        when (eventKeyName e == "Escape") (widgetDestroy w)
        return False

    da <- drawingAreaNew
    w `containerAdd` da
    da `onExpose` \(Expose sent area region count) -> do
        dw <- widgetGetDrawWindow da
        (w, h) <- drawableGetSize dw
        flakes <- readIORef flakesRef

        let width = fromIntegral w
            height = fromIntegral h
            radius = (min width height) / 2.0

        renderWithDrawable dw $ do
            rectangle 0 0 width height
            setSourceRGB 0 0 0
            fill
            setSourceRGB 1 1 1
            forM_ flakes $ \(x, y, r) -> do
                arc (x * width) (y * height) (r * width) 0 (2 * pi)
                fill
        return False

    flip timeoutAdd 38 $ do
        update flakesRef
        dw <- widgetGetDrawWindow da
        (w, h) <- drawableGetSize dw
        drawWindowInvalidateRect dw (Rectangle 0 0 w h) False
        return True

    widgetShowAll w
    mainGUI

