Sunday, January 26, 2014

prime curve

This curve is created, Logo-style, by the trail of a turtle that makes a clockwise quarter-turn at every prime iteration; the screenshot shows the curve after about 730000 steps.
import Control.Arrow ((***))
import Control.Monad (void, liftM3, when)
import Data.Bits (shift)
import Data.Numbers.Primes (primes)
import Graphics.UI.SDL as SDL
   
(xres, yres) = (800, 800)
  
main = withInit [InitVideo] $ do
  win <- setVideoMode xres yres 32 []
  fillRect win (Just $ Rect 0 0 xres yres) (Pixel 0)
  enableEvent SDLMouseMotion False
  setCaption "Prime Curve" "Prime Curve"
  run win (xres `div` 2, yres `div` 2) [1..] nesw rgbs
 where
  nesw    = cycle $ map f [(0,-1), (1,0), (0,1), (-1,0)]
  f (x,y) = (x+) *** (+y)
   
run w p (n:ns) (d:ds) (c:cs) = do
  drawCell w p c
  let ds' = if prime n then ds else d:ds
  when (n `mod` 13 == 0) $ SDL.flip w
  e <- pollEvent
  case e of
   KeyUp (Keysym SDLK_ESCAPE _ _) -> void save
   _                              -> run w (d p) ns ds' cs
 where
  prime n = n `elem` takeWhile (< n + 1) primes
  save    = saveBMP w "out.bmp" >> print n
   
drawCell w p c =
  draw p =<< createRGBSurface [SWSurface] 1 1 32 0 0 0 0
 where
  rect x y     = Just $ Rect x y 1 1
  draw (x,y) s = do fillRect s (rect 0 0) (Pixel c)
                    blitSurface s (rect 0 0) w (rect x y)
 
rgbs = cycle . map f $ liftM3 (,,) ns ns ns
 where
  ns        = [151, 153.. 255]
  f (r,g,b) = shift r 16 + shift g 8 + b