hps-cairo-0.11: Help/animation.hs

module Main where

import System.Random
import Graphics.PS
import Graphics.PS.Cairo
import qualified Graphics.UI.Gtk as G
import Data.IORef

type R = Double
data A = A R R R R

semiann :: A -> R -> Image
semiann (A gs ir xr a) sa =
    let  x = 250
         y = 250
         z = 250
         sa' = sa * 2.0 * pi
         a' = a * pi
         ir' = min ir xr
         xr' = max ir xr
         shift = translate x y . scale z z
    in Fill (greyGS gs) (shift (annular origin ir' xr' sa' a'))

-- | Group a list into a list of n element lists.
clump :: Int -> [a] -> [[a]]
clump _ [] = []
clump n l =
    let (i,j) = splitAt n l
    in i : clump n j

-- | Generate a list of n random numbers in the range [l,r].
randn :: Int -> Int -> R -> R -> [R]
randn s n l r =
    let f i = i * (r - l) + l
    in (map f . take n . randoms . mkStdGen) s

--
settings :: [(A, R, R)]
settings =
    let g [a,b,c,d,e,f] = (A a b c d, e, f)
        g _ = undefined
    in map g (clump 6 (randn 0 66 0 1))

as :: [A]
as = map (\(a,_,_) -> a) settings

ns :: [R]
ns = map (\(_,n,_) -> n/100) settings

is :: [R]
is = map (\(_,_,i) -> i) settings

main :: IO ()
main = do
  _ <- G.initGUI
  window <- G.windowNew
  canvas <- G.drawingAreaNew
  ss <- newIORef is
  G.windowSetResizable window False
  G.widgetSetSizeRequest window 500 500
  _ <- G.onKeyPress window (const (G.widgetDestroy window >> return True))
  _ <- G.onDestroy window G.mainQuit
  _ <- G.onExpose canvas (const (updateCanvas canvas ss))
  _ <- G.timeoutAdd (G.widgetQueueDraw window >> return True) 42
  G.set window [G.containerChild G.:= canvas]
  G.widgetShowAll window
  G.mainGUI

updateCanvas :: G.DrawingArea -> IORef [R] -> IO Bool
updateCanvas canvas ss = do
  window <- G.widgetGetDrawWindow canvas
  modifyIORef ss (zipWith (+) ns)
  aa <- readIORef ss
  let i = foldl1 over (zipWith semiann as aa)
  G.renderWithDrawable window (renderImage i)
  return True