summaryrefslogtreecommitdiffstats
path: root/raytracer.hs
blob: f33a87f86a8169a31ec2952b349e0dfebc3f3251 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
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