diff options
| author | Matthias P. Braendli <matthias.braendli@mpb.li> | 2013-12-03 21:37:30 +0100 |
|---|---|---|
| committer | Matthias P. Braendli <matthias.braendli@mpb.li> | 2013-12-03 21:37:30 +0100 |
| commit | b75511d5c4455ec9c1602e8c389f9abfe6217c4c (patch) | |
| tree | bc582419194e3ccdfd0276868809a2abe9a0c2fd | |
| parent | 98a7c512b85e99340c10dd4b934ad2ddbcfec246 (diff) | |
| download | haskell-b75511d5c4455ec9c1602e8c389f9abfe6217c4c.tar.gz haskell-b75511d5c4455ec9c1602e8c389f9abfe6217c4c.tar.bz2 haskell-b75511d5c4455ec9c1602e8c389f9abfe6217c4c.zip | |
wonderful reflections
| -rw-r--r-- | raytracer.hs | 37 |
1 files changed, 16 insertions, 21 deletions
diff --git a/raytracer.hs b/raytracer.hs index 5b58bd3..88b66ae 100644 --- a/raytracer.hs +++ b/raytracer.hs @@ -21,7 +21,7 @@ x_of (x, _, _) = x y_of (_, y, _) = y z_of (_, _, z) = z -sphere1 = Sphere (0, 80, 25) 10 (55,255,0) +sphere1 = Sphere (0, 80, 25) 60 (55,255,0) sphere2 = Sphere (80, 0, 35) 20 (255,60,200) --sphere3 = Sphere (0, -80, 5) 20 (5,60,200) --sphere4 = Sphere (-80, 0, 5) 20 (0,255,255) @@ -32,12 +32,12 @@ filename num = "foo/foo" ++ show num ++ ".ppm" --spherepos = take 1 [0,20..] --spherepos = take 10 [0,36..] -spherepos = [72] +spherepos = [60] spheres num = [ trace ("Sphere at " ++ show (round (80 * sin(num * degrees))) ++ "," ++ show (round (80 * cos(num * degrees))) ++ ",5" ) - Sphere (80 * sin(num * degrees), 80 * cos(num * degrees), 5) 10 (255,60,0), + Sphere (80 * sin(num * degrees), 80 * cos(num * degrees), 45) 10 (255,60,0), sphere1, sphere2 ] writenum :: Double -> IO () @@ -55,10 +55,10 @@ beta2 = 120 * degrees floorscale = 4 -w = 192 * 4 -h = 108 * 4 +w = 192 * 6 +h = 108 * 6 -oversampling = 1 -- each pixel is oversampling^2 rays +oversampling = 2 -- each pixel is oversampling^2 rays black :: Color black = (0,0,0) @@ -95,7 +95,7 @@ spherical_proj (x,y,z) alpha beta dist = (x + dist*(sin beta * cos alpha), z + dist*cos beta) cart2spher :: Coord -> Direction -cart2spher coord = ( atan2 y x, acos $ (-z/r)) +cart2spher coord = ( atan2 y x, acos $ z/r) where (x, y, z) = coord r = magnitude coord @@ -108,17 +108,14 @@ spher2cart direction = (sin beta * cos alpha, -- reflection on sphere reflect :: Coord -> Direction -> Direction reflect normal incoming = (alph, beta) - where (alpha, beta) = cart2spher normal + where a = (b `dot` n) `scale` n b = spher2cart incoming n = normalise normal + (alpha, beta) = cart2spher $ ((-2) `scale` a) `plus` b + -- (alpha, beta) = cart2spher normal alph = degrees*(fromIntegral (alpha_i `mod` 360) + alpha_f) (alpha_i, alpha_f) = properFraction (alpha/degrees) -reflect2 normal incoming = cart2spher $ ((1) `scale` a) `plus` b - where a = (b `dot` n) `scale` n - b = spher2cart incoming - n = normalise normal - -- intersect sphere -- discr = 4(( A u + B v + C w )^2 - (A^2 + B^2 + C^2)(u^2 + v^2 + w^2)) @@ -133,7 +130,7 @@ discr source (alpha, beta) (Sphere centre radius _) = 4*(( aa * u + bb * v + cc cc = cos beta --debug -simplecolor (beta, alpha) +simplecolor (alpha, beta) | 0 <= alph && alph < 90 = (a,0,0) | 90 <= alph && alph < 180 = (0,a,0) | 180 <= alph && alph < 270 = (0,0,a) @@ -147,12 +144,10 @@ simplecolor (beta, alpha) -- distance = 0 means no intersection intersect_sphere :: Coord -> [Sphere] -> Direction -> Sphere -> (Double, Color) intersect_sphere source spheres (alpha, beta) (Sphere centre radius color) - | delta > 0 = (t, - attenuate_color 0.8 $ - pixel_color intersect_point [] reflection_angle + | delta > 0 = (t, + attenuate_color 0.7 $ + pixel_color intersect_point spheres reflection_angle --simplecolor reflection_angle - --( round $ 200 * ((spher2cart (alpha, beta)) `dot` (normalise normal)) - -- ,0 ,0) ) | otherwise = (0, black) where t = min ((-b - sqrt(delta)) / (2*a)) ((-b + sqrt(delta)) / (2*a)) @@ -167,8 +162,8 @@ intersect_sphere source spheres (alpha, beta) (Sphere centre radius color) cc = cos beta intersect_point = spherical_proj source alpha beta t reflection_angle = reflect normal (alpha, beta) - normal = centre `minus` intersect_point - subspheres = filter ((/=) (Sphere centre radius color)) spheres + normal = intersect_point `minus` centre + --subspheres = filter ((/=) (Sphere centre radius color)) spheres --limit recursion intersect_point_floor :: Coord -> Direction -> (Coord, Double) |