★ /prog/ Challenge Summer Edition ★

THE CHALLENGE:
I) Write three functions, union :: [(Float,Float)] -> [(Float,Float)], difference :: [(Float,Float)] -> [(Float,Float)], intersection :: [(Float,Float)] -> [(Float,Float)]
Which perform the respective set operations on their input, a list of closed intervals of the form (min, max). Your functions need not support sentinel values such as NaN or infinity. The number of intervals returned should be minimized where possible.

II) Use your functions from I to implement a simple ^CSG _raytracer. Your raytracer should support the following features:

• Spheres
• Diffuse surfaces
• Specular surfaces

Upon completion, post your source code here, along with one (1) example rendering, showcasing ^your raytracer. The example render should include an example of each set operation performed on two spheres, for a total of six spheres. A single directional light source should be used to light the scene.

Submissions close on 2010-10-04 at 00:00. Programs will be marked in three categories: efficiency, conciseness, and quality of implementation.

Each winner is entitled to claim ownership of two (2) /prog/ memes of his choice, with the exception of SICP, HMA, and UMH.

>>8
We're not all NEET, but since you are so eager here's my work in progress.

Union: http://img52.imageshack.us/img52/9596/uniono.png
Difference: see Union
Intersection: http://img833.imageshack.us/img833/2696/intersection.png

type interval = Interval of float * float

let rec union a b =
  match (a, b) with
      ([], _) -> b
    | (_, []) -> a
    | (Interval(a_l, a_h) :: a_r, Interval(b_l, b_h) :: b_r) ->
      if a_h < b_l then List.hd a :: union a_r b else
      if b_h < a_l then List.hd b :: union a b_r else
      union (Interval(min a_l b_l, max a_h b_h) :: a_r) b_r

let rec difference a b =
  match (a, b) with
      ([], _) -> b
    | (_, []) -> a
    | (Interval(a_l, a_h) :: a_r, Interval(b_l, b_h) :: b_r) ->
      if a_h < b_l then List.hd a :: union a_r b else
      if b_h < a_l then List.hd b :: union a b_r else
      Interval(min a_l b_l, max a_l b_l) ::
        difference (Interval(min a_h b_h, max a_h b_h) :: a_r) b_r

let rec intersection a b =
  match (a, b) with
      ([], _) -> []
    | (_, []) -> []
    | (Interval(a_l, a_h) :: a_r, Interval(b_l, b_h) :: b_r) ->
      if a_h < b_l then union a_r b else
      if b_h < a_l then union a b_r else
      Interval(max a_l b_l, min a_h b_h) ::
        if a_h > b_h then difference a b_r else difference a_r b

type vector = Vector of float * float * float

let vector_sub (Vector(a_x, a_y, a_z)) (Vector(b_x, b_y, b_z)) =
  Vector(a_x -. b_x, a_y -. b_y, a_z -. b_z)

let vector_dot (Vector(a_x, a_y, a_z)) (Vector(b_x, b_y, b_z)) =
  a_x *. b_x +. a_y *. b_y +. a_z *. b_z

type sphere = Sphere of vector * float

let line_sphere o i (Sphere(c, r)) =
  let c' = vector_sub c o in
  let i_c' = vector_dot i c' in
  let det = (i_c' *. i_c') -. (vector_dot c' c') +. (r *. r) in
  if det < 0. then [] else
    let sqrt_det = sqrt det in
    [Interval(i_c' -. sqrt_det, i_c' +. sqrt_det)]

type csg =
    Union of csg * csg
  | Difference of csg * csg
  | Intersection of csg * csg
  | Primitive of sphere

let rec ray o i csg =
  match csg with
      Union(a, b) -> union (ray o i a) (ray o i b)
    | Difference(a, b) -> difference (ray o i a) (ray o i b)
    | Intersection(a, b) -> intersection (ray o i a) (ray o i b)
    | Primitive(s) -> line_sphere o i s

let rec visible l =
  match l with
      [] -> None
    | Interval(l, h) :: r ->
      if h > 0. then Some (max 0. l) else visible r

type color = {r: int; g: int; b: int}

let view x y csg =
  match visible (ray (Vector(x,y,0.)) (Vector(0.,0.,1.)) csg) with
      None -> {r=255;g=0;b=255}
    | Some z ->
      let k = int_of_float (50. +. (1. -. z) *. 155.) in {r=k;g=k;b=k}

let ppm w h csg =
  print_string "P6 ";
  print_int w;
  print_string " ";
  print_int h;
  print_string " 255";
  print_newline ();

  let w' = float_of_int w in
  let h' = float_of_int h in
 
  let rec yloop y =
    let rec xloop x =
      if x >= w' then yloop (y +. 1.) else
        let color = view (x /. w') (y /. h') csg in
        print_char (char_of_int color.r);
        print_char (char_of_int color.g);
        print_char (char_of_int color.b);
        xloop (x +. 1.)
    in if y >= h' then () else xloop 0.
  in yloop 0.

let sphere1 = Sphere(Vector(0.4,0.4,0.5), 0.3)

let sphere2 = Sphere(Vector(0.6,0.6,0.7), 0.4)

let test_csg = Union(Primitive(sphere1), Primitive(sphere2))

let _ = ppm 500 500 test_csg