Depth of field, huzzah
Will Brown
10 years ago
23 | 23 | let s = (x `dotprod` n - pos `dotprod` n) / (dir `dotprod` n) |
24 | 24 | in if s > 0 then Just (s, pos &+ scalarMul s dir, p) else Nothing |
25 | 25 | |
26 | pointToRay :: Viewer -> Point2D -> Ray | |
27 | pointToRay (Viewer location u v f) (RelPoint2D hu hv) = | |
26 | pointToRay' :: Viewer -> Point2D -> Ray | |
27 | pointToRay' (Viewer location u v f) (RelPoint2D hu hv) = | |
28 | 28 | Ray (normalize (p &- location)) location |
29 | 29 | where p = location &+ f &+ scalarMul hu u &+ scalarMul hv v |
30 | ||
31 | -- | Finds the point on a ray whose projection on a vector has a specific length. | |
32 | farpoint :: Ray -> Vec3 -> Double -> Vec3 | |
33 | farpoint (Ray dir pos) onto dist = pos &+ scalarMul s dir | |
34 | where f_hat = normalize onto | |
35 | s = (dist - dotprod pos f_hat) / dotprod dir f_hat | |
36 | ||
37 | deformRay :: Scene -> Ray -> (Double, Double) -> Ray | |
38 | deformRay scene ray@(Ray dir pos) (i, j) = | |
39 | let farpt = farpoint ray (f $ viewer scene) (dofdepth scene) | |
40 | newpos = pos &+ (scalarMul i (u $ viewer scene)) | |
41 | &+ (scalarMul j (v $ viewer scene)) | |
42 | newdir = normalize (farpt &- newpos) | |
43 | in Ray newdir newpos | |
44 | ||
45 | pointToRay :: Scene -> Viewer -> Point2D -> [Ray] | |
46 | pointToRay scene viewer point = | |
47 | if not $ dofenabled scene then [pointToRay' viewer point] | |
48 | else let ray = pointToRay' viewer point | |
49 | in map (deformRay scene ray) [(i,j) | i <- range, j <- range] | |
50 | where ap = 0.5 * (dofaperture scene) | |
51 | samplesize = ap / fromIntegral (dofsamples scene) | |
52 | range = [-ap, (-ap) + samplesize .. ap] | |
30 | 53 | |
31 | 54 | reflectAbout :: Vec3 -> Vec3 -> Vec3 |
32 | 55 | reflectAbout vec norm = vec &- scalarMul (2 * dotprod norm vec) norm |
14 | 14 | } deriving (Show, Read) |
15 | 15 | |
16 | 16 | data Option |
17 | = Antialiased Double | |
18 | | GlobalAmbient ColorTriple | |
17 | = GlobalAmbient ColorTriple | |
18 | ||
19 | | Antialiased { | |
20 | msaaSamples :: Double | |
21 | } | |
22 | ||
23 | | DepthOfField { | |
24 | focalLength :: Double, | |
25 | aperture :: Double, | |
26 | dofSamples :: Int | |
27 | } | |
19 | 28 | deriving (Show, Read) |
20 | 29 | |
21 | 30 | data Primitive |
111 | 120 | subp:_ -> Just subp |
112 | 121 | otherwise -> Nothing |
113 | 122 | |
123 | dofinfo :: Scene -> Maybe Option | |
124 | dofinfo scene = | |
125 | case mapMaybe | |
126 | (\opt -> case opt of | |
127 | dof@(DepthOfField _ _ _) -> Just dof | |
128 | otherwise -> Nothing) | |
129 | (options scene) of | |
130 | dofs:_ -> Just dofs | |
131 | otherwise -> Nothing | |
132 | ||
133 | dofenabled :: Scene -> Bool | |
134 | dofenabled = isJust . dofinfo | |
135 | ||
136 | dofsamples :: Scene -> Int | |
137 | dofsamples = dofSamples . fromJust . dofinfo | |
138 | ||
139 | dofdepth :: Scene -> Double | |
140 | dofdepth = focalLength . fromJust . dofinfo | |
141 | ||
142 | dofaperture :: Scene -> Double | |
143 | dofaperture = aperture . fromJust . dofinfo | |
144 | ||
114 | 145 | p2d :: Int -> Int -> Point2D |
115 | 146 | p2d x y = Point2D (fromIntegral x) (fromIntegral y) |
116 | 147 |
10 | 10 | pixelColor :: Size -> Scene -> Viewer -> Point2D -> ColorTriple |
11 | 11 | pixelColor size scene viewer (Point2D ix iy) = |
12 | 12 | pixelColor size scene viewer (toRelPoint size (Point2D ix iy)) |
13 | ||
13 | 14 | pixelColor size scene viewer (RelPoint2D hu hv) = |
14 | colorAtRay scene ray 0 where ray = pointToRay viewer (RelPoint2D hu hv) | |
15 | meanColor $ map (colorAtRay scene 0) rays | |
16 | where rays = pointToRay scene viewer (RelPoint2D hu hv) | |
15 | 17 | |
16 | 18 | colorFor :: Scene |
17 | 19 | -- ^ The scene we're operating within |
36 | 38 | ReflectiveMaterial basemat reflectivity -> |
37 | 39 | weightedCombine reflectivity reflectColor baseColor |
38 | 40 | where ray = Ray (direction `reflectAbout` normal shape location) location |
39 | reflectColor = colorAtRay' scene ray [shape] (depth + 1) | |
41 | reflectColor = colorAtRay' scene (depth + 1) ray [shape] | |
40 | 42 | baseColor = colorFor scene shape basemat direction location depth |
41 | 43 | |
42 | 44 | PhongMaterial spec diff amb exp -> |
48 | 50 | TransparentMaterial base cmodel refindex -> |
49 | 51 | com throughcolor basecolor |
50 | 52 | where ray = Ray (refractVector refindex (normal shape location) direction) location |
51 | throughcolor = colorAtRay' scene ray [shape] (depth + 1) | |
53 | throughcolor = colorAtRay' scene (depth + 1) ray [shape] | |
52 | 54 | basecolor = colorFor scene shape base direction location depth |
53 | 55 | com = case cmodel of |
54 | 56 | WeightSum opacity -> weightedCombine opacity |
77 | 79 | occlusion = occluded scene shape (position ray) (loclight light) |
78 | 80 | in weightedCombine occlusion (sumLight [kd `scale` sd, ks `scale` ss]) (0, 0, 0) |
79 | 81 | |
80 | colorAtRay :: Scene -> Ray -> Int -> ColorTriple | |
81 | colorAtRay scene ray = colorAtRay' scene ray [] | |
82 | colorAtRay :: Scene -> Int -> Ray -> ColorTriple | |
83 | colorAtRay scene depth ray = colorAtRay' scene depth ray [] | |
82 | 84 | |
83 | colorAtRay' :: Scene -> Ray -> [Primitive] -> Int -> ColorTriple | |
84 | colorAtRay' scene ray exclude depth = | |
85 | colorAtRay' :: Scene -> Int -> Ray -> [Primitive] -> ColorTriple | |
86 | colorAtRay' scene depth ray exclude = | |
85 | 87 | let geom = geomAtRay scene ray exclude |
86 | 88 | in |
87 | 89 | if isNothing geom |
5 | 5 | import Graphics.GD |
6 | 6 | import ArtRay.Geometry |
7 | 7 | import Debug.Trace |
8 | ||
9 | 8 | |
10 | 9 | -- | Raytrace an image without antialiasing |
11 | 10 | rayTraceImage' :: Scene -> Size -> Point2D -> ColorTriple |
0 | Scene { | |
1 | background = (0.0,0.0,0.0), | |
2 | options = [ | |
3 | GlobalAmbient (0.4, 0.4, 0.4), | |
4 | DepthOfField { | |
5 | focalLength = 10, | |
6 | aperture = 2, | |
7 | dofSamples = 4 | |
8 | } | |
9 | ], | |
10 | ||
11 | geom = [ | |
12 | Sphere { | |
13 | center = Vec3 14.0 (-4.0) 0.0, | |
14 | radius = 3.0, | |
15 | material = PhongMaterial { | |
16 | specular = (1.0,1.0,1.0), | |
17 | diffuse = (0.7,0.0,0.0), | |
18 | ambient = (1.0,0.0,0.0), | |
19 | phongexp = 4 | |
20 | } | |
21 | }, | |
22 | ||
23 | Sphere { | |
24 | center = Vec3 8.0 -1.0 1.0, | |
25 | radius = 1.0, | |
26 | material = PhongMaterial { | |
27 | specular = (1.0,1.0,1.0), | |
28 | diffuse = (0.7,0.7,0.0), | |
29 | ambient = (1.0,1.0,0.0), | |
30 | phongexp = 2 | |
31 | } | |
32 | }, | |
33 | ||
34 | Sphere { | |
35 | center = Vec3 10.0 0.0 0.0, | |
36 | radius = 1.0, | |
37 | material = PhongMaterial { | |
38 | specular = (1.0,1.0,1.0), | |
39 | diffuse = (0.0,0.7,0.0), | |
40 | ambient = (0.0,1.0,0.0), | |
41 | phongexp = 16 | |
42 | } | |
43 | }, | |
44 | ||
45 | Plane { | |
46 | pnorm = Vec3 (-1.0) 0.0 0.0, | |
47 | point = Vec3 13.0 0.0 0.0, | |
48 | material = PhongMaterial { | |
49 | specular = (0.0,0.0,0.0), | |
50 | diffuse = (0.0,0.0,0.7), | |
51 | ambient = (0.0,0.0,1.0), | |
52 | phongexp = 4 | |
53 | } | |
54 | } | |
55 | ], | |
56 | ||
57 | lights = [ | |
58 | PhongLight { | |
59 | speclight = (1.0,1.0,1.0), | |
60 | difflight = (1.0,1.0,1.0), | |
61 | loclight = Vec3 6.0 4.0 0.0 | |
62 | } | |
63 | ], | |
64 | ||
65 | viewer = Viewer { | |
66 | location = Vec3 0.0 0.0 0.0, | |
67 | u = Vec3 0.0 0.422 0.0, | |
68 | v = Vec3 0.0 0.0 0.422, | |
69 | f = Vec3 1.0 (-0.2) 0.0 | |
70 | } | |
71 | } |