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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
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
type Angle = Double
type ScreenCoord = (Angle, Angle)
type Color = (Int, Int, Int)
type Coord = (Double, Double, Double)
degrees = pi / 180
eye = (0, 0, 2)
x_of (x, _, _) = x
y_of (_, y, _) = y
z_of (_, _, z) = z
alpha1 = 80 * degrees
alpha2 = -40 * degrees
beta1 = 15 * degrees
beta2 = -30 * degrees
w = 1000
h = 500
oversampling = 1 -- 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 :: Coord -> ScreenCoord -> (Double, Double, Double)
intersect_floor source (alpha, beta)
| beta < 0 = (-(z_of source) * (cos alpha) / (sin beta) - 2 * (cos beta) / (sin beta),
-(z_of source) * (sin alpha) / (sin beta),
-(z_of source) / (sin beta) )
| otherwise = (0, 0, 0)
floorcolor :: Coord -> ScreenCoord -> Color
floorcolor source (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 source (alpha, beta)
-- blue is beautiful, but a green tint is nice too
skycolor :: Coord -> ScreenCoord -> Color
skycolor source (alpha, beta) = (60,
round ((sqrt (alpha/6)) / (sqrt (90 * degrees)) * 128),
round ((sqrt beta) / (sqrt (90 * degrees)) * 255) )
pixel_color :: Coord -> ScreenCoord -> Color
pixel_color source (alpha, beta)
| beta > 0 = skycolor source (alpha, beta)
| beta == 0 = (0, 255, 0)
| otherwise = floorcolor source (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"
tuple2sum x y = (a1 + b1, a2 + b2)
where (a1, a2) = x
(b1, b2) = y
-- from one pixel (alpha, beta), get a list of oversampled pixels
oversample :: ScreenCoord -> [ScreenCoord]
oversample (a,b) = map (tuple2sum (a,b)) (cartProd ov_alphaoffsets ov_betaoffsets)
tuple3sum x y = (a1 + b1, a2 + b2, a3 + b3)
where (a1, a2, a3) = x
(b1, b2, b3) = y
coloraverage :: [Color] -> Color
coloraverage xs = ( round (fromIntegral s1/l),
round (fromIntegral s2/l),
round (fromIntegral s3/l) )
where (s1, s2, s3) = foldr tuple3sum (0,0,0) xs
l = fromIntegral (length xs)
-- calculate color of oversampled pixels
ov_color :: [ScreenCoord] -> Color
ov_color xs = coloraverage (map (pixel_color eye) xs)
-- list of list of (alpha, beta)-tuples
ov_pixels = map oversample (cartProdTranspose betas alphas)
allpixels = map ov_color ov_pixels
image = imgheader ++ (foldr (++) "" (map pixel_to_ppm allpixels))
main = writeFile "foo.ppm" image
|
