From 197e1a84d7a75707c2329f1652ff33ce3ed9aaf0 Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Fri, 24 Oct 2014 22:40:40 +0200
Subject: [PATCH] added diffuse light

---
 src/Scene/Renderer.hs | 63 ++++++++++++++++++++++++++++++++++---------
 src/Scene/Types.hs    |  8 ++++--
 2 files changed, 56 insertions(+), 15 deletions(-)

diff --git a/src/Scene/Renderer.hs b/src/Scene/Renderer.hs
index 0ad300d..a1a2758 100644
--- a/src/Scene/Renderer.hs
+++ b/src/Scene/Renderer.hs
@@ -19,29 +19,66 @@ import Debug.Trace
 
 data Ray = Ray (V3 Float) (V3 Float)
 
-data Collision = Collision (V3 Float) Float Collidable
+-- | Collision position normal distance object
+data Collision = Collision (V3 Float) (V3 Float) Float Collidable
                     deriving (Eq)
 
 instance Ord Collision where
-    compare (Collision _ a _) (Collision _ b _) = compare a b
+    compare (Collision _ _ a _) (Collision _ _ b _) = compare a b
 
 render :: Int -> Int -> Scene -> Int -> PixelRGB8
-render w h s index = case pcolls of
-                        [] -> PixelRGB8 (ci br) (ci bg) (ci bb) --no collision -> Background
-                        _  -> PixelRGB8 (ci ar) (ci ag) (ci ab) --collission -> git color
+render w h s index = PixelRGB8 (ci cr) (ci cg) (ci cb)
         where
-            (V3 ar ag ab) = materialAmbience $ getMaterial coll
-            (Background (V3 br bg bb)) = sceneBackground s
-            pcolls = map fromJust $ filter isJust $ (intersect ray) <$> (sceneObjects s)
-            (Collision pos _ coll) = foldl1 min pcolls
-            ray = camRay x y (sceneCamera s) 
+            (V3 cr cg cb) =
+                case raytrace ray s of
+                  Nothing -> bgColor $ sceneBackground s
+                  Just c@(Collision pos _ _ obj) ->
+                         -- ambient lighting
+                         ((*) <$> (ambColor . ambientLight $ s) <*> (materialAmbience . getMaterial $ obj))
+                         -- + diffuse lighting
+                         ^+^ (foldl1 (^+^) $ (diffuse c s) <$> sceneLights s)
+                         -- + reflections - TODO
+            ray = camRay x y (sceneCamera s)
             y = fromIntegral $ index `mod` w
             x = fromIntegral $ index `div` w
-            ci = floor . (*255)
+            ci = floor . (clamp 0 255) . (*255)
             --wrong format:
             --Ray (eye cam) $ rotCam x y w h (center cam ^-^ eye cam) (up cam) (fovy cam)
             --cam = sceneCamera s
 
+diffuse :: Collision -> Scene -> Light -> V3 Float
+diffuse (Collision pos n _ obj) s (Light lpos color int) =
+            case blocked of
+                Nothing                   -> ill
+                Just (Collision _ _ dist _) -> if dist < norm lightdir
+                                            then
+                                                V3 0 0 0 --light is blocked -> no lighting from here.
+                                            else
+                                                ill
+        where
+            ill = (*) (dot n $ normalize lightdir) <$> illumination
+            illumination = (*) <$> color ^* i <*> materialDiffuse mat
+            mat = getMaterial obj
+            blocked = raytrace (Ray pos lightdir) s
+            lightdir = (lpos ^-^ pos)
+            i = case int of
+                    Nothing -> 1
+                    Just a -> a
+
+clamp :: Ord a => a -> a -> a -> a
+clamp min max x
+        | x < min = min
+        | x > max = max
+        | otherwise = x
+
+raytrace :: Ray -> Scene -> Maybe Collision
+raytrace r s = case possibleCollisions of
+                    [] -> Nothing
+                    _  -> Just $ foldl1 min possibleCollisions
+               where
+                    possibleCollisions :: [Collision]
+                    possibleCollisions = map fromJust $ filter isJust $ (intersect r) <$> (sceneObjects s)
+
 camRay :: Float -> Float -> Camera -> Ray
 camRay x y c = Ray (eye c) (lowerLeft c ^+^ x *^ xDir c ^+^ y *^ yDir c ^-^ eye c)
 
@@ -52,7 +89,7 @@ rotateDegAx phi axis = rotate q
 
 intersect :: Ray -> Collidable -> Maybe Collision
 intersect (Ray ro rd) s@(S (Sphere sc sr _)) = if (d > 0 && int > 0) then
-                                                Just (Collision (ro ^+^ (rd ^* int)) int s)
+                                                Just (Collision pos (normalize $ pos ^-^ sc) int s)
                                               else
                                                 Nothing
                                 where
@@ -61,6 +98,7 @@ intersect (Ray ro rd) s@(S (Sphere sc sr _)) = if (d > 0 && int > 0) then
                                     c = dot oc oc - sr*sr
                                     d = b * b - 4 * a * c
                                     oc = ro ^-^ sc
+                                    pos = ro ^+^ (rd ^* int)
                                     int = case ints of
                                             [] -> 0
                                             a  -> foldl1 min a
@@ -77,4 +115,3 @@ rotCam x y w h dir up fovy = rotxy
                 dx = (x - (fromIntegral w) / 2)/(fromIntegral w)
                 dy = (y - (fromIntegral h) / 2)/(fromIntegral h)
                 rad = (*pi).(/180)
-
diff --git a/src/Scene/Types.hs b/src/Scene/Types.hs
index 44f4422..6db08a0 100644
--- a/src/Scene/Types.hs
+++ b/src/Scene/Types.hs
@@ -20,10 +20,14 @@ data Camera = Camera
 
 type RecursionDepth = Int
 
-data Background = Background Color
+data Background = Background 
+                { bgColor :: Color
+                }
                 deriving (Show, Eq)
 
-data Ambience = Ambience Color
+data Ambience = Ambience
+                { ambColor :: Color
+                }
                 deriving (Show, Eq)
 
 data Light = Light (V3 Float) Color (Maybe Intensity)