module Trace where import Basics import Objects import Lights import Colors import Data.List(delete, minimumBy) import World import Debug.Trace import Env maxLevel = 4 minIntensity = 0.01 switchInside objectId insideList = if objectId `elem` insideList then delete objectId insideList else objectId : insideList traceRay level world from dir insideList refrCoef = color where (hitDist, hitObject) = minimumBy compFst distances distances = [(distance from dir obj, obj) | obj <- worldObjects world] color = if hitDist == infinite then envColor else objectColor envColor = worldEnv world $ dir objectColor = diffuseColor + if level < maxLevel then reflectionCol + refractionCol else blackColor (objectRefl, objectRefr) = if critic > 0 then (materialReflection hitMaterial, materialRefraction hitMaterial) else (materialReflection hitMaterial + materialRefraction hitMaterial, 0) hitMaterial = hitTexture hit reflectionCol = objectRefl <*> traceRay (level+1) world (hit+reflectionDir) reflectionDir insideList refrCoef refractionCol = objectRefr <*> traceRay (level+1) world (hit+refractionDir) refractionDir (switchInside hitId insideList) (materialRefrCoef hitMaterial) col1 <*> col2 = if intensity col1 > minIntensity then col1 * col2 else blackColor ratio = refrCoef / (materialRefrCoef hitMaterial) hit = hitDist `scale` dir + from ci = normal .* dir critic = 1 + sq ratio * (sq ci - 1) -- 1 / sq ratio + sq ci - 1 reflectionDir = dir - (2 * ci) `scale` normal refractionDir = ratio `scale` dir - (ratio * ci - sqrt critic) `scale` normal -- ratio `scale` (dir - (ci - sqrt critic) `scale` normal) normal' = getNormal hitObject hit normal = if normal' `dotProd` dir < 0 then negate normal' else normal' Object hitId hitShape hitTexture = hitObject diffuseColor = sum $ map (lighten world hitMaterial hit normal') $ worldLights world compFst (x, _) (y, _) = compare x y