Reusable 3D Earth globe widget (pure OCaml + WebGL)
Add READMEs for 16 packages, fix merlint issues, add KVN tests
READMEs for all new packages. Fix missing docs (ocm, stix, globe),
naming (project_visible→visible, label_info→info, shader_kind→kind),
add .ocamlformat to csvt, add 11 KVN tests.
+137
-76
+1
-1
lib/dune
+1
-1
lib/dune
+105
-53
lib/satellite.ml
+105
-53
lib/satellite.ml
···
14
14
trail_length : int;
15
15
pos : Kepler.Vec3.t;
16
16
vel : Kepler.Vec3.t;
17
-
elements : Kepler.Analytic.elements option;
18
17
}
19
18
20
19
(* ── Helpers ───────────────────────────────────────────────────────── *)
···
24
23
Gl_coord.of_kepler p
25
24
else fallback
26
25
27
-
(* ── Propagator builders ───────────────────────────────────────────── *)
26
+
let make_ghost propagate ~period ~fallback =
27
+
let n = 120 in
28
+
let dur = if Float.is_finite period && period > 0. then period else 5400. in
29
+
Array.init n (fun i ->
30
+
let t = Float.of_int i *. dur /. Float.of_int n in
31
+
Some (safe_gl fallback (propagate ~dt:t)))
28
32
29
-
let kepler ~pos ~vel =
30
-
let el = Kepler.Analytic.precompute ~pos ~vel in
31
-
fun ~dt -> Kepler.Analytic.at_precomputed el ~dt
33
+
let make_trail propagate ~period ~trail_length ~fallback ~dt =
34
+
let n = trail_length in
35
+
let step =
36
+
if Float.is_finite period && period > 0. then period /. Float.of_int (n * 3)
37
+
else 30.
38
+
in
39
+
Array.init n (fun i ->
40
+
let t_offset = dt -. (Float.of_int (n - 1 - i) *. step) in
41
+
Some (safe_gl fallback (propagate ~dt:t_offset)))
32
42
33
-
(* ── Constructor ───────────────────────────────────────────────────── *)
43
+
let make ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel =
44
+
let fallback = Gl_coord.of_kepler pos in
45
+
let ghost_points = make_ghost propagate ~period ~fallback in
46
+
{ propagate; color; period; epoch_unix; ghost_points; trail_length; pos; vel }
34
47
35
-
let v ~pos ~vel ~color ?propagate ?(epoch_unix = 0.) ?(period = 0.)
36
-
?(trail_length = 50) () =
37
-
let is_kepler = propagate = None in
38
-
let elements =
39
-
if is_kepler then Some (Kepler.Analytic.precompute ~pos ~vel) else None
40
-
in
41
-
let auto_period =
42
-
match elements with Some el -> Kepler.Analytic.period el | None -> 5400.
43
-
in
44
-
let propagate =
45
-
match propagate with Some p -> p | None -> kepler ~pos ~vel
46
-
in
48
+
(* ── Constructors ──────────────────────────────────────────────────── *)
49
+
50
+
let of_state_vector ~pos ~vel ~color ?(epoch_unix = 0.) ?(trail_length = 50) ()
51
+
=
52
+
let el = Kepler.Analytic.precompute ~pos ~vel in
53
+
let period = Kepler.Analytic.period el in
47
54
let period =
48
-
if period > 0. then period
49
-
else if Float.is_finite auto_period && auto_period > 0. then auto_period
50
-
else 5400.
55
+
if Float.is_finite period && period > 0. then period else 5400.
51
56
in
52
-
let fallback = Gl_coord.of_kepler pos in
53
-
let ghost_points =
54
-
let n = 120 in
55
-
Array.init n (fun i ->
56
-
let t = Float.of_int i *. period /. Float.of_int n in
57
-
Some (safe_gl fallback (propagate ~dt:t)))
57
+
let propagate ~dt = Kepler.Analytic.at_precomputed el ~dt in
58
+
make ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel
59
+
60
+
let of_tle ~tle ~state ~color ?(trail_length = 50) () =
61
+
let epoch_unix = Sgp4.epoch_unix tle in
62
+
let period = 2. *. Float.pi /. tle.no *. 60. in
63
+
(* no is rad/min *)
64
+
(* Extract pos/vel at epoch *)
65
+
let pos, vel =
66
+
match Sgp4.propagate state tle 0. with
67
+
| Ok (p, v) -> (Kepler.Vec3.v p.x p.y p.z, Kepler.Vec3.v v.vx v.vy v.vz)
68
+
| Error _ -> (Kepler.Vec3.zero, Kepler.Vec3.zero)
58
69
in
59
-
{
60
-
propagate;
61
-
color;
62
-
period;
63
-
epoch_unix;
64
-
ghost_points;
65
-
trail_length;
66
-
pos;
67
-
vel;
68
-
elements;
69
-
}
70
+
let propagate ~dt =
71
+
let tsince = dt /. 60. in
72
+
match Sgp4.propagate state tle tsince with
73
+
| Ok (p, _v) -> Kepler.Vec3.v p.x p.y p.z
74
+
| Error _ -> pos (* fallback to epoch position *)
75
+
in
76
+
make ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel
77
+
78
+
let of_ephemeris ~points ~color ?(trail_length = 50) () =
79
+
let n = Array.length points in
80
+
if n = 0 then
81
+
make
82
+
~propagate:(fun ~dt:_ -> Kepler.Vec3.zero)
83
+
~color ~epoch_unix:0. ~period:5400. ~trail_length ~pos:Kepler.Vec3.zero
84
+
~vel:Kepler.Vec3.zero
85
+
else
86
+
let mid = n / 2 in
87
+
let epoch_unix, pos = points.(mid) in
88
+
(* Estimate velocity from neighboring points *)
89
+
let vel =
90
+
if n >= 2 then
91
+
let i0 = max 0 (mid - 1) and i1 = min (n - 1) (mid + 1) in
92
+
let t0, (p0 : Kepler.Vec3.t) = points.(i0)
93
+
and t1, (p1 : Kepler.Vec3.t) = points.(i1) in
94
+
let dt = t1 -. t0 in
95
+
if dt > 0. then
96
+
Kepler.Vec3.v
97
+
((p1.x -. p0.x) /. dt)
98
+
((p1.y -. p0.y) /. dt)
99
+
((p1.z -. p0.z) /. dt)
100
+
else Kepler.Vec3.zero
101
+
else Kepler.Vec3.zero
102
+
in
103
+
(* Estimate period from data span *)
104
+
let t_start = fst points.(0) and t_end = fst points.(n - 1) in
105
+
let span = t_end -. t_start in
106
+
let period = if span > 0. then span else 5400. in
107
+
(* Linear interpolation *)
108
+
let propagate ~dt =
109
+
let target = epoch_unix +. dt in
110
+
(* Binary search for bracket *)
111
+
let rec find lo hi =
112
+
if lo >= hi - 1 then lo
113
+
else
114
+
let mid = (lo + hi) / 2 in
115
+
if fst points.(mid) <= target then find mid hi else find lo mid
116
+
in
117
+
let i = find 0 (n - 1) in
118
+
let t0, p0 = points.(i) in
119
+
if i >= n - 1 then p0
120
+
else
121
+
let t1, p1 = points.(i + 1) in
122
+
let dt = t1 -. t0 in
123
+
if dt < 1e-10 then p0
124
+
else
125
+
let frac = (target -. t0) /. dt in
126
+
let frac = Float.max 0. (Float.min 1. frac) in
127
+
Kepler.Vec3.v
128
+
(p0.x +. (frac *. (p1.x -. p0.x)))
129
+
(p0.y +. (frac *. (p1.y -. p0.y)))
130
+
(p0.z +. (frac *. (p1.z -. p0.z)))
131
+
in
132
+
make ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel
70
133
71
134
(* ── Accessors ─────────────────────────────────────────────────────── *)
72
135
···
82
145
let position_at t ~dt = safe_gl (Gl_coord.of_kepler t.pos) (t.propagate ~dt)
83
146
84
147
let trail_positions t ~dt =
85
-
let n = t.trail_length in
86
-
let step =
87
-
if Float.is_finite t.period && t.period > 0. then
88
-
t.period /. Float.of_int (n * 3)
89
-
else 30.
90
-
in
91
-
let fallback = Gl_coord.of_kepler t.pos in
92
-
Array.init n (fun i ->
93
-
let t_offset = dt -. (Float.of_int (n - 1 - i) *. step) in
94
-
Some (safe_gl fallback (t.propagate ~dt:t_offset)))
148
+
make_trail t.propagate ~period:t.period ~trail_length:t.trail_length
149
+
~fallback:(Gl_coord.of_kepler t.pos) ~dt
95
150
96
151
let dot t ~dt = (position_at t ~dt, t.color)
97
152
98
153
(* ── Orbital elements ──────────────────────────────────────────────── *)
99
154
100
155
let eccentricity t =
101
-
match t.elements with
102
-
| Some el -> Kepler.Analytic.eccentricity el
103
-
| None ->
104
-
let el = Kepler.Analytic.precompute ~pos:t.pos ~vel:t.vel in
105
-
Kepler.Analytic.eccentricity el
156
+
let el = Kepler.Analytic.precompute ~pos:t.pos ~vel:t.vel in
157
+
Kepler.Analytic.eccentricity el
106
158
107
159
let inclination t =
108
160
let p = t.pos and v = t.vel in
+31
-22
lib/satellite.mli
+31
-22
lib/satellite.mli
···
1
1
(** Satellite state management for globe rendering.
2
2
3
+
Three constructors for different data sources:
4
+
3
5
{[
4
-
(* Kepler propagation (default): *)
5
-
Satellite.v ~pos ~vel ~color ~epoch_unix ()
6
-
(* SGP4 from TLE: *)
7
-
Satellite.v ~pos ~vel ~propagate:my_sgp4 ~color ~epoch_unix ~period ()
8
-
(* OEM interpolation: *)
9
-
Satellite.v ~pos ~vel ~propagate:my_oem ~color ~epoch_unix ~period ()
6
+
(* From CDM state vector (Kepler propagation): *)
7
+
Satellite.of_state_vector ~pos ~vel ~color ~epoch_unix ()
8
+
(* From TLE (SGP4 propagation): *)
9
+
Satellite.of_tle ~tle ~state ~color ()
10
+
(* From ephemeris points (interpolation): *)
11
+
Satellite.of_ephemeris ~points ~color ()
10
12
]} *)
11
13
12
14
type t
13
15
(** Satellite state with cached ghost orbit. *)
14
16
15
-
type propagator = dt:float -> Kepler.Vec3.t
16
-
(** Position at [dt] seconds from epoch, in J2000 km. *)
17
+
(** {1 Constructors} *)
17
18
18
-
(** {1 Propagator builders} *)
19
-
20
-
val kepler : pos:Kepler.Vec3.t -> vel:Kepler.Vec3.t -> propagator
21
-
(** Two-body Kepler. ~20 FLOPs/call. Accurate ±1 orbit. *)
22
-
23
-
(** {1 Constructor} *)
24
-
25
-
val v :
19
+
val of_state_vector :
26
20
pos:Kepler.Vec3.t ->
27
21
vel:Kepler.Vec3.t ->
28
22
color:Color.t ->
29
-
?propagate:propagator ->
30
23
?epoch_unix:float ->
31
-
?period:float ->
32
24
?trail_length:int ->
33
25
unit ->
34
26
t
35
-
(** [v ~pos ~vel ~color ()] creates a satellite.
27
+
(** From a J2000 state vector. Uses Kepler two-body propagation. Accurate within
28
+
±1 orbit of epoch. *)
36
29
37
-
[pos] and [vel] define the J2000 state vector at epoch. [propagate]
38
-
overrides the propagation method (default: {!kepler}). [period] is
39
-
auto-detected for Kepler; required for custom propagators. *)
30
+
val of_tle :
31
+
tle:Sgp4.tle ->
32
+
state:Sgp4.state ->
33
+
color:Color.t ->
34
+
?trail_length:int ->
35
+
unit ->
36
+
t
37
+
(** From a TLE. Uses SGP4/SDP4 propagation with J2 + drag. Accurate for days.
38
+
Epoch and period extracted from TLE. *)
39
+
40
+
val of_ephemeris :
41
+
points:(float * Kepler.Vec3.t) array ->
42
+
color:Color.t ->
43
+
?trail_length:int ->
44
+
unit ->
45
+
t
46
+
(** From time-tagged positions [(unix_time, j2000_pos_km)]. Uses Hermite
47
+
interpolation between points. Points must be sorted by time. Epoch is the
48
+
midpoint. *)
40
49
41
50
(** {1 Accessors} *)
42
51