Reusable 3D Earth globe widget (pure OCaml + WebGL)
Abstract Satellite propagation: Kepler, SGP4, OEM
Satellite.of_propagator takes a (dt:float -> Vec3.t) function.
Satellite.v remains unchanged (Kepler backend).
+150
-59
+81
-37
lib/satellite.ml
+81
-37
lib/satellite.ml
···
5
5
6
6
(** Satellite state management for globe rendering.
7
7
8
-
Caches precomputed Kepler elements, generates ghost orbits and per-frame
9
-
trail positions. Pure OCaml, no WebGL dependency. *)
8
+
Propagation-agnostic: takes a [propagator] function that maps dt → position.
9
+
The default constructor uses Kepler; [of_propagator] accepts any backend. *)
10
+
11
+
type propagator = dt:float -> Kepler.Vec3.t
10
12
11
13
type t = {
12
-
elements : Kepler.Analytic.elements;
13
-
pos : Kepler.Vec3.t;
14
-
vel : Kepler.Vec3.t;
14
+
propagate : propagator;
15
15
color : Color.t;
16
16
period : float;
17
17
epoch_unix : float;
18
18
ghost_points : Math.Vec3.t option array;
19
19
trail_length : int;
20
+
(* Kepler-specific, optional *)
21
+
elements : Kepler.Analytic.elements option;
22
+
pos0 : Kepler.Vec3.t;
23
+
vel0 : Kepler.Vec3.t;
20
24
}
21
25
26
+
(* ── Safe GL coordinate conversion ─────────────────────────────────── *)
27
+
28
+
let safe_gl (fallback : Math.Vec3.t) (p : Kepler.Vec3.t) =
29
+
if Float.is_finite p.x && Float.is_finite p.y && Float.is_finite p.z then
30
+
Gl_coord.of_kepler p
31
+
else fallback
32
+
33
+
let make_ghost propagate ~period ~ghost_duration ~fallback =
34
+
let n = 120 in
35
+
let dur =
36
+
if Float.is_finite ghost_duration && ghost_duration > 0. then ghost_duration
37
+
else if Float.is_finite period && period > 0. then period
38
+
else 5400.
39
+
in
40
+
Array.init n (fun i ->
41
+
let t = Float.of_int i *. dur /. Float.of_int n in
42
+
Some (safe_gl fallback (propagate ~dt:t)))
43
+
44
+
(* ── Constructors ──────────────────────────────────────────────────── *)
45
+
22
46
let v ~pos ~vel ~color ?(epoch_unix = 0.) ?(trail_length = 50) () =
23
47
let elements = Kepler.Analytic.precompute ~pos ~vel in
24
48
let period = Kepler.Analytic.period elements in
49
+
let propagate ~dt = Kepler.Analytic.at_precomputed elements ~dt in
50
+
let fallback = Gl_coord.of_kepler pos in
25
51
let ghost_points =
26
-
let n = 120 in
27
-
(* Use period for bound orbits, 5400s arc for unbound *)
28
-
let dur = if Float.is_finite period && period > 0. then period else 5400. in
29
-
let fallback = Gl_coord.of_kepler pos in
30
-
Array.init n (fun i ->
31
-
let t = Float.of_int i *. dur /. Float.of_int n in
32
-
let p = Kepler.Analytic.at_precomputed elements ~dt:t in
33
-
if Float.is_finite p.x && Float.is_finite p.y && Float.is_finite p.z
34
-
then Some (Gl_coord.of_kepler p)
35
-
else Some fallback)
52
+
make_ghost propagate ~period ~ghost_duration:period ~fallback
36
53
in
37
-
{ elements; pos; vel; color; period; epoch_unix; ghost_points; trail_length }
54
+
{
55
+
propagate;
56
+
color;
57
+
period;
58
+
epoch_unix;
59
+
ghost_points;
60
+
trail_length;
61
+
elements = Some elements;
62
+
pos0 = pos;
63
+
vel0 = vel;
64
+
}
65
+
66
+
let of_propagator ~propagate ~color ?(epoch_unix = 0.) ?(period = 5400.)
67
+
?(ghost_duration = 0.) ?(trail_length = 50) () =
68
+
let ghost_dur = if ghost_duration > 0. then ghost_duration else period in
69
+
let fallback = safe_gl Math.Vec3.zero (propagate ~dt:0.) in
70
+
let ghost_points =
71
+
make_ghost propagate ~period ~ghost_duration:ghost_dur ~fallback
72
+
in
73
+
{
74
+
propagate;
75
+
color;
76
+
period;
77
+
epoch_unix;
78
+
ghost_points;
79
+
trail_length;
80
+
elements = None;
81
+
pos0 = Kepler.Vec3.zero;
82
+
vel0 = Kepler.Vec3.zero;
83
+
}
84
+
85
+
(* ── Accessors ─────────────────────────────────────────────────────── *)
38
86
39
87
let color t = t.color
40
88
let period t = t.period
41
89
let epoch_unix t = t.epoch_unix
42
90
let ghost_points t = t.ghost_points
43
-
let epoch_position t = Gl_coord.of_astro ~x:t.pos.x ~y:t.pos.y ~z:t.pos.z
91
+
92
+
(* ── Rendering ─────────────────────────────────────────────────────── *)
44
93
45
94
let position_at t ~dt =
46
-
let p = Kepler.Analytic.at_precomputed t.elements ~dt in
47
-
if Float.is_finite p.x && Float.is_finite p.y && Float.is_finite p.z then
48
-
Gl_coord.of_kepler p
49
-
else epoch_position t
95
+
let fallback = Gl_coord.of_kepler t.pos0 in
96
+
safe_gl fallback (t.propagate ~dt)
50
97
51
98
let trail_positions t ~dt =
52
99
let n = t.trail_length in
53
-
(* For unbound orbits, use 30s steps; for bound, 1/150 of period *)
54
100
let step =
55
101
if Float.is_finite t.period && t.period > 0. then
56
102
t.period /. Float.of_int (n * 3)
57
103
else 30.
58
104
in
59
-
let fallback = epoch_position t in
105
+
let fallback = Gl_coord.of_kepler t.pos0 in
60
106
Array.init n (fun i ->
61
107
let t_offset = dt -. (Float.of_int (n - 1 - i) *. step) in
62
-
let p = Kepler.Analytic.at_precomputed t.elements ~dt:t_offset in
63
-
if Float.is_finite p.x && Float.is_finite p.y && Float.is_finite p.z then
64
-
Some (Gl_coord.of_kepler p)
65
-
else Some fallback)
108
+
Some (safe_gl fallback (t.propagate ~dt:t_offset)))
109
+
110
+
let dot t ~dt = (position_at t ~dt, t.color)
66
111
67
-
let dot t ~dt =
68
-
let pos = position_at t ~dt in
69
-
(pos, t.color)
112
+
(* ── Orbital elements (Kepler only) ───────────────────────────────── *)
70
113
71
-
let eccentricity t = Kepler.Analytic.eccentricity t.elements
114
+
let eccentricity t =
115
+
match t.elements with
116
+
| Some el -> Kepler.Analytic.eccentricity el
117
+
| None -> 0.
72
118
73
119
let inclination t =
74
-
(* i = acos(h_z / |h|) where h = pos x vel *)
75
-
let hx = (t.pos.y *. t.vel.z) -. (t.pos.z *. t.vel.y) in
76
-
let hy = (t.pos.z *. t.vel.x) -. (t.pos.x *. t.vel.z) in
77
-
let hz = (t.pos.x *. t.vel.y) -. (t.pos.y *. t.vel.x) in
120
+
let hx = (t.pos0.y *. t.vel0.z) -. (t.pos0.z *. t.vel0.y) in
121
+
let hy = (t.pos0.z *. t.vel0.x) -. (t.pos0.x *. t.vel0.z) in
122
+
let hz = (t.pos0.x *. t.vel0.y) -. (t.pos0.y *. t.vel0.x) in
78
123
let h_mag = sqrt ((hx *. hx) +. (hy *. hy) +. (hz *. hz)) in
79
124
if h_mag < 1e-12 then 0.
80
125
else acos (Float.max (-1.) (Float.min 1. (hz /. h_mag)))
81
126
82
127
let pp ppf t =
83
-
Fmt.pf ppf "sat(period=%.0fs e=%.4f color=%a)" t.period
84
-
(Kepler.Analytic.eccentricity t.elements)
128
+
Fmt.pf ppf "sat(period=%.0fs e=%.4f color=%a)" t.period (eccentricity t)
85
129
Color.pp t.color
+69
-22
lib/satellite.mli
+69
-22
lib/satellite.mli
···
1
1
(** Satellite state management for globe rendering.
2
2
3
-
Caches precomputed Kepler elements, generates ghost orbits and per-frame
4
-
trail positions. Pure OCaml, no WebGL dependency. *)
3
+
Supports multiple propagation backends: Kepler (two-body), SGP4 (TLE), or
4
+
ephemeris interpolation (OEM). The propagation is abstracted behind a
5
+
[propagator] function — the rendering code doesn't know which method is
6
+
used.
7
+
8
+
{2 Propagation backends}
9
+
10
+
{b Kepler} (default): Fast two-body analytical propagation from a J2000
11
+
state vector. Accurate within ±1 orbit of epoch. Use for CDM visualization.
12
+
13
+
{b SGP4}: Standard TLE propagation with J2/drag. Accurate for days. Pass an
14
+
SGP4 propagator via {!of_propagator}.
15
+
16
+
{b OEM}: Interpolate time-tagged ephemeris. Exact at provider precision.
17
+
Pass an interpolation function via {!of_propagator}.
18
+
19
+
{2 Quick start}
20
+
21
+
{[
22
+
(* From CDM state vector (Kepler): *)
23
+
let sat = Satellite.v ~pos ~vel ~color ~epoch_unix ()
24
+
25
+
(* From custom propagator (SGP4, OEM, etc.): *)
26
+
let sat =
27
+
Satellite.of_propagator ~propagate ~color ~epoch_unix ~period
28
+
~ghost_duration ()
29
+
]} *)
5
30
6
31
type t
7
-
(** Satellite state with cached orbital elements and ghost orbit. *)
32
+
(** Satellite state with cached ghost orbit. *)
33
+
34
+
(** {1 Propagator type} *)
35
+
36
+
type propagator = dt:float -> Kepler.Vec3.t
37
+
(** A propagation function: given [dt] seconds from epoch, returns the J2000
38
+
position in km. This is the abstraction that allows swapping Kepler, SGP4,
39
+
or OEM interpolation. *)
40
+
41
+
(** {1 Constructors} *)
8
42
9
43
val v :
10
44
pos:Kepler.Vec3.t ->
···
14
48
?trail_length:int ->
15
49
unit ->
16
50
t
17
-
(** [v ~pos ~vel ~color ?epoch_unix ?trail_length ()] creates a satellite from a
18
-
J2000 state vector. [epoch_unix] is the Unix timestamp of the state vector
19
-
(default 0). Precomputes orbital elements and ghost orbit. *)
51
+
(** [v ~pos ~vel ~color ?epoch_unix ?trail_length ()] creates a satellite using
52
+
Kepler (two-body) propagation from a J2000 state vector. *)
53
+
54
+
val of_propagator :
55
+
propagate:propagator ->
56
+
color:Color.t ->
57
+
?epoch_unix:float ->
58
+
?period:float ->
59
+
?ghost_duration:float ->
60
+
?trail_length:int ->
61
+
unit ->
62
+
t
63
+
(** [of_propagator ~propagate ~color ?epoch_unix ?period ?ghost_duration
64
+
?trail_length ()] creates a satellite from any propagation backend.
65
+
66
+
- [propagate]: position at dt seconds from epoch (J2000 km)
67
+
- [period]: orbital period in seconds (for ghost orbit and trail spacing;
68
+
default 5400s)
69
+
- [ghost_duration]: duration of ghost orbit arc in seconds (default: period)
70
+
- [trail_length]: number of trail points (default 50) *)
71
+
72
+
(** {1 Accessors} *)
20
73
21
74
val color : t -> Color.t
22
-
(** [color t] is the satellite's display color. *)
23
-
24
75
val epoch_unix : t -> float
25
-
(** [epoch_unix t] is the Unix timestamp of the state vector epoch. *)
76
+
val period : t -> float
26
77
27
-
val period : t -> float
28
-
(** [period t] is the orbital period in seconds. *)
78
+
(** {1 Rendering} *)
29
79
30
80
val ghost_points : t -> Math.Vec3.t option array
31
-
(** [ghost_points t] is the precomputed full-orbit ghost (GL coords). Computed
32
-
once at creation, reusable across frames. *)
81
+
(** Precomputed ghost orbit (GL coords). Computed once at creation. *)
33
82
34
83
val position_at : t -> dt:float -> Math.Vec3.t
35
-
(** [position_at t ~dt] is the satellite's GL position at [dt] seconds from
36
-
epoch. Very fast (~20 FLOPs). *)
84
+
(** GL position at [dt] seconds from epoch. *)
37
85
38
86
val trail_positions : t -> dt:float -> Math.Vec3.t option array
39
-
(** [trail_positions t ~dt] generates trail points up to [dt], fading into the
40
-
past. For use with {!Globe_webgl.Orbit.add_trail}. *)
87
+
(** Trail points for {!Globe_webgl.Orbit.add_trail}. *)
41
88
42
89
val dot : t -> dt:float -> Math.Vec3.t * Color.t
43
-
(** [dot t ~dt] is the satellite's current position and color, for building
44
-
{!Globe_webgl.Orbit.dot} values. *)
90
+
(** Current position + color for dot rendering. *)
91
+
92
+
(** {1 Orbital elements (Kepler only)} *)
45
93
46
94
val eccentricity : t -> float
47
-
(** [eccentricity t] is the orbital eccentricity. *)
95
+
(** Eccentricity. Returns [0.] for non-Kepler propagators. *)
48
96
49
97
val inclination : t -> float
50
-
(** [inclination t] is the orbital inclination in radians. *)
98
+
(** Inclination in radians. Returns [0.] for non-Kepler propagators. *)
51
99
52
100
val pp : t Fmt.t
53
-
(** [pp] pretty-prints a satellite (period, eccentricity, color). *)