broken raytracer

1 files changed, 75 insertions, 0 deletions

diff --git a/raytracer.hs b/raytracer.hs
new file mode 100644
index 0000000..899b922
--- /dev/null
+++ b/raytracer.hs
@@ -0,0 +1,75 @@
+import System.IO
+import Data.Char
+-- ppm image file
+-- P3 width height maxcolorval r g b r g b r g b ...
+-- max line length: 70
+
+degrees = pi / 180
+
+eye = [0, 0, 2]
+
+alpha1 = 80 * degrees
+alpha2 = -40 * degrees
+
+beta1 = 15 * degrees
+beta2 = -30 * degrees
+
+w = 1000
+h = 500
+
+oversampling = 2 -- each pixel is 2x2 rays
+ov_alphaoffset = ((alpha2 - alpha1) / (w-1)) / oversampling
+ov_betaoffset  = ((beta2 - beta1) / (h-1)) / oversampling
+
+ov_alphaoffsets = take oversampling [0,ov_alphaoffset..]
+ov_betaoffsets  = take oversampling [0,ov_betaoffset..]
+
+imgheader = "P3 " ++ (show w) ++ " " ++ (show h) ++ " 255\n"
+
+alphas = take (round w) [alpha1,(alpha1 + ((alpha2 - alpha1) / (w-1)))..]
+betas  = take (round h) [beta1,(beta1 + ((beta2 - beta1) / (h-1)))..]
+
+--                       intersect at  (x     , y     , depth )
+intersect_floor :: Double -> Double -> (Double, Double, Double)
+intersect_floor alpha beta
+        | beta < 0 = (-2 * (cos alpha) / (sin beta) - 2 * (cos beta) / (sin beta),
+                      -2 * (sin alpha) / (sin beta),
+                      -2 / (sin beta) )
+        | otherwise = (0, 0, 0)
+
+floorcolor :: Double -> Double -> (Int, Int, Int)
+floorcolor alpha beta
+        | (round (x/8) `mod` 2) == (round (y/8) `mod` 2) = (attn, 0, 0)
+        | otherwise              = (attn, attn, attn)
+        where attn = max 0 (round (255 - 8*(sqrt t)))
+              (x, y, t) = intersect_floor alpha beta
+
+-- blue is beautiful
+skycolor :: Double -> Double -> (Int, Int, Int)
+skycolor alpha beta = (60,
+            round ((sqrt (alpha/6)) / (sqrt (90 * degrees)) * 128),
+            round ((sqrt beta) / (sqrt (90 * degrees)) * 255) )
+
+pixel_color :: Double -> Double -> (Int, Int, Int)
+pixel_color alpha beta
+        | beta > 0  = skycolor alpha beta
+        | beta == 0 = (0, 255, 0)
+        | otherwise = floorcolor alpha beta
+
+cartProdTranspose xs ys = [(y,x) | x <- xs, y <- ys]
+cartProd xs ys = [(x,y) | x <- xs, y <- ys]
+
+pixel_to_ppm (r,g,b) = show r ++ " " ++ show g ++ " " ++ show b ++ "\n"
+
+--tuplesum x y = (a1 + a2, b1 + b2)
+--               where (a1, a2) = x
+--                     (b1, b2) = y
+
+-- from one pixel alpha beta, get a list of oversampled pixels
+--oversample (a,b) = (cartProd ov_alphaoffsets ov_betaoffsets)
+
+-- allpixels = map (uncurry pixel_color) (cartProdTranspose betas alphas)
+
+--image = imgheader ++ (foldr (++) "" (map pixel_to_ppm allpixels))
+
+--main = writeFile "foo.ppm" image