an imagecabal build && ./raytrace && eog out.png

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

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

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