connett circles

Like Barry Martin's 'Hopalong' fractal, this dynamical system from John Connett was first published in Scientific American in 1986. This demo is interactive: successively clicking two points specifies a rectangle to zoom into. Doing so, you'll see that the system isn't actually a fractal. Instead of self-similarity, deep zooms reveal peacock-like images.

	{-# LANGUAGE NoMonomorphismRestriction #-}
	import Data.Complex (magnitude, Complex((:+)))
	import Graphics.UI.SDL as SDL
	(xres, yres, cast) = (768, 768, fromIntegral)
	main = withInit [InitVideo] $ do
	w <- setVideoMode xres yres 32 [NoFrame]
	enableEvent SDLMouseMotion False
	setCaption "Connett Circles" "Connett Circles"
	zoom w (-2000, -2000) (2000, 2000)
	zoom w (x,y) (s,t) = do
	let r = area x s y t
	render w r
	run w r (0,0)
	run w (xs,ys) p@(x,y) = do
	delay 32
	e <- pollEvent
	case e of
	KeyUp (Keysym SDLK_ESCAPE _ _) -> return ()
	MouseButtonUp i j _ -> click $ f i j
	_ -> run w (xs,ys) p
	where
	f i j = (xs !! cast i, ys !! cast j)
	click q
	| p == (0,0) = run w (xs,ys) q
	| otherwise = zoom w p q
	render w r = draw w . concat . f $ set r
	where
	f = zipWith zip $ map (zip [0..] . repeat) [0..]
	draw w r = do
	s <- createRGBSurface [] 1 1 32 0 0 0 0
	mapM_ (draw s) r
	SDL.flip w
	where
	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
	------------------------------------------------------
	rgb n
	| m `mod` 7 == 0 = 0xFFFFFF
	| m `mod` 6 == 0 = 0x00FFFF
	| m `mod` 5 == 0 = 0xFFFF00
	| m `mod` 4 == 0 = 0xFF0000
	| m `mod` 3 == 0 = 0xFF00
	| m `mod` 2 == 0 = 0xFF
	| otherwise = 0
	where
	f x y = round $ magnitude $ (cast x^2) :+ (cast y^2)
	m = abs n
	set (xs, ys) = [[f x y | x <- xs] | y <- ys]
	where
	f x y = round $ magnitude $ (x^2) :+ (y^2)
	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) = (cast xres, cast yres)

view raw connett_circles.hs hosted with ❤ by GitHub