diff options
Diffstat (limited to 'raytracer.hs')
| -rw-r--r-- | raytracer.hs | 70 |
1 files changed, 33 insertions, 37 deletions
diff --git a/raytracer.hs b/raytracer.hs index 883331f..618c708 100644 --- a/raytracer.hs +++ b/raytracer.hs @@ -30,15 +30,17 @@ sphere2 = Sphere (80, 0, 5) 20 (255,60,0) filename num = "foo/foo" ++ show num ++ ".ppm" -spherepos = take 1 [0,20..] -- take 80 [0,1..] +--spherepos = take 1 [0,20..] +spherepos = take 10 [0,36..] spheres num = [ trace ("Sphere at " ++ show (round (80 * sin(num * degrees))) ++ "," ++ - show (round (80 * cos(num * degrees)))) - Sphere (80 * sin(num * degrees), 80 * cos(num * degrees), 5) 10 (255,60,0), sphere1] + show (round (80 * cos(num * degrees))) ++ ",5" ) + Sphere (80 * sin(num * degrees), 80 * cos(num * degrees), 5) 10 (255,60,0), + sphere1, sphere2] writenum :: Double -> IO () -writenum num = trace ("Rendering " ++ show (filename num)) +writenum num = trace ("Rendering " ++ show (filename $ round num)) writeFile (filename num) (image $ spheres num) main = mapM writenum spherepos @@ -47,8 +49,8 @@ main = mapM writenum spherepos alpha1 = 0 * degrees alpha2 = 360 * degrees -beta1 = 20 * degrees -beta2 = -100 * degrees +beta1 = 70 * degrees +beta2 = 180 * degrees floorscale = 4 @@ -76,28 +78,23 @@ betas = take (round h) [beta1,(beta1 + ((beta2 - beta1) / (h-1)))..] -- 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) +spherical_proj (x,y,z) alpha beta dist = (x + dist*(sin beta * cos alpha), + y + dist*(sin beta * sin alpha), + z + dist*cos beta) -- intersect sphere -- discr = 4(( A u + B v + C w )^2 - (A^2 + B^2 + C^2)(u^2 + v^2 + w^2)) --- where u = source_x - sphere_x (v and w analogous) --- where A = cos alpha + cos beta --- B = sin alpha --- C = sin beta - discr :: Coord -> ScreenCoord -> 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) v = (y_of source) - (y_of centre) w = (z_of source) - (z_of centre) - aa = cos alpha + cos beta - bb = sin alpha - cc = sin beta + aa = sin beta * cos alpha + bb = sin beta * sin alpha + cc = cos beta -- the intersect functions return (Coord, Distance, Color) -- distance = 0 means no intersection @@ -105,24 +102,24 @@ 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) - v = (y_of source) - (y_of centre) - w = (z_of source) - (z_of centre) - aa = cos alpha + cos beta - bb = sin alpha - cc = sin beta + 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) + v = (y_of source) - (y_of centre) + w = (z_of source) - (z_of centre) + aa = sin beta * cos alpha + bb = sin beta * sin alpha + cc = cos beta intersect_point_floor :: Coord -> ScreenCoord -> (Coord, Double) intersect_point_floor (x, y, z) (alpha, beta) = - ( (-z * ((cos alpha) + (cos beta)) / (sin beta) + x, - -z * (sin alpha) / (sin beta) + y, - 0), - -z / (sin beta) ) + ( (x - z * sin beta * cos alpha / cos beta, + y - z * sin beta * sin alpha / cos beta, + 0), + -z / (cos beta) ) direction_color :: Double -> Double -> Int -> Color direction_color x y attn @@ -138,10 +135,9 @@ checkerboard_pattern x y attn intersect_floor :: Coord -> ScreenCoord -> (Coord, Double, Color) intersect_floor source (alpha, beta) --- | beta >= 0 = ((0, 0, 0), 0, black) | 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 - | beta >= 0 = ((x, y, z), -t, checkerboard_pattern x y 128) + | beta <= 90*degrees = ((x, y, z), 0, checkerboard_pattern x y 128) | otherwise = ((x, y, z), t, checkerboard_pattern x y attn) where attn = max 0 (round (255 - 8*(sqrt $ abs t))) ((x, y, z), t) = intersect_point_floor source (alpha, beta) @@ -150,7 +146,7 @@ intersect_floor source (alpha, beta) skycolor :: Coord -> ScreenCoord -> Color skycolor source (alpha, beta) = (60, round ((sqrt (alpha/6)) / (sqrt (90 * degrees)) * 128), - round ((sqrt beta) / (sqrt (90 * degrees)) * 255) ) + round ((sqrt (-beta+90*degrees)) / (sqrt (90 * degrees)) * 255) ) data SphereIntersect = SphereIntersect Double Color deriving (Eq, Show) -- distance color instance Ord SphereIntersect where @@ -175,13 +171,13 @@ nearest_obj source scoord spheres -- First iteration pixel_color :: Coord -> [Sphere] -> ScreenCoord -> Color -pixel_color source spheres scoord = floorcolor +pixel_color_only_floor source spheres scoord = floorcolor where ((x,y,z), floordist, floorcolor) = intersect_floor source scoord (alpha, beta) = scoord -pixel_colorold source spheres scoord +pixel_color source spheres scoord | nearest_object_dist > 0 = objcolor - | beta == 0 = (0, 255, 0) + | beta == 90 * degrees = (0, 255, 0) | otherwise = skycolor source scoord where (_, beta) = scoord (nearest_object_dist, objcolor) = nearest_obj source scoord spheres |