reflections, but wrong

1 files 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