From 9205c91cc7ab658f95f0abbda47692f9971305bf Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Thu, 23 Oct 2014 18:51:27 +0200
Subject: [PATCH] an imagecabal build && ./raytrace && eog out.png

---
 scenes/test.sce    |  2 +-
 src/Main.hs        | 55 +++++++++++++++++++++++++++++++++++++++++-----
 src/Scene/Types.hs |  5 +++++
 3 files changed, 55 insertions(+), 7 deletions(-)

diff --git a/scenes/test.sce b/scenes/test.sce
index 4a70eef..a2fbc30 100644
--- a/scenes/test.sce
+++ b/scenes/test.sce
@@ -21,4 +21,4 @@ sphere -1.0 0.5 2.0  0.5  0.0 1.0 0.0  0.0 1.0 0.0  1.0 1.0 1.0  200.0  0.2
 sphere  3.0 2.0 1.5  2.0  0.0 0.0 1.0  0.0 0.0 1.0  1.0 1.0 1.0   50.0  0.2
 
 # planes: center, normal, material
-plane  0 0 0  0 1 0  0.2 0.2 0.2  0.2 0.2 0.2  0.0 0.0 0.0  100.0  0.1
+#plane  0 0 0  0 1 0  0.2 0.2 0.2  0.2 0.2 0.2  0.0 0.0 0.0  100.0  0.1
diff --git a/src/Main.hs b/src/Main.hs
index e918d27..ca38ef5 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -2,12 +2,15 @@
 module Main where
 
 import Control.Applicative
+import Control.Arrow
 import Codec.Picture.Png
 import Codec.Picture.Types
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as B8
-import Data.Vector hiding ((++),map)
+import Data.Vector hiding ((++),map, foldl, filter, foldl1)
 import Data.Word (Word8)
+import Data.Maybe
+import Linear (V3(..), (^+^), (^*), (^-^), dot, axisAngle, rotate, cross)
 
 import Data.Attoparsec
 
@@ -73,18 +76,58 @@ validateAndParseScene f = do
                    }
 
 render :: Int -> Int -> Scene -> Int -> PixelRGB8
-render w h s index = trace (show (x,y)) PixelRGB8 255 (fromIntegral x) (fromIntegral y)
+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
         where
-            y = index `mod` w
-            x = index `div` w
+            (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 = Ray (center cam) $ rotCam x y w h (eye cam) (up cam) (fovy cam)
+            cam = sceneCamera s
+            y = fromIntegral $ index `mod` w
+            x = fromIntegral $ index `div` w
+            ci = floor . (*255)
+
+rotCam :: Float -> Float -> Int -> Int -> V3 Float -> V3 Float -> Float -> V3 Float
+rotCam x y w h dir up fovy = rotxy 
+            where
+                rotxy = rotateDegAx (rad $ fovy*dy) (cross up roty) roty
+                roty  = rotateDegAx (rad $ fovy*dx) up dir
+                dx = (x - (fromIntegral w) / 2)/(fromIntegral w)
+                dy = (y - (fromIntegral h) / 2)/(fromIntegral h)
+                rad = (*pi).(/180)
+
+rotateDegAx :: Float -> V3 Float -> V3 Float -> V3 Float
+rotateDegAx phi axis = rotate q
+                where
+                    q = axisAngle axis phi
 
 data Ray = Ray (V3 Float) (V3 Float)
 
 data Collision = Collision (V3 Float) Float Collidable
+                    deriving (Eq)
+
+instance Ord Collision where
+    compare (Collision _ a _) (Collision _ b _) = compare a b
 
 intersect :: Ray -> Collidable -> Maybe Collision
-intersect (Ray ro rd) (S (Sphere sc sr _) = undefined
-intersect _ = undefined
+intersect (Ray ro rd) s@(S (Sphere sc sr _)) = if (d > 0 && int > 0) then
+                                                Just (Collision (ro ^+^ (rd ^* int)) int s)
+                                              else
+                                                Nothing
+                                where
+                                    a = dot rd rd
+                                    b = 2 * dot rd oc
+                                    c = dot oc oc - sr*sr
+                                    d = b * b - 4 * a * c
+                                    oc = ro ^-^ sc
+                                    int = case ints of 
+                                            [] -> 0
+                                            a  -> foldl1 min a
+                                    ints = filter (uncurry (&&).(&&&) (>0.00001) (not.isNaN)) [(-b-(sqrt d))/(2*a),(-b+(sqrt d))/(2*a)]
+intersect _ _ = undefined
 
 main :: IO ()
 main = do
diff --git a/src/Scene/Types.hs b/src/Scene/Types.hs
index b19bff5..1ddc5cf 100644
--- a/src/Scene/Types.hs
+++ b/src/Scene/Types.hs
@@ -84,3 +84,8 @@ data Scene = Scene
            , sceneObjects    :: [Collidable]
            }
                 deriving (Show, Eq)
+
+getMaterial :: Collidable -> Material
+getMaterial (S (Sphere _ _ m)) = m
+getMaterial (P (Plane _ _ m)) = m
+getMaterial (M (Mesh _ _ m)) = m