open Misc
open Point
open Object

(* Map object coordinates to texture coordinates *)

(* Sphere:
      x = sqrt(1 - y^2) sin(360u)
      y = 2v - 1
      z = sqrt(1 - y^2) cos(360u)
   hence v = (y+1)/2
     and u = atan2_turns(x, z) (atan2 in "number of turns")
*)

let inv2pi = 1.0 /. (2.0 *. pi)

let atan2_turns x z =   (* result between 0 and 1 *)
  let r = (atan2 x z) *. inv2pi in
  if r >= 0.0 then r else r +. 1.0

let sphere_coords x y z =
  (0, atan2_turns x z, (y +. 1.0) *. 0.5)

(* Cube:
     (x, y, 0)  ->  (0, x, y)
     (x, y, 1)  ->  (1, x, y)
     (0, y, z)  ->  (2, z, y)
     (1, y, z)  ->  (3, z, y)
     (x, 1, z)  ->  (4, x, z)
     (x, 0, z)  ->  (5, x, z)
   Watch out for rounding errors when determining which coordinate is 0 or 1;
   see which one is closest to 0 or 1 *)

let cube_coords x y z =
  let dists = [| abs_float z; abs_float (1.0 -. z);
                 abs_float x; abs_float (1.0 -. x);
                 abs_float (1.0 -. y); abs_float y |] in
  let min = ref dists.(0) and face = ref 0 in
  for i = 1 to 5 do
    let d = dists.(i) in if d < !min then begin min := d; face := i end
  done;
  match !face with
    0 -> (0, x, y)
  | 1 -> (1, x, y)
  | 2 -> (2, z, y)
  | 3 -> (3, z, y)
  | 4 -> (4, x, z)
  | 5 -> (5, x, z)
  | _ -> assert false

(* Cylinder:
     (x, 0, z)  ->  (2, u, v) where x = 2u-1 and z = 2v-1 hence
     (x, 1, z)  ->  (1, x, z)   u = (x+1)/2 and v = (z+1)/2
     (x, y, z)  ->  (0, u, v) where x = sin(360u)  v = y  z = cos(360u)
                              hence u = atan2_turns(x, z)  and v = y
*)

let cylinder_coords x y z =
  let min = ref (y *. y) and face = ref 0 in
  let y' = 1.0 -. y in let d = y' *. y' in
  if d < !min then begin min := d; face := 1 end;
  let d = abs_float (x *. x +. z *. z -. 1.0) in
  if d < !min then face := 2;
  match !face with
    0 -> (2, (x +. 1.0) *. 0.5, (z +. 1.0) *. 0.5)
  | 1 -> (1, (x +. 1.0) *. 0.5, (z +. 1.0) *. 0.5) 
  | 2 -> (0, atan2_turns x z, y)
  | _ -> assert false

(* Cone:
     (x, y, z)  ->  (0, u, v)  where x = v sin 360u
                                     y = v
                                     z = v cos 360u
                               hence u = atan2_turns(x, z) and v = y
     (x, 1, z)  ->  (1, u, v)  where x = 2u-1 and z = 2v-1
                               hence u = (x+1)/2 and v = (z+1)/2
*)

let cone_coords x y z =
  let y' = 1.0 -. y in
  if y' *. y' < abs_float (x *. x +. z *. z -. y *. y)
  then (1, (x +. 1.0) *. 0.5, (z +. 1.0) *. 0.5)
  else (0, atan2_turns x z, y)

(* Plane *)

let plane_coords x y z = (0, x, z)

(* All together *)

let coords bobj p =
  match bobj.kind with
    Cone -> cone_coords p.x p.y p.z
  | Cube -> cube_coords p.x p.y p.z
  | Cylinder -> cylinder_coords p.x p.y p.z
  | Plane -> plane_coords p.x p.y p.z
  | Sphere -> sphere_coords p.x p.y p.z

(* For faces *)
      
let cylinder_faces x y z =
  let min = ref (y *. y) and face = ref 0 in
  let y' = 1.0 -. y in let d = y' *. y' in
  if d < !min then begin min := d; face := 1 end;
  let d = abs_float (x *. x +. z *. z -. 1.0) in
  if d < !min then face := 2;
  !face
      

let cone_faces x y z =
  let y' = 1.0 -. y in
  if y' *. y' < abs_float (x *. x +. z *. z -. y *. y)
  then 1
  else 0
    
let cube_faces x y z =
  let dists = [| abs_float z; abs_float (1.0 -. z);
                 abs_float x; abs_float (1.0 -. x);
                 abs_float (1.0 -. y); abs_float y |] in
  let min = ref dists.(0) and face = ref 0 in
  for i = 1 to 5 do
    let d = dists.(i) in if d < !min then begin min := d; face := i end
  done;
  !face

let cylinder_faces x y z =
  let min = ref (y *. y) and face = ref 0 in
  let y' = 1.0 -. y in let d = y' *. y' in
  if d < !min then begin min := d; face := 1 end;
  let d = abs_float (x *. x +. z *. z -. 1.0) in
  if d < !min then face := 2;
  2 - !face
  
let faces bobj p =
  match bobj.kind with
    Cone -> cone_faces p.x p.y p.z
  | Cube -> cube_faces p.x p.y p.z
  | Cylinder -> cylinder_faces p.x p.y p.z
  | Plane -> 0
  | Sphere -> 0