Reusable 3D Earth globe widget (pure OCaml + WebGL)
globe: doc satellite accessors, drop redundant make_/test_ prefixes
- Document the ten missing satellite.mli accessors / renderers (E405).
- Add doc on Fuzz_satellite.suite (E405).
- Rename satellite.ml internal helpers: make_ghost -> ghost_array,
make_trail -> trail_array, make -> build (E331).
- Rename label.ml's HTML-element helper from create to html_el to
avoid the make_/create idiomatic-constructor lint without colliding
with the public Label.v constructor (E336).
- Shorten test_default_cam_has_full_trails -> default_cam_full_trails
(E325 long identifier).
Remaining: density and label still report missing test files (E605); a
proper test would need DOM/WebGL2 mocks that are out of scope here.
+43
-14
+3
fuzz/fuzz_satellite.mli
+3
fuzz/fuzz_satellite.mli
+9
-9
lib/satellite.ml
+9
-9
lib/satellite.ml
···
24
24
Gl_coord.of_kepler p
25
25
else fallback
26
26
27
-
let make_ghost propagate ~period ~fallback =
27
+
let ghost_array propagate ~period ~fallback =
28
28
let n = 120 in
29
29
let dur = if Float.is_finite period && period > 0. then period else 5400. in
30
30
Array.init n (fun i ->
31
31
let t = Float.of_int i *. dur /. Float.of_int n in
32
32
Some (safe_gl fallback (propagate ~dt:t)))
33
33
34
-
let make_trail propagate ~period ~trail_length ~fallback ~dt =
34
+
let trail_array propagate ~period ~trail_length ~fallback ~dt =
35
35
let n = trail_length in
36
36
let step =
37
37
if Float.is_finite period && period > 0. then period /. Float.of_int (n * 3)
···
41
41
let t_offset = dt -. (Float.of_int (n - 1 - i) *. step) in
42
42
Some (safe_gl fallback (propagate ~dt:t_offset)))
43
43
44
-
let make ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel =
44
+
let build ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel =
45
45
let fallback = Gl_coord.of_kepler pos in
46
-
let ghost_points = make_ghost propagate ~period ~fallback in
46
+
let ghost_points = ghost_array propagate ~period ~fallback in
47
47
{
48
48
propagate;
49
49
color;
···
66
66
if Float.is_finite period && period > 0. then period else 5400.
67
67
in
68
68
let propagate ~dt = Kepler.Analytic.at_precomputed el ~dt in
69
-
make ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel
69
+
build ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel
70
70
71
71
let v = of_state_vector
72
72
···
86
86
| Ok (p, _v) -> Vec3.v p.x p.y p.z
87
87
| Error _ -> pos (* fallback to epoch position *)
88
88
in
89
-
make ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel
89
+
build ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel
90
90
91
91
let estimate_velocity points ~mid ~n =
92
92
if n >= 2 then
···
124
124
let of_ephemeris ~points ~color ?(trail_length = 50) () =
125
125
let n = Array.length points in
126
126
if n = 0 then
127
-
make
127
+
build
128
128
~propagate:(fun ~dt:_ -> Vec3.zero)
129
129
~color ~epoch_unix:0. ~period:5400. ~trail_length ~pos:Vec3.zero
130
130
~vel:Vec3.zero
···
136
136
let span = t_end -. t_start in
137
137
let period = if span > 0. then span else 5400. in
138
138
let propagate ~dt = interpolate_position points ~n ~epoch_unix ~dt in
139
-
make ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel
139
+
build ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel
140
140
141
141
(* ── Accessors ─────────────────────────────────────────────────────── *)
142
142
···
154
154
let position_at t ~dt = safe_gl (Gl_coord.of_kepler t.pos) (t.propagate ~dt)
155
155
156
156
let trail_positions t ~dt =
157
-
make_trail t.propagate ~period:t.period ~trail_length:t.trail_length
157
+
trail_array t.propagate ~period:t.period ~trail_length:t.trail_length
158
158
~fallback:(Gl_coord.of_kepler t.pos) ~dt
159
159
160
160
let lit_color t =
+27
lib/satellite.mli
+27
lib/satellite.mli
···
60
60
(** {1 Accessors} *)
61
61
62
62
val color : t -> Color.t
63
+
(** [color t] is the base RGB tint configured for [t]. *)
64
+
63
65
val brightness : t -> float
66
+
(** [brightness t] is the current brightness multiplier in [[0., 1.]]. *)
67
+
64
68
val set_brightness : t -> float -> unit
69
+
(** [set_brightness t b] mutates [t] so subsequent renders use brightness [b].
70
+
*)
71
+
65
72
val lit_color : t -> Color.t
73
+
(** [lit_color t] is [color t] scaled by [brightness t]. *)
74
+
66
75
val epoch_unix : t -> float
76
+
(** [epoch_unix t] is the Unix-time epoch of the orbital state. *)
77
+
67
78
val period : t -> float
79
+
(** [period t] is the orbital period in seconds. *)
80
+
68
81
val pos : t -> Vec3.t
82
+
(** [pos t] is the cached J2000 position vector at [epoch_unix]. *)
83
+
69
84
val vel : t -> Vec3.t
85
+
(** [vel t] is the cached J2000 velocity vector at [epoch_unix]. *)
70
86
71
87
(** {1 Rendering} *)
72
88
73
89
val ghost_points : t -> Math.Vec3.t option array
90
+
(** [ghost_points t] is the cached array of GL-space points sampled along one
91
+
full orbit, used to render the static "ghost" trail. *)
92
+
74
93
val position_at : t -> dt:float -> Math.Vec3.t
94
+
(** [position_at t ~dt] is the GL-space position [dt] seconds after the epoch.
95
+
*)
96
+
75
97
val trail_positions : t -> dt:float -> Math.Vec3.t option array
98
+
(** [trail_positions t ~dt] is the array of GL-space points along the trail
99
+
leading up to time [dt]. *)
100
+
76
101
val dot : t -> dt:float -> Math.Vec3.t * Color.t
102
+
(** [dot t ~dt] is the GL-space position and lit colour of the satellite at time
103
+
[dt]. *)
77
104
78
105
(** {1 Orbital elements} *)
79
106
+2
-2
lib/webgl/label.ml
+2
-2
lib/webgl/label.ml
···
21
21
container;
22
22
{ container; entries = [] }
23
23
24
-
let create text =
24
+
let html_el text =
25
25
let el = El.div [] in
26
26
El.set_at (Jstr.of_string "style")
27
27
(Some
···
37
37
match List.assoc_opt idx t.entries with
38
38
| Some entry -> entry
39
39
| None ->
40
-
let el = create text in
40
+
let el = html_el text in
41
41
El.append_children t.container [ el ];
42
42
let entry = { el; visible = false } in
43
43
t.entries <- (idx, entry) :: t.entries;
+2
-3
test/test_visibility.ml
+2
-3
test/test_visibility.ml
···
176
176
done;
177
177
(!full, !dots, !hidden)
178
178
179
-
let test_default_cam_has_full_trails () =
179
+
let default_cam_full_trails () =
180
180
(* At default camera distance (3.5), the closest point on a LEO orbit
181
181
is at distance 3.5 - 1.1 = 2.4. With near=2.0 this is Dot_only!
182
182
This test documents the expectation: front satellites SHOULD have
···
315
315
Alcotest.test_case "visible fraction" `Quick test_visible_fraction;
316
316
Alcotest.test_case "symmetric" `Quick test_symmetric;
317
317
Alcotest.test_case "just past horizon" `Quick test_just_past_horizon;
318
-
Alcotest.test_case "default cam trails" `Quick
319
-
test_default_cam_has_full_trails;
318
+
Alcotest.test_case "default cam trails" `Quick default_cam_full_trails;
320
319
Alcotest.test_case "zoomed in mostly full" `Quick
321
320
test_zoomed_in_mostly_full;
322
321
Alcotest.test_case "zoomed out visible" `Quick