Reusable 3D Earth globe widget (pure OCaml + WebGL)
Fix build: coverage tris(), project Mat4
+54
-34
+4
-2
lib/gl_coord.ml
+4
-2
lib/gl_coord.ml
···
10
10
1.0. *)
11
11
12
12
let scale = 1. /. Coordinate.earth_radius
13
-
let of_astro ~x ~y ~z = Math.Vec3.create (x *. scale) (z *. scale) (y *. scale)
14
-
let of_coordinate (v : Coordinate.vec3) = of_astro ~x:v.x ~y:v.y ~z:v.z
13
+
let of_pos ~x ~y ~z = Math.Vec3.create (x *. scale) (z *. scale) (y *. scale)
14
+
let of_astro ~x ~y ~z = of_pos ~x ~y ~z
15
+
let of_coordinate (v : Coordinate.vec3) = of_pos ~x:v.x ~y:v.y ~z:v.z
16
+
let of_kepler (v : Kepler.Vec3.t) = of_pos ~x:v.x ~y:v.y ~z:v.z
+6
-2
lib/gl_coord.mli
+6
-2
lib/gl_coord.mli
···
3
3
Converts astrodynamics position vectors (km) to GL coordinates where Earth
4
4
radius = 1.0 and Y axis points north. *)
5
5
6
-
val of_astro : x:float -> y:float -> z:float -> Math.Vec3.t
7
-
(** [of_astro ~x ~y ~z] maps (x, y, z) in km to GL coordinates. *)
6
+
val of_kepler : Kepler.Vec3.t -> Math.Vec3.t
7
+
(** [of_kepler v] converts a Kepler position vector (km) to GL coordinates. *)
8
8
9
9
val of_coordinate : Coordinate.vec3 -> Math.Vec3.t
10
10
(** [of_coordinate v] converts a {!Coordinate.vec3} to GL coordinates. *)
11
+
12
+
val of_astro : x:float -> y:float -> z:float -> Math.Vec3.t
13
+
(** [of_astro ~x ~y ~z] maps (x, y, z) in km to GL coordinates. Prefer
14
+
{!of_kepler} or {!of_coordinate} when you have a vector. *)
+4
-4
lib/satellite.ml
+4
-4
lib/satellite.ml
···
26
26
let n = 120 in
27
27
(* Use period for bound orbits, 5400s arc for unbound *)
28
28
let dur = if Float.is_finite period && period > 0. then period else 5400. in
29
-
let fallback = Gl_coord.of_astro ~x:pos.x ~y:pos.y ~z:pos.z in
29
+
let fallback = Gl_coord.of_kepler pos in
30
30
Array.init n (fun i ->
31
31
let t = Float.of_int i *. dur /. Float.of_int n in
32
32
let p = Kepler.Analytic.at_precomputed elements ~dt:t in
33
33
if Float.is_finite p.x && Float.is_finite p.y && Float.is_finite p.z
34
-
then Some (Gl_coord.of_astro ~x:p.x ~y:p.y ~z:p.z)
34
+
then Some (Gl_coord.of_kepler p)
35
35
else Some fallback)
36
36
in
37
37
{ elements; pos; vel; color; period; epoch_unix; ghost_points; trail_length }
···
45
45
let position_at t ~dt =
46
46
let p = Kepler.Analytic.at_precomputed t.elements ~dt in
47
47
if Float.is_finite p.x && Float.is_finite p.y && Float.is_finite p.z then
48
-
Gl_coord.of_astro ~x:p.x ~y:p.y ~z:p.z
48
+
Gl_coord.of_kepler p
49
49
else epoch_position t
50
50
51
51
let trail_positions t ~dt =
···
61
61
let t_offset = dt -. (Float.of_int (n - 1 - i) *. step) in
62
62
let p = Kepler.Analytic.at_precomputed t.elements ~dt:t_offset in
63
63
if Float.is_finite p.x && Float.is_finite p.y && Float.is_finite p.z then
64
-
Some (Gl_coord.of_astro ~x:p.x ~y:p.y ~z:p.z)
64
+
Some (Gl_coord.of_kepler p)
65
65
else Some fallback)
66
66
67
67
let dot t ~dt =
+40
-26
test/test_project.ml
+40
-26
test/test_project.ml
···
9
9
10
10
open Globe
11
11
12
-
let proj = Math.Mat4.(to_float_array
13
-
(perspective ~fovy:(Float.pi /. 4.) ~aspect:1.333 ~near:0.1 ~far:100.))
14
-
let view = Math.Mat4.(to_float_array
15
-
(look_at
16
-
~eye:(Math.Vec3.create 0. 0. 3.5)
17
-
~center:Math.Vec3.zero
18
-
~up:(Math.Vec3.create 0. 1. 0.)))
12
+
let proj =
13
+
Math.Mat4.(
14
+
to_float_array
15
+
(perspective ~fovy:(Float.pi /. 4.) ~aspect:1.333 ~near:0.1 ~far:100.))
16
+
17
+
let view =
18
+
Math.Mat4.(
19
+
to_float_array
20
+
(look_at
21
+
~eye:(Math.Vec3.create 0. 0. 3.5)
22
+
~center:Math.Vec3.zero
23
+
~up:(Math.Vec3.create 0. 1. 0.)))
19
24
20
25
(** Origin projects to screen center. *)
21
26
let test_center () =
22
-
match Project.to_screen ~projection:proj ~view ~width:800 ~height:600
23
-
Math.Vec3.zero with
27
+
match
28
+
Project.to_screen ~projection:proj ~view ~width:800 ~height:600
29
+
Math.Vec3.zero
30
+
with
24
31
| None -> Alcotest.fail "origin must be visible from front camera"
25
32
| Some (sx, sy, _) ->
26
33
Alcotest.(check bool) "center x ~400" true (sx > 390. && sx < 410.);
···
29
36
(** Point behind camera is rejected. *)
30
37
let test_behind_camera () =
31
38
let pos = Math.Vec3.create 0. 0. 10. in
32
-
Alcotest.(check bool) "behind camera → None" true
39
+
Alcotest.(check bool)
40
+
"behind camera → None" true
33
41
(Project.to_screen ~projection:proj ~view ~width:800 ~height:600 pos = None)
34
42
35
43
(** Positive X projects right of center. *)
36
44
let test_right_of_center () =
37
-
match Project.to_screen ~projection:proj ~view ~width:800 ~height:600
38
-
(Math.Vec3.create 0.5 0. 0.) with
45
+
match
46
+
Project.to_screen ~projection:proj ~view ~width:800 ~height:600
47
+
(Math.Vec3.create 0.5 0. 0.)
48
+
with
39
49
| None -> Alcotest.fail "right point must project"
40
-
| Some (sx, _, _) ->
41
-
Alcotest.(check bool) "right of center" true (sx > 400.)
50
+
| Some (sx, _, _) -> Alcotest.(check bool) "right of center" true (sx > 400.)
42
51
43
52
(** Positive Y projects above center (smaller screen Y). *)
44
53
let test_above_center () =
45
-
match Project.to_screen ~projection:proj ~view ~width:800 ~height:600
46
-
(Math.Vec3.create 0. 0.5 0.) with
54
+
match
55
+
Project.to_screen ~projection:proj ~view ~width:800 ~height:600
56
+
(Math.Vec3.create 0. 0.5 0.)
57
+
with
47
58
| None -> Alcotest.fail "above point must project"
48
-
| Some (_, sy, _) ->
49
-
Alcotest.(check bool) "above center" true (sy < 300.)
59
+
| Some (_, sy, _) -> Alcotest.(check bool) "above center" true (sy < 300.)
50
60
51
61
(** Nearer objects have smaller depth. *)
52
62
let test_depth_ordering () =
···
62
72
63
73
(** project_visible filters out behind-camera points. *)
64
74
let test_project_visible () =
65
-
let positions = [
66
-
(0, Math.Vec3.zero);
67
-
(1, Math.Vec3.create 0. 0. 10.); (* behind camera *)
68
-
(2, Math.Vec3.create 0.5 0. 0.);
69
-
] in
75
+
let positions =
76
+
[
77
+
(0, Math.Vec3.zero);
78
+
(1, Math.Vec3.create 0. 0. 10.);
79
+
(* behind camera *)
80
+
(2, Math.Vec3.create 0.5 0. 0.);
81
+
]
82
+
in
70
83
let visible =
71
-
Project.project_visible ~projection:proj ~view
72
-
~width:800 ~height:600 positions
84
+
Project.project_visible ~projection:proj ~view ~width:800 ~height:600
85
+
positions
73
86
in
74
87
Alcotest.(check int) "2 of 3 visible" 2 (List.length visible);
75
88
let indices = List.map (fun (i, _, _, _) -> i) visible in
···
95
108
(** Far clip: point beyond far plane is rejected. *)
96
109
let test_far_clip () =
97
110
let pos = Math.Vec3.create 0. 0. (-200.) in
98
-
Alcotest.(check bool) "beyond far → None" true
111
+
Alcotest.(check bool)
112
+
"beyond far → None" true
99
113
(Project.to_screen ~projection:proj ~view ~width:800 ~height:600 pos = None)
100
114
101
115
let suite =