render a series of images

1 files changed, 44 insertions, 39 deletions

diff --git a/raytracer.hs b/raytracer.hs
index 8bc697d..ed0726d 100644
--- a/raytracer.hs
+++ b/raytracer.hs
@@ -1,5 +1,6 @@
 import System.IO
 import Data.Char
+import Debug.Trace
 -- ppm image file
 -- P3 width height maxcolorval r g b r g b r g b ...
 -- max line length: 70
@@ -13,25 +14,37 @@ data Sphere = Sphere Coord Double Color deriving (Show, Eq)
 
 degrees = pi / 180
 
-eye = (0, 0, 8)
+eye = (0, 0, 40)
 
 x_of (x, _, _) = x
 y_of (_, y, _) = y
 z_of (_, _, z) = z
 
-sphere1 = Sphere (80, 80, 5) 10 (55,255,0)
-sphere2 = Sphere (80, -80, -5) 20 (255,60,0)
-sphere3 = Sphere (-80, 80, -5) 20 (5,60,200)
-sphere4 = Sphere (-80, -80, -5) 20 (0,255,255)
+sphere1 = Sphere (0, 80, 5) 10 (55,255,0)
+sphere2 = Sphere (80, 0, 5) 20 (255,60,0)
+--sphere3 = Sphere (0, -80, 5) 20 (5,60,200)
+--sphere4 = Sphere (-80, 0, 5) 20 (0,255,255)
+--spheres = [sphere1, sphere2, sphere3, sphere4]
 
-spheres = [sphere1, sphere2, sphere3, sphere4]
 
+filename num = "foo/foo" ++ show num ++ ".ppm"
 
-alpha1 = 120 * degrees
+spherepos = take 80 [0,1..]
+
+spheres num = [Sphere (num, 2+(num/2), 5) 20 (255,60,0), sphere1]
+
+writenum :: Double -> IO ()
+writenum num = trace ("Rendering " ++ show (filename num))
+                writeFile (filename num) (image $ spheres num)
+
+main = mapM writenum spherepos
+
+
+alpha1 = 360 * degrees
 alpha2 = 0 * degrees
 
 beta1 = 20 * degrees
-beta2 = -20 * degrees
+beta2 = -90 * degrees
 
 floorscale = 4
 
@@ -49,7 +62,7 @@ ov_betaoffset  = ((beta2 - beta1) / (h-1)) / oversampling
 ov_alphaoffsets = take (round oversampling) [0,ov_alphaoffset..]
 ov_betaoffsets  = take (round oversampling) [0,ov_betaoffset..]
 
-imgheader = "P3 " ++ (show w) ++ " " ++ (show h) ++ " 255\n"
+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)))..]
@@ -101,21 +114,22 @@ intersect_sphere source (alpha, beta) (Sphere centre radius color)
 
 
 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),
+intersect_point_floor (_, _, z) (alpha, beta) =
+                      (  (-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_floor :: Coord -> ScreenCoord -> (Coord, Double, Color)
 intersect_floor source (alpha, beta)
-        | 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))
+        | beta >= 0              = ((0, 0, 0), 0, black)
+        | 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, z), t) = intersect_point_floor source (alpha, beta)
+        where   attn = max 0 (round (255 - 8*(sqrt t)))
+                ((x, y, z), t) = intersect_point_floor source (alpha, beta)
 
 -- blue is beautiful, but a green tint is nice too
 skycolor :: Coord -> ScreenCoord -> Color
@@ -126,8 +140,8 @@ skycolor source (alpha, beta) = (60,
 data SphereIntersect = SphereIntersect Double Color deriving (Eq, Show) -- distance color
 instance Ord SphereIntersect where
   (SphereIntersect d1 _) `compare` (SphereIntersect d2 _)
-                        | d2 == 0 = LT
-                        | d1 == 0 = GT
+                        | d2 <= 0 = LT
+                        | d1 <= 0 = GT
                         | otherwise = d1 `compare` d2
 
 nearest_sphere :: Coord -> ScreenCoord -> [Sphere] -> SphereIntersect
@@ -138,31 +152,22 @@ nearest_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)
+            | floordist == 0 && 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 scoord
+pixel_color :: Coord -> [Sphere] -> ScreenCoord -> Color
+pixel_color source spheres scoord
             | nearest_object_dist > 0 = objcolor
-            | beta > 0  = skycolor source scoord
             | beta == 0 = (0, 255, 0)
-            | otherwise = (255, 0, 255)
+            | otherwise = skycolor source scoord
             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]
 
@@ -188,15 +193,15 @@ coloraverage xs = ( round (fromIntegral s1/l),
                           l = fromIntegral (length xs)
 
 -- calculate color of oversampled pixels
-ov_color :: [ScreenCoord] -> Color
-ov_color xs = coloraverage (map (pixel_color eye) xs)
+ov_color :: [Sphere] -> [ScreenCoord] -> Color
+ov_color spheres coords  = coloraverage (map (pixel_color eye spheres) coords)
 
 -- list of list of (alpha, beta)-tuples
 ov_pixels = map oversample (cartProdTranspose betas alphas)
 
-allpixels = map ov_color ov_pixels
+allpixels spheres = map (ov_color spheres) ov_pixels
+
+image spheres = imgheader ++ (foldr (++) "" (map pixel_to_ppm (allpixels spheres)))
+
 
-image = imgheader ++ (foldr (++) "" (map pixel_to_ppm allpixels))
 
-main = do   putStrLn "Rendering";
-            writeFile "foo.ppm" image