1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
type t = { origin : Vec3.t; direction : Vec3.t }
let eps = 1e-9
let make (origin : Vec3.t) (direction : Vec3.t) : t =
if Vec3.length direction < eps then invalid_arg "Ray.make: a zero direction";
{ origin; direction = Vec3.normalize direction }
let at (ray : t) (t : float) : Vec3.t = Vec3.add ray.origin (Vec3.scale t ray.direction)
let sphere (ray : t) ((c, r) : Vec3.t * float) : (float * float) option =
let m = Vec3.sub ray.origin c in
let b = Vec3.dot m ray.direction and k = Vec3.dot m m -. (r *. r) in
let disc = (b *. b) -. k in
if disc < 0. then None
else
let s = sqrt disc in
Some (-.b -. s, -.b +. s)
let plane (ray : t) ((n, d) : Vec3.t * float) : float option =
let denom = Vec3.dot n ray.direction in
if Float.abs denom < eps then None else Some ((d -. Vec3.dot n ray.origin) /. denom)
let triangle (ray : t) ((a, b, c) : Vec3.t * Vec3.t * Vec3.t) : (float * float * float) option =
let e1 = Vec3.sub b a and e2 = Vec3.sub c a in
let p = Vec3.cross ray.direction e2 in
let det = Vec3.dot e1 p in
if Float.abs det < eps then None
else
let inv = 1. /. det in
let s = Vec3.sub ray.origin a in
let u = Vec3.dot s p *. inv in
if u < 0. || u > 1. then None
else
let q = Vec3.cross s e1 in
let v = Vec3.dot ray.direction q *. inv in
if v < 0. || u +. v > 1. then None else Some (Vec3.dot e2 q *. inv, u, v)
let box (ray : t) (((lx, ly, lz), (hx, hy, hz)) : Vec3.t * Vec3.t) : (float * float) option =
let ox, oy, oz = ray.origin and dx, dy, dz = ray.direction in
let slab o d lo hi (t_in, t_out) =
if Float.abs d < eps then
if o < lo || o > hi then (infinity, neg_infinity) else (t_in, t_out)
else
let t1 = (lo -. o) /. d and t2 = (hi -. o) /. d in
(Float.max t_in (Float.min t1 t2), Float.min t_out (Float.max t1 t2))
in
let t_in, t_out = slab oz dz lz hz (slab oy dy ly hy (slab ox dx lx hx (neg_infinity, infinity))) in
if t_in > t_out then None else Some (t_in, t_out)