Wednesday, July 8, 2015

sqrt 2, visualized

This program, inspired by my earlier post, illustrates the digits of sqrt 2. Each digit advances the curve eight pixels in the direction given by a numeric keypad, with 5 and 0 both considered (0,0). The thumbnail at right links to a 4000x4000 window on 9856041 digits of the curve, which originates at the image center.
import Control.Arrow ((***))
import Control.Monad (join, liftM2, liftM3, when)
import Data.Bits (shift)
import Data.Maybe (fromJust)
import Graphics.UI.SDL as SDL

(xres, yres) = (1600, 900)

main = withInit [InitVideo] $ do
  w <- setVideoMode xres yres 32 [NoFrame]
  s <- createRGBSurface [SWSurface] 1 1 32 0 0 0 0
  enableEvent SDLMouseMotion False
  setCaption "Sqrt 2 Curve" "Sqrt 2 Curve"
  run w s (xres `div` 2, yres `div` 2) dirs rgbs [1..]

run w s p (f:fs) (c:cs) (n:ns) = do
  drawCell w s p c
  when (n `mod` 47 == 0) $ SDL.flip w
  e <- pollEvent
  case e of
   KeyUp (Keysym SDLK_ESCAPE _ _) -> save >> print n
   _                              -> run w s (f p) fs cs ns
 where
  save = saveBMP w "out.bmp"

drawCell w s (x,y) c = draw x y
 where
  rect x y = Just $ Rect x y 1 1
  draw x y = do fillRect s (rect 0 0) (Pixel c)
                blitSurface s (rect 0 0) w $ rect x y

sqrt2 = let ns = f 2 0 in concatMap (show . (ns !!)) [0..]
 where
  f x r = d : f (100 * (x - (20 * r + d) * d)) (10 * r + d)
   where
    d   = head (dropWhile p [0..]) - 1
    p n = (20 * r + n) * n < x

dirs = map f . expand $ map numPad sqrt2
 where
  f (x,y) = (x+) *** (+y)

rgbs = expand . cycle . map f $ liftM3 (,,) ns ns ns
 where
  ns        = [71, 77.. 255]
  f (r,g,b) = shift r 16 + shift g 8 + b

numPad = fromJust . (`lookup` pad)
 where
  pad = zip "0528639417" $ head ps : ps
  ps  = (join $ liftM2 (,)) [0, 1, -1]

expand (x:xs) = replicate 8 x ++ expand xs