From ac83cfc365b5b5bb626d6732868cc479e2325633 Mon Sep 17 00:00:00 2001 From: Matthias Braendli Date: Tue, 3 Dec 2013 13:42:25 +0100 Subject: reflections, but wrong --- raytracer.hs | 74 +++++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 53 insertions(+), 21 deletions(-) diff --git a/raytracer.hs b/raytracer.hs index f127d9d..9f8a184 100644 --- a/raytracer.hs +++ b/raytracer.hs @@ -7,7 +7,7 @@ import Debug.Trace type Angle = Double -type ScreenCoord = (Angle, Angle) +type Direction = (Angle, Angle) -- azimut, inclination type Color = (Int, Int, Int) type Coord = (Double, Double, Double) data Sphere = Sphere Coord Double Color deriving (Show, Eq) @@ -55,8 +55,8 @@ beta2 = 120 * degrees floorscale = 4 -w = 1920 -h = 1080 +w = 192 * 8 +h = 108 * 8 oversampling = 4 -- each pixel is oversampling^2 rays @@ -79,19 +79,47 @@ attenuate_color factor (r,g,b) = ( round $ fromIntegral r * factor, round $ fromIntegral g * factor, round $ fromIntegral b * factor) +(a, b, c) `dot` (d, e, f) = a*d + b*e + c*f +(a, b, c) `plus` (d, e, f) = (a+d, b+e, c+f) +(a, b, c) `minus` (d, e, f) = (a-d, b-e, c-f) +s `scale` (a,b,c) = (s*a, s*b, s*c) +magnitude (a,b,c) = sqrt(a^2 + b^2 + c^2) +normalise v = (1/(magnitude v)) `scale` v + -- spherical projection, -- return coordinates from a given coordinate, extended by given -- angles to some distance spherical_proj :: Coord -> Angle -> Angle -> Double -> Coord spherical_proj (x,y,z) alpha beta dist = (x + dist*(sin beta * cos alpha), y + dist*(sin beta * sin alpha), - z + dist*cos beta - 0.1) - + z + dist*cos beta) + +cart2spher :: Coord -> Direction +cart2spher coord = (acos $ z/r, atan2 y x) + where (x, y, z) = coord + r = magnitude coord + +spher2cart :: Direction -> Coord +spher2cart direction = (sin beta * cos alpha, + sin beta * sin alpha, + cos beta) + where (alpha, beta) = direction + +-- reflection on sphere +reflect :: Coord -> Direction -> Direction +reflect normal _ = --trace ("a " ++ show alpha ++ " b " ++ show beta) + cart2spher normal + where (alpha, beta) = cart2spher normal + +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)) -discr :: Coord -> ScreenCoord -> Sphere -> Double +discr :: Coord -> Direction -> Sphere -> Double discr source (alpha, beta) (Sphere centre radius _) = 4*(( aa * u + bb * v + cc * w )^2 - (aa*aa + bb*bb + cc*cc)*(u*u + v*v + w*w - radius^2)) where u = (x_of source) - (x_of centre) @@ -103,13 +131,13 @@ discr source (alpha, beta) (Sphere centre radius _) = 4*(( aa * u + bb * v + cc -- the intersect functions return (Coord, Distance, Color) -- distance = 0 means no intersection -intersect_sphere :: Coord -> [Sphere] -> ScreenCoord -> Sphere -> (Coord, Double, Color) +intersect_sphere :: Coord -> [Sphere] -> Direction -> Sphere -> (Double, Color) intersect_sphere source spheres (alpha, beta) (Sphere centre radius color) - | delta > 0 = (spherical_proj source alpha beta t, t, - attenuate_color 0.5 $ - pixel_color (spherical_proj source alpha beta t) spheres reflection_angle + | delta > 0 = (t, + attenuate_color 0.8 $ + pixel_color intersect_point subspheres reflection_angle ) - | otherwise = ((0,0,0), 0, black) + | otherwise = (0, black) where t = min ((-b - sqrt(delta)) / (2*a)) ((-b + sqrt(delta)) / (2*a)) delta = discr source (alpha, beta) (Sphere centre radius color) a = aa^2 + bb^2 + cc^2 @@ -120,10 +148,12 @@ intersect_sphere source spheres (alpha, beta) (Sphere centre radius color) aa = sin beta * cos alpha bb = sin beta * sin alpha cc = cos beta - reflection_angle = (-alpha, 180) + intersect_point = spherical_proj source alpha beta t + reflection_angle = reflect (intersect_point `minus` centre) (alpha, beta) + subspheres = filter ((/=) (Sphere centre radius color)) spheres -intersect_point_floor :: Coord -> ScreenCoord -> (Coord, Double) +intersect_point_floor :: Coord -> Direction -> (Coord, Double) intersect_point_floor (x, y, z) (alpha, beta) = ( (x - z * sin beta * cos alpha / cos beta, y - z * sin beta * sin alpha / cos beta, @@ -142,7 +172,7 @@ checkerboard_pattern x y attn | (round (x/floorscale) `mod` 2) == (round (y/floorscale) `mod` 2) = direction_color x y attn | otherwise = (attn, attn, attn) -intersect_floor :: Coord -> ScreenCoord -> (Coord, Double, Color) +intersect_floor :: Coord -> Direction -> (Coord, Double, Color) intersect_floor source (alpha, beta) | x > (-0.5) && x < 0.5 = ((x, y, z), t, (0, attn, attn)) -- x near 0 : cyan | y > (-0.5) && y < 0.5 = ((x, y, z), t, (attn, attn, 0)) -- y near 0 : yellow @@ -152,7 +182,7 @@ intersect_floor source (alpha, beta) ((x, y, z), t) = intersect_point_floor source (alpha, beta) -- blue is beautiful, but a green tint is nice too -skycolor :: Coord -> ScreenCoord -> Color +skycolor :: Coord -> Direction -> Color skycolor source (alpha, beta) = (r,g,b) where r = 60 g = max 0 $ round $ (sqrt (alpha/6)) / (sqrt (90 * degrees)) * 128 @@ -165,13 +195,15 @@ instance Ord SphereIntersect where | d1 <= 0 = GT | otherwise = d1 `compare` d2 -nearest_sphere :: Coord -> ScreenCoord -> [Sphere] -> SphereIntersect +nearest_sphere :: Coord -> Direction -> [Sphere] -> SphereIntersect nearest_sphere source scoord spheres = - minimum [(SphereIntersect distance color) | (_, distance, color) <- intersections] + minimum [(SphereIntersect distance color) | (distance, color) <- intersections] where intersections = map (intersect_sphere source spheres scoord) spheres -- also include floor in objects -nearest_obj :: Coord -> ScreenCoord -> [Sphere] -> (Double, Color) +nearest_obj :: Coord -> Direction -> [Sphere] -> (Double, Color) +nearest_obj source scoord [] = (floordist, floorcolor) + where (_, floordist, floorcolor) = intersect_floor source scoord nearest_obj source scoord spheres | floordist == 0 && spheredist > 0 = (spheredist, spherecolor) | floordist > spheredist && spheredist > 0 = (spheredist, spherecolor) @@ -180,7 +212,7 @@ nearest_obj source scoord spheres (_, floordist, floorcolor) = intersect_floor source scoord -- First iteration -pixel_color :: Coord -> [Sphere] -> ScreenCoord -> Color +pixel_color :: Coord -> [Sphere] -> Direction -> Color pixel_color_only_floor source spheres scoord = floorcolor where ((x,y,z), floordist, floorcolor) = intersect_floor source scoord (alpha, beta) = scoord @@ -203,7 +235,7 @@ tuple2sum x y = (a1 + b1, a2 + b2) (b1, b2) = y -- from one pixel (alpha, beta), get a list of oversampled pixels -oversample :: ScreenCoord -> [ScreenCoord] +oversample :: Direction -> [Direction] oversample (a,b) = map (tuple2sum (a,b)) (cartProd ov_alphaoffsets ov_betaoffsets) tuple3sum x y = (a1 + b1, a2 + b2, a3 + b3) @@ -218,7 +250,7 @@ coloraverage xs = ( round (fromIntegral s1/l), l = fromIntegral (length xs) -- calculate color of oversampled pixels -ov_color :: [Sphere] -> [ScreenCoord] -> Color +ov_color :: [Sphere] -> [Direction] -> Color ov_color spheres coords = coloraverage (map (pixel_color eye spheres) coords) -- list of list of (alpha, beta)-tuples -- cgit v1.2.3