jort-1.0.0: Objects.hs

module Objects where

import Vectors
import Basics
import Data.List(sort)
import Debug.Trace

newtype ProtoObject = ProtoObject { fromProto :: Int -> Object }
data Object = Object !Int !Shape !Texture deriving Show

object sh tex = ProtoObject (\ id -> Object id sh tex)

--objectTexture (Object _ _ material) = material

data Shape 
    = Sphere !Vector !Scal -- center, radius
    | Plane !Vector !Scal  -- normal, distance to origin
    | Quadric !Vector !Vector !Scal  -- center, director, const

{- Equation of (Quadric c d k) is (norm (x-c) == abs ( d `dotProd` (x-c)) + k)
let e = norm d, then
e = 0 => sphere
0 < e < 1 => ellipsoid
e = 1 => cylinder
e > 1 => hyperboloid (or cone, when k = 0)

-}
    | Meta ![MetaPoint] !Scal -- points, threshold
  deriving Show

data MetaPoint = MetaPoint !Vector !Scal -- center, strength
  deriving Show




eps :: Scal
eps = (1.0e-3)

distance src ray (Object id sh m) = distance' src ray sh
getNormal (Object id sh m) = getNormal' sh

distance' source ray (Sphere center rad) = solution
  -- we solve sq t - 2*b*t + * c = 0 (w.r.t. t)
    where b = ray `dotProd` (center - source)
	  c = sqnorm (center - source) - sq rad
	  d = b * b - c
	  solution
	      | d < 0.0 = infinite
	      | sol1 > 0 = sol1
	      | sol2 > 0 = sol2
	      | otherwise = infinite
	  sol1 = b - sqrt d
	  sol2 = b + sqrt d

distance' source ray (Plane norm dist) = solution
 where solution = if abs v1 > eps && ((v > 0.0) == (v1 > 0.0)) then v / v1 else infinite
       v1 = norm `dotProd` ray
       v = dist - norm `dotProd` source


distance' source ray (Quadric center dir sqk0) = solution
    where 
	  a = 1 - sq (ray .* dir)
	  b = ray .* ((c0 .* dir) `scale` dir - c0)
	  c = sqnorm c0 - sqk0 - sq (c0 .* dir)
	  d = b * b - a * c
	  sol1 = (b - sqrt d)/a
	  sol2 = (b + sqrt d)/a
	  sol = if a > 0 then sol1 else sol2
	  -- the good solution depends on the concavity/convexy of the curve
	  solution = if d >= 0 && sol > 0 then sol else infinite
  	  c0 = source - center

distance' source ray (Meta points threshold) = --trace ("Maxs = " ++ show maximums) $ 
					       --trace ("Dens = " ++ show (map density maximums)) $ 
                                               if ubound > 0 then solution else infinite
    where ubound = sum [(strength/(c-b*b)) | (b, c, strength) <- pointInfo] - threshold
	  pointInfo = [(ray .* (center - source),
			sqnorm (center - source) + 0.001,
			strength) |
		       MetaPoint center strength <- points]
	  
	  maximums = [b | (b, _, _) <- pointInfo, b > 0]
	  
	  density x = sum [(strength/(x*x-2*b*x+c)) | (b, c, strength) <- pointInfo] - threshold
	  forwardFindSolution (x0:x1:xs)
	      | density x1 > 0 = dichoFindSolution x0 x1
	      | otherwise = forwardFindSolution (x1:xs)
	  forwardFindSolution (x0:[]) = infinite
	  dichoFindSolution x0 x1 
	      | x1 - x0 < eps = mid
	      | density mid >  0 = dichoFindSolution x0  mid
	      | density mid <= 0 = dichoFindSolution mid x1
	      where mid = (x1 + x0) / 2
	  solution = forwardFindSolution (0:sort maximums)
	      


sq x = x * x

getNormal' (Sphere center rad) hit = (1.0/rad) `scale` (hit - center)
getNormal' (Plane norm dist) hit = norm

getNormal' (Quadric center dir k) hit = normalized $ 
      v - (c `scale` dir)
    where v = hit - center
	  c = dir `dotProd` v 

getNormal' (Meta points threshold) hit = 
    normalized $ sum [ (strength / sq (sqnorm (hit-center))) `scale` 
			(hit-center)
			| MetaPoint center strength <- points ]