import System.IO import Data.Char -- ppm image file -- P3 width height maxcolorval r g b r g b r g b ... -- max line length: 70 degrees = pi / 180 eye = [0, 0, 2] alpha1 = 80 * degrees alpha2 = -40 * degrees beta1 = 15 * degrees beta2 = -30 * degrees w = 1000 h = 500 oversampling = 2 -- each pixel is 2x2 rays ov_alphaoffset = ((alpha2 - alpha1) / (w-1)) / oversampling ov_betaoffset = ((beta2 - beta1) / (h-1)) / oversampling ov_alphaoffsets = take (round oversampling) [0,ov_alphaoffset..] ov_betaoffsets = take (round oversampling) [0,ov_betaoffset..] imgheader = "P3 " ++ (show w) ++ " " ++ (show h) ++ " 255\n" alphas = take (round w) [alpha1,(alpha1 + ((alpha2 - alpha1) / (w-1)))..] betas = take (round h) [beta1,(beta1 + ((beta2 - beta1) / (h-1)))..] -- intersect at (x , y , depth ) intersect_floor :: Double -> Double -> (Double, Double, Double) intersect_floor alpha beta | beta < 0 = (-2 * (cos alpha) / (sin beta) - 2 * (cos beta) / (sin beta), -2 * (sin alpha) / (sin beta), -2 / (sin beta) ) | otherwise = (0, 0, 0) floorcolor :: Double -> Double -> (Int, Int, Int) floorcolor alpha beta | (round (x/8) `mod` 2) == (round (y/8) `mod` 2) = (attn, 0, 0) | otherwise = (attn, attn, attn) where attn = max 0 (round (255 - 8*(sqrt t))) (x, y, t) = intersect_floor alpha beta -- blue is beautiful skycolor :: Double -> Double -> (Int, Int, Int) skycolor alpha beta = (60, round ((sqrt (alpha/6)) / (sqrt (90 * degrees)) * 128), round ((sqrt beta) / (sqrt (90 * degrees)) * 255) ) pixel_color :: Double -> Double -> (Int, Int, Int) pixel_color alpha beta | beta > 0 = skycolor alpha beta | beta == 0 = (0, 255, 0) | otherwise = floorcolor alpha beta cartProdTranspose xs ys = [(y,x) | x <- xs, y <- ys] cartProd xs ys = [(x,y) | x <- xs, y <- ys] pixel_to_ppm (r,g,b) = show r ++ " " ++ show g ++ " " ++ show b ++ "\n" --tuplesum x y = (a1 + a2, b1 + b2) -- where (a1, a2) = x -- (b1, b2) = y -- from one pixel alpha beta, get a list of oversampled pixels --oversample (a,b) = (cartProd ov_alphaoffsets ov_betaoffsets) allpixels = map (uncurry pixel_color) (cartProdTranspose betas alphas) image = imgheader ++ (foldr (++) "" (map pixel_to_ppm allpixels)) main = writeFile "foo.ppm" image