summaryrefslogtreecommitdiffstats
path: root/raytracer.hs
diff options
context:
space:
mode:
authorMatthias P. Braendli <matthias.braendli@mpb.li>2013-12-02 22:51:42 +0100
committerMatthias P. Braendli <matthias.braendli@mpb.li>2013-12-02 22:51:42 +0100
commit40860a46fa0a22cc376b015e36744c8573f92654 (patch)
treeee96c1dbae27ac0dc0f0e417a53533d0b75b3f3e /raytracer.hs
parent915cfd6620a607721d9e4477ae917dc8e8e32f2f (diff)
downloadhaskell-40860a46fa0a22cc376b015e36744c8573f92654.tar.gz
haskell-40860a46fa0a22cc376b015e36744c8573f92654.tar.bz2
haskell-40860a46fa0a22cc376b015e36744c8573f92654.zip
sphere intersection recursion
Diffstat (limited to 'raytracer.hs')
-rw-r--r--raytracer.hs24
1 files changed, 16 insertions, 8 deletions
diff --git a/raytracer.hs b/raytracer.hs
index 40ff6aa..a49e5cd 100644
--- a/raytracer.hs
+++ b/raytracer.hs
@@ -38,7 +38,7 @@ spheres num = [ trace ("Sphere at " ++
show (round (80 * sin(num * degrees))) ++ "," ++
show (round (80 * cos(num * degrees))) ++ ",5" )
Sphere (80 * sin(num * degrees), 80 * cos(num * degrees), 5) 10 (255,60,0),
- sphere1, sphere2]
+ sphere1]
writenum :: Double -> IO ()
writenum num = trace ("Rendering " ++ show (filename $ round num))
@@ -55,10 +55,10 @@ beta2 = 120 * degrees
floorscale = 4
-w = 400
-h = 220
+w = 600 * 2
+h = 330 * 2
-oversampling = 1 -- each pixel is oversampling^2 rays
+oversampling = 2 -- each pixel is oversampling^2 rays
black :: Color
black = (0,0,0)
@@ -74,6 +74,10 @@ imgheader = "P3 " ++ (show $ round w) ++ " " ++ (show $ round h) ++ " 255\n"
alphas = take (round w) [alpha1,(alpha1 + ((alpha2 - alpha1) / (w-1)))..]
betas = take (round h) [beta1,(beta1 + ((beta2 - beta1) / (h-1)))..]
+attenuate_color :: Double -> Color -> Color
+attenuate_color factor (r,g,b) = ( round $ fromIntegral r * factor,
+ round $ fromIntegral g * factor,
+ round $ fromIntegral b * factor)
-- spherical projection,
-- return coordinates from a given coordinate, extended by given
@@ -99,9 +103,12 @@ 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 -> ScreenCoord -> Sphere -> (Coord, Double, Color)
-intersect_sphere source (alpha, beta) (Sphere centre radius color)
- | delta > 0 = (spherical_proj source alpha beta t, t, color)
+intersect_sphere :: Coord -> [Sphere] -> ScreenCoord -> Sphere -> (Coord, 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
+ )
| 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)
@@ -113,6 +120,7 @@ intersect_sphere source (alpha, beta) (Sphere centre radius color)
aa = sin beta * cos alpha
bb = sin beta * sin alpha
cc = cos beta
+ reflection_angle = (0, -beta)
intersect_point_floor :: Coord -> ScreenCoord -> (Coord, Double)
@@ -159,7 +167,7 @@ instance Ord SphereIntersect where
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
+ where intersections = map (intersect_sphere source spheres scoord) spheres
-- also include floor in objects
nearest_obj :: Coord -> ScreenCoord -> [Sphere] -> (Double, Color)