sphere intersection improved

1 files changed, 78 insertions, 34 deletions

diff --git a/raytracer.hs b/raytracer.hs
index 15ebc18..9d60e8c 100644
--- a/raytracer.hs
+++ b/raytracer.hs
@@ -9,32 +9,38 @@ type Angle = Double
 type ScreenCoord = (Angle, Angle)
 type Color = (Int, Int, Int)
 type Coord = (Double, Double, Double)
-type Sphere = (Coord, Double)
+data Sphere = Sphere Coord Double Color deriving (Show, Eq)
 
 degrees = pi / 180
 
-eye = (0, 0, 2)
+eye = (0, 0, 8)
 
 x_of (x, _, _) = x
 y_of (_, y, _) = y
 z_of (_, _, z) = z
 
-sphere1 = ((40, 85, 0), 4)
-sphere2 = ((40, 45, 0), 4)
+sphere1 = Sphere (80, 43, 5) 10 (55,255,0)
+sphere2 = Sphere (30, 65, -5) 20 (255,60,0)
 
+spheres = [sphere1, sphere2]
 
-alpha1 = 180 * degrees
+
+alpha1 = 120 * degrees
 alpha2 = 0 * degrees
 
 beta1 = 20 * degrees
 beta2 = -20 * degrees
 
-floorscale = 1
+floorscale = 4
 
-w = 600
-h = 400
+w = 800
+h = 300
 
 oversampling = 1 -- each pixel is 2x2 rays
+
+black :: Color
+black = (0,0,0)
+
 ov_alphaoffset = ((alpha2 - alpha1) / (w-1)) / oversampling
 ov_betaoffset  = ((beta2 - beta1) / (h-1)) / oversampling
 
@@ -47,6 +53,13 @@ alphas = take (round w) [alpha1,(alpha1 + ((alpha2 - alpha1) / (w-1)))..]
 betas  = take (round h) [beta1,(beta1 + ((beta2 - beta1) / (h-1)))..]
 
 
+-- 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*cos alpha + dist*cos beta,
+                                          y + dist*sin alpha,
+                                          z + dist*sin beta)
 
 
 -- intersect sphere
@@ -58,7 +71,7 @@ betas  = take (round h) [beta1,(beta1 + ((beta2 - beta1) / (h-1)))..]
 --       C = sin beta
 
 discr :: Coord -> ScreenCoord -> Sphere -> Double
-discr source (alpha, beta) (centre, radius) = 4*(( aa * u + bb * v + cc * w )^2 -
+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)
             v = (y_of source) - (y_of centre)
@@ -67,11 +80,14 @@ discr source (alpha, beta) (centre, radius) = 4*(( aa * u + bb * v + cc * w )^2
             bb = sin alpha
             cc = sin beta
 
-intersect_sphere :: Coord -> ScreenCoord -> Sphere -> Double
-intersect_sphere source (alpha, beta) (centre, radius)
-        | delta > 0 = min ((-b - sqrt(delta)) / (2*a)) ((-b + sqrt(delta)) / (2*a))
-        | otherwise = 0
-            where delta = discr source (alpha, beta) (centre, radius)
+-- the intersect functions return (Coord, Distance, Color)
+-- distance = 0 means no intersection
+intersect_sphere :: Coord -> ScreenCoord -> Sphere -> (Coord, Double, Color)
+intersect_sphere source (alpha, beta) (Sphere centre radius color)
+        | delta > 0 = (spherical_proj source alpha beta t, t, color)
+        | otherwise = ((0,0,0), 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
                   b = 2 * (aa*u + bb*v + cc*w)
                   u = (x_of source) - (x_of centre)
@@ -82,23 +98,22 @@ intersect_sphere source (alpha, beta) (centre, radius)
                   cc = sin beta
 
 
+intersect_point_floor :: Coord -> ScreenCoord -> (Coord, Double)
+intersect_point_floor (_, _, z) (alpha, beta)
+        | beta < 0 = (  (-z * (cos alpha) / (sin beta) - 2 * (cos beta) / (sin beta),
+                         -z * (sin alpha) / (sin beta),
+                         0),
+                      -z / (sin beta) )
+        | otherwise = ((0, 0, 0), 0)
 
---                     intersect at  (x     , y     , depth )
-intersect_floor :: Coord -> ScreenCoord -> (Double, Double, Double)
+intersect_floor :: Coord -> ScreenCoord -> (Coord, Double, Color)
 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)
-        | x > (-0.5) && x < 0.5 = (0, attn, attn)
-        | y > (-0.5) && y < 0.5 = (attn, attn, 0)
-        | (round (x/floorscale) `mod` 2) == (round (y/floorscale) `mod` 2) = (attn, 0, 0)
-        | otherwise              = (attn, attn, attn)
+        | x > (-0.5) && x < 0.5 = ((x, y, z), t, (0, attn, attn))
+        | y > (-0.5) && y < 0.5 = ((x, y, z), t, (attn, attn, 0))
+        | (round (x/floorscale) `mod` 2) == (round (y/floorscale) `mod` 2) = ((x, y, z), t, (attn, 0, 0))
+        | otherwise              = ((x, y, z), t, (attn, attn, attn))
         where attn = max 0 (round (255 - 8*(sqrt t)))
-              (x, y, t) = 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
@@ -106,13 +121,42 @@ skycolor source (alpha, beta) = (60,
             round ((sqrt (alpha/6)) / (sqrt (90 * degrees)) * 128),
             round ((sqrt beta) / (sqrt (90 * degrees)) * 255) )
 
+data SphereIntersect = SphereIntersect Double Color deriving (Eq, Show) -- distance color
+instance Ord SphereIntersect where
+  (SphereIntersect d1 _) `compare` (SphereIntersect d2 _) = d1 `compare` d2
+
+nearest_sphere :: Coord -> ScreenCoord -> [Sphere] -> SphereIntersect
+nearest_sphere source scoord spheres =
+                        minimum [(SphereIntersect distance color) | (_, distance, color) <- intersections]
+                        where intersections = map (intersect_sphere source scoord) spheres
+
+-- also include floor in objects
+nearest_obj :: Coord -> ScreenCoord -> [Sphere] -> (Double, Color)
+nearest_obj source scoord spheres
+            | spheredist > 0 = (spheredist, spherecolor)
+--            | floordist > spheredist && spheredist > 0   = (spheredist, spherecolor)
+            | otherwise                                  = (floordist, floorcolor)
+            where   (SphereIntersect spheredist spherecolor)  = nearest_sphere source scoord spheres
+                    (_, floordist, floorcolor) = intersect_floor source scoord
+
+-- First iteration
 pixel_color :: Coord -> ScreenCoord -> Color
-pixel_color source (alpha, beta)
-        | intersect_sphere source (alpha, beta) sphere1 > 0 = (200, 0, 0)
-        | intersect_sphere source (alpha, beta) sphere2 > 0 = (0, 200, 0)
-        | beta > 0  = skycolor source (alpha, beta)
-        | beta == 0 = (0, 255, 0)
-        | otherwise = floorcolor source (alpha, beta)
+pixel_color source scoord
+            | nearest_object_dist > 0 = objcolor
+            | beta > 0  = skycolor source scoord
+            | beta == 0 = (0, 255, 0)
+            | otherwise = (255, 0, 255)
+            where   (_, beta) = scoord
+                    (nearest_object_dist, objcolor) = nearest_obj source scoord spheres
+
+
+--pixel_color :: Coord -> ScreenCoord -> Color
+--pixel_color source (alpha, beta)
+--        | intersect_sphere source (alpha, beta) sphere1 > 0 = (200, 0, 0)
+--        | intersect_sphere source (alpha, beta) sphere2 > 0 = (0, 200, 0)
+--        | 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]