diff options
| -rw-r--r-- | raytracer.hs | 112 |
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] |