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