Tuesday, December 15, 2015

the mandelbrot set

Benoit's famous fractal. Click any two points to specify a zoom rectangle.
import Data.Complex (magnitude, Complex((:+)))
import Graphics.UI.SDL as SDL
 
(xres, yres) = (900, 750)

main = withInit [InitVideo] $ do
  w <- setVideoMode xres yres 32 [NoFrame]
  enableEvent SDLMouseMotion False
  setCaption "Mandelbrot" "Mandelbrot"
  zoom w 1 (-2, 1) (0.5, -1)

zoom w i (x,y) (s,t) = do
  let r = area x s y t
  render w r i
  run w (i + 1) r (0,0)

render w r i = draw w . concat . f $ set i r
 where
  f = zipWith zip $ map (zip [0..] . repeat) [0..]

draw w cs = do
  s <- createRGBSurface [] 1 1 32 0 0 0 0
  mapM_ (draw s) cs
  SDL.flip w
 where
  rgb n        = div (floor $ min n 2 * 512) 2
  rect (x,y)   = Just $ Rect x y 1 1
  draw s (p,n) = do fillRect s Nothing $ Pixel $ rgb n
                    blitSurface s Nothing w $ rect p

run w i (xs,ys) p@(x,y) = do
  e <- pollEvent
  case e of
   KeyUp (Keysym SDLK_ESCAPE _ _) -> return ()
   MouseButtonUp i j _            -> click $ f i j
   _                              -> run w i (xs,ys) p
 where
  f i j = (xs !! fromIntegral i, ys !! fromIntegral j)
  click q
    | p == (0,0) = run w i (xs,ys) q
    | otherwise  = zoom w i p q

------------------------------------------------------

area x x' y y' = ([t, t+a.. s], [u, u-b.. v])
 where
  (a,b)    = ((s - t) / dx, (u - v) / dy)
  (s,t)    = (max x x', min x x')
  (u,v)    = (max y y', min y y')
  (dx, dy) = (fromIntegral xres, fromIntegral yres)

set i (xs, ys) = [[f x y | x <- xs] | y <- ys]
 where
  f x = magnitude . g . (x :+)
  g a = iterate ((+ a) . (^2)) 0 !! (i * 20)

No comments:

Post a Comment