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

## 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.

Subscribe to:
Posts (Atom)