added adjustable camera

app/Main.hs

@@ -26,14 +26,14 @@ scatter (Ray o d) (Hit t p n (Lambertian c)) = do
 scatter (Ray o d) (Hit t p n (Metal c)) = do
   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
+scatter (Ray o d) (Hit t p n Glass) = do
+  let refraction_ratio = if isFrontFace (Ray o d) n then 1.0 / 1.5 else 1.5
   let ud = unitVector d
-  let ct = min (ud `dotP` n) 1.0
+  let ct = min (negated ud `dotP` n) 1.0
   let st = sqrt (1.0 - ct * ct)
-  rVal <- rand
+  rVal <- randRange 0 1
 
-  if refraction_ratio * st > 1.0 || reflectance ct refraction_ratio < rVal
+  if refraction_ratio * st > 1.0 || reflectance ct refraction_ratio > rVal
     then do
       let reflected = reflect ud n
       return $ Ray p reflected
@@ -70,7 +70,7 @@ getRayColor' (Ray o d) (Just (Hit t p n m)) ws depth = do
 colorGradient :: V3 Double -> V3 Double
 colorGradient (V3 x y z) = do
   let t = 0.5 * (y + 1.0)
-  (1.0 - t) *^ V3 1.0 1.0 1.0 + t *^ V3 0.5 0.7 1.0
+  ((1.0 - t) *^ V3 1.0 1.0 1.0) ^+^ (t *^ V3 0.5 0.7 1.0)
 
 -- from a list of possible hits, get the closest possible hit found
 getBestHit :: [Hit] -> Maybe Hit
@@ -93,23 +93,19 @@ rayTrace :: (Shape s) => (Int, Int) -> ImageDimensions -> [s] -> Int -> Camera -
 rayTrace coord dim world samples camera = do
   let maxDepth = 50
   l <- replicateM samples (evalRandIO (grc coord dim world maxDepth camera))
-  return $ foldl (^+^) (V3 0.0 0.0 0.0) l
+  return $ sumV l
 
 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 aspect = 1.0 -- 16.0 / 9.0
+  let camera = makeCamera (V3 0.0 0.0 1.0) (V3 0.0 0.0 (-1.0)) (V3 0.0 1.0 0.0) 90 aspect
 
-  let camera = makeCamera (V3 0.0 0.0 0.0) viewWidth viewHeight focalLength
-
-  let samples = 25
+  let samples = 500
   let world =
-        [ Circle (V3 0.0 0.0 (-1.0)) 0.5 (Glass (V3 1.0 1.0 1.0)),
+        [ Circle (V3 0.0 0.0 (-1.0)) 0.5 Glass,
           Circle (V3 1.0 0.0 (-1.0)) 0.5 (Lambertian (V3 1.0 0.753 0.796)),
           Circle (V3 0.0 (-100.5) (-1.0)) 100 (Lambertian (V3 0.7 0.6 0.5))
         ]

src/Camera.hs

@@ -2,13 +2,24 @@ module Camera (Camera (..), makeCamera) where
 
 import Linear.V3
 import Linear.Vector
+import Maths
 
 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
+--lookat :: V3 Double, vup :: V3 Double}
+
+makeCamera :: V3 Double -> V3 Double -> V3 Double -> Double -> Double -> Camera
+makeCamera o lookat vup vfov aspect = do
+  let t = degToRadians vfov
+  let h = tan (t / 2)
+  let vh = 2.0 * h
+  let vw = aspect * vh
+
+  let w = unitVector (o ^-^ lookat)
+  let u = unitVector (cross vup w)
+  let v = cross w u
+
+  let horizontal = vw *^ u
+  let vertical = vh *^ v
+  let lowerLeft = o ^-^ (horizontal ^/ 2) ^-^ (vertical ^/ 2) ^-^ w
   Camera o lowerLeft horizontal vertical

src/Hittable.hs

@@ -15,13 +15,13 @@ data Hit = Hit {root :: Double, p :: V3 Double, n :: V3 Double, m :: Material}
 
 getFaceNormal :: Ray -> V3 Double -> V3 Double
 getFaceNormal (Ray o d) n
-  | (d `dotP` n) < 0.0 = n
-  | otherwise = (-1.0) *^ n
+  | (d `dotP` n) > 0.0 = negated n
+  | otherwise = n
 
 isFrontFace :: Ray -> V3 Double -> Bool
 isFrontFace (Ray o d) n
-  | (d `dotP` n) < 0.0 = True
-  | otherwise = False
+  | (d `dotP` n) > 0.0 = False
+  | otherwise = True
 
 -- t_min 0 t_max infinity... need closest so far
 instance Shape Circle where
@@ -41,8 +41,9 @@ instance Shape Circle where
       b = co `dotP` d
       c = lengthSquared co - r * r
       discriminant = b * b - a * c
-      root = (b * (-1.0) - sqrt discriminant) / a
-      rootP = (b * (-1.0) + sqrt discriminant) / a
+      sqrtd = sqrt discriminant
+      root = ((b * (-1.0)) - sqrtd) / a
+      rootP = ((b * (-1.0)) + sqrtd) / a
       p = rayAt (Ray o d) root
       pp = rayAt (Ray o d) rootP
 

src/Material.hs

@@ -3,8 +3,8 @@ module Material (Material (..), attenuation) where
 import Linear.V3
 import Linear.Vector
 
-data Material = Lambertian (V3 Double) | Metal (V3 Double) | Glass (V3 Double)
+data Material = Lambertian (V3 Double) | Metal (V3 Double) | Glass
 
 attenuation (Lambertian c) = c
 attenuation (Metal c) = c
-attenuation (Glass c) = V3 1.0 1.0 1.0
+attenuation Glass = V3 1.0 1.0 1.0

src/Maths.hs

@@ -9,6 +9,7 @@ module Maths
     refract,
     reflectance,
     clamp,
+    degToRadians,
   )
 where
 
@@ -54,11 +55,11 @@ refract :: V3 Double -> V3 Double -> Double -> V3 Double
 refract uv n etai_over_etat = perp ^+^ parallel
   where
     ct = min (uv `dotP` n) 1.0
-    perp = etai_over_etat *^ ((-1.0 *^ uv) ^+^ (ct *^ n))
-    parallel = -1.0 * sqrt (abs (1.0 - lengthSquared perp)) *^ n
+    perp = etai_over_etat *^ (negated uv ^+^ (ct *^ n))
+    parallel = (-1.0) * sqrt (abs (1.0 - lengthSquared perp)) *^ n
 
 reflectance :: Double -> Double -> Double
-reflectance c r = r00 + (1 - r00) * (1 - c) ^ 5
+reflectance c r = r00 + (1 - r00) * ((1 - c) ^ 5)
   where
     r0 = (1 - r) / (1 + r)
     r00 = r0 * r0