added camera object

app/Main.hs

@@ -1,12 +1,12 @@
 module Main where
 
+import Camera
 import Control.Monad (mapM)
 import Control.Monad.Random
 import Data.Ix
 import Data.Maybe
 import Hittable
 import IOUtils
-import Linear.V2
 import Linear.V3
 import Linear.Vector
 import Material
@@ -17,8 +17,6 @@ type Coord = (Int, Int)
 
 type ImageDimensions = (Int, Int)
 
-type ViewPortDimensions = (Double, Double)
-
 -- TODO
 -- antialiasing
 
@@ -26,24 +24,24 @@ type ViewPortDimensions = (Double, Double)
 scatter :: (RandomGen g) => Ray -> Hit -> Rand g (Ray)
 scatter (Ray o d) (Hit t p n (Lambertian c)) = do
   r <- randV3
-  let target = p ^+^ colorWithNormal (unitVector n) ^+^ r
+  let target = p ^+^ colorWithNormal n ^+^ r
   return $ Ray p (target ^-^ p)
 scatter (Ray o d) (Hit t p n (Metal c)) = do
-  let reflected = reflect (unitVector d) (unitVector n)
+  let reflected = reflect (unitVector d) n
   return $ Ray p reflected
 scatter (Ray o d) (Hit t p n (Glass c)) = do
   let refraction_ratio = if isFrontFace (Ray o d) n then 1.0 / 1.5 else 1.0
   let ud = unitVector d
-  let ct = min (ud `dotP` (unitVector n)) 1.0
+  let ct = min (ud `dotP` n) 1.0
   let st = sqrt (1.0 - ct * ct)
   rVal <- rand
 
   if refraction_ratio * st > 1.0 || reflectance ct refraction_ratio < rVal
     then do
-      let reflected = reflect ud (unitVector n)
+      let reflected = reflect ud n
       return $ Ray p reflected
     else do
-      let refracted = refract ud (unitVector n) refraction_ratio
+      let refracted = refract ud n refraction_ratio
       return $ Ray p refracted
 
 getRayColor :: (Shape s, RandomGen g) => [s] -> Int -> Ray -> Rand g (V3 Double)
@@ -84,10 +82,10 @@ colorWithNormal v = 0.5 *^ (v ^+^ V3 1.0 1.0 1.0)
 
 -- heart of loop, for each x y coordinate pixel, convert it into world space and then run the ray tracing algorithm
 -- run [samples] times in order to increase fidelity
-rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> ViewPortDimensions -> [s] -> Int -> IO (V3 Double)
-rayTrace (x, y) (w, h) (vw, vh) world samples = do
+rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> [s] -> Int -> Camera -> IO (V3 Double)
+rayTrace (x, y) (w, h) world samples camera = do
   let maxDepth = 50
-  l <- replicateM samples (evalRandIO (getRayColor world maxDepth $ (buildRay (xf * (vw / wf)) (yf * (vh / hf)))))
+  l <- replicateM samples (evalRandIO (getRayColor world maxDepth $ buildRay (xf / wf) (yf / hf) camera))
   return $ foldl (^+^) (V3 0.0 0.0 0.0) l
   where
     xf = fromIntegral x
@@ -99,14 +97,22 @@ main :: IO ()
 main = do
   let w = 400
   let h = 400
+
+  let aspect = 1.0 --16.0 / 9.0
+  let viewHeight = 2.0
+  let viewWidth = aspect * viewHeight
+  let focalLength = 1.0
+
+  let camera = makeCamera (V3 0.0 0.0 0.0) viewWidth viewHeight focalLength
+
   let samples = 25
   let world =
-        [ Circle (V3 0.0 0.0 (-1.0)) 0.25 (Glass (V3 1.0 1.0 1.0)),
-          Circle (V3 0.5 0.0 (-1.0)) 0.25 (Lambertian (V3 0.7 0.1 0.1)),
-          Circle (V3 0.0 (-10.25) (-1.0)) 10 (Lambertian (V3 0.7 0.6 0.5))
+        [ Circle (V3 0.0 0.0 (-1.0)) 0.5 (Glass (V3 1.0 1.0 1.0)),
+          Circle (V3 1.0 0.0 (-1.0)) 0.5 (Lambertian (V3 0.7 0.1 0.1)),
+          Circle (V3 0.0 (-100.5) (-1.0)) 100 (Lambertian (V3 0.7 0.6 0.5))
         ]
-  let coords = [(x, y) | x <- reverse $ [-1 * (w `div` 2) .. (w `div` 2) - 1], y <- [-1 * (h `div` 2) .. (h `div` 2) - 1]]
-  colors <- mapM (\x -> rayTrace x (w, h) (1.0, 1.0) world samples) coords
+  let coords = [(x, y) | x <- reverse [0 .. w - 1], y <- [0 .. h - 1]]
+  colors <- mapM (\x -> rayTrace x (w, h) world samples camera) coords
   let convertedColors = map v3ToColor colors
   -- print ppm header
   putStrLn "P3"

src/Camera.hs

@@ -0,0 +1,14 @@
+module Camera (Camera (..), makeCamera) where
+
+import Linear.V3
+import Linear.Vector
+
+data Camera = Camera {origin :: V3 Double, lowerLeft :: V3 Double, horizontal :: V3 Double, vertical :: V3 Double}
+
+makeCamera :: V3 Double -> Double -> Double -> Double -> Camera
+makeCamera o viewWidth viewHeight focalLength = do
+  let horizontal = V3 viewWidth 0.0 0.0
+  let vertical = V3 0.0 viewHeight 0.0
+  let focalVec = V3 0.0 0.0 focalLength
+  let lowerLeft = o ^-^ (horizontal ^/ 2) ^-^ (vertical ^/ 2) ^-^ focalVec
+  Camera o lowerLeft horizontal vertical

src/Hittable.hs

@@ -36,11 +36,11 @@ instance Shape Circle where
               then Just (Hit rootP pp (getFaceNormal (Ray o d) ((pp - center) ^/ r)) m)
               else Nothing
     where
-      co = o - center
+      co = o ^-^ center
       a = lengthSquared d -- a vector dotted with itself is = lengthSquared
       b = co `dotP` d
-      c = lengthSquared co - r ^ 2
-      discriminant = b ^ 2 - a * c
+      c = lengthSquared co - r * r
+      discriminant = b * b - a * c
       root = (b * (-1.0) - sqrt discriminant) / a
       rootP = (b * (-1.0) + sqrt discriminant) / a
       p = rayAt (Ray o d) root

src/Ray.hs

@@ -7,6 +7,7 @@ module Ray
   )
 where
 
+import Camera
 import Control.Monad.Random
 import Linear.V3
 import Linear.Vector
@@ -22,11 +23,11 @@ rayAt (Ray origin dir) t = origin + (t *^ dir)
 calculateRayNormal :: Ray -> Double -> V3 Double
 calculateRayNormal r t = unitVector (rayAt r t ^-^ V3 0.0 0.0 1.0)
 
-buildRayAA :: (RandomGen g) => Double -> Double -> Rand g Ray
-buildRayAA u v = do
+buildRayAA :: (RandomGen g) => Double -> Double -> Camera -> Rand g Ray
+buildRayAA u v camera = do
   ur <- rand
   vr <- rand
-  return (Ray (V3 0.0 0.0 0.0) (V3 (v + vr) (u + ur) (-1.0)))
+  return $ buildRay (u + ur) (v + vr) camera
 
-buildRay :: Double -> Double -> Ray
-buildRay u v = Ray (V3 0.0 0.0 0.0) (V3 v u (-1.0))
+buildRay :: Double -> Double -> Camera -> Ray
+buildRay u v (Camera o ll h vv) = Ray o (ll ^+^ (v *^ h) ^+^ (u *^ vv) ^-^ o)