Reusable 3D Earth globe widget (pure OCaml + WebGL)
Simplify Satellite.v: pos+vel required, ?propagate defaults to kepler
+46
-82
+31
-34
lib/satellite.ml
+31
-34
lib/satellite.ml
···
12
12
epoch_unix : float;
13
13
ghost_points : Math.Vec3.t option array;
14
14
trail_length : int;
15
+
pos : Kepler.Vec3.t;
16
+
vel : Kepler.Vec3.t;
15
17
elements : Kepler.Analytic.elements option;
16
-
pos0 : Kepler.Vec3.t;
17
-
vel0 : Kepler.Vec3.t;
18
18
}
19
19
20
20
(* ── Helpers ───────────────────────────────────────────────────────── *)
21
21
22
-
let safe_gl (fallback : Math.Vec3.t) (p : Kepler.Vec3.t) =
22
+
let safe_gl fallback (p : Kepler.Vec3.t) =
23
23
if Float.is_finite p.x && Float.is_finite p.y && Float.is_finite p.z then
24
24
Gl_coord.of_kepler p
25
25
else fallback
26
26
27
-
let make_ghost propagate ~dur ~fallback =
28
-
let n = 120 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)))
32
-
33
27
(* ── Propagator builders ───────────────────────────────────────────── *)
34
28
35
29
let kepler ~pos ~vel =
···
38
32
39
33
(* ── Constructor ───────────────────────────────────────────────────── *)
40
34
41
-
let v ?propagate ?pos ?vel ~color ?(epoch_unix = 0.) ?(period = 0.)
42
-
?(ghost_duration = 0.) ?(trail_length = 50) () =
43
-
let propagate, elements, pos0, vel0, auto_period =
44
-
match (propagate, pos, vel) with
45
-
| Some p, _, _ ->
46
-
let pos0 = match pos with Some p -> p | None -> Kepler.Vec3.zero in
47
-
let vel0 = match vel with Some v -> v | None -> Kepler.Vec3.zero in
48
-
(p, None, pos0, vel0, 5400.)
49
-
| None, Some pos, Some vel ->
50
-
let el = Kepler.Analytic.precompute ~pos ~vel in
51
-
let p = Kepler.Analytic.period el in
52
-
let prop ~dt = Kepler.Analytic.at_precomputed el ~dt in
53
-
(prop, Some el, pos, vel, p)
54
-
| None, _, _ ->
55
-
let pos0 = match pos with Some p -> p | None -> Kepler.Vec3.zero in
56
-
((fun ~dt:_ -> pos0), None, pos0, Kepler.Vec3.zero, 5400.)
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
57
46
in
58
47
let period =
59
48
if period > 0. then period
60
49
else if Float.is_finite auto_period && auto_period > 0. then auto_period
61
50
else 5400.
62
51
in
63
-
let ghost_dur = if ghost_duration > 0. then ghost_duration else period in
64
-
let fallback = Gl_coord.of_kepler pos0 in
65
-
let ghost_points = make_ghost propagate ~dur:ghost_dur ~fallback 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)))
58
+
in
66
59
{
67
60
propagate;
68
61
color;
···
70
63
epoch_unix;
71
64
ghost_points;
72
65
trail_length;
66
+
pos;
67
+
vel;
73
68
elements;
74
-
pos0;
75
-
vel0;
76
69
}
77
70
78
71
(* ── Accessors ─────────────────────────────────────────────────────── *)
···
80
73
let color t = t.color
81
74
let period t = t.period
82
75
let epoch_unix t = t.epoch_unix
76
+
let pos t = t.pos
77
+
let vel t = t.vel
83
78
let ghost_points t = t.ghost_points
84
79
85
80
(* ── Rendering ─────────────────────────────────────────────────────── *)
86
81
87
-
let position_at t ~dt = safe_gl (Gl_coord.of_kepler t.pos0) (t.propagate ~dt)
82
+
let position_at t ~dt = safe_gl (Gl_coord.of_kepler t.pos) (t.propagate ~dt)
88
83
89
84
let trail_positions t ~dt =
90
85
let n = t.trail_length in
···
93
88
t.period /. Float.of_int (n * 3)
94
89
else 30.
95
90
in
96
-
let fallback = Gl_coord.of_kepler t.pos0 in
91
+
let fallback = Gl_coord.of_kepler t.pos in
97
92
Array.init n (fun i ->
98
93
let t_offset = dt -. (Float.of_int (n - 1 - i) *. step) in
99
94
Some (safe_gl fallback (t.propagate ~dt:t_offset)))
···
105
100
let eccentricity t =
106
101
match t.elements with
107
102
| Some el -> Kepler.Analytic.eccentricity el
108
-
| None -> 0.
103
+
| None ->
104
+
let el = Kepler.Analytic.precompute ~pos:t.pos ~vel:t.vel in
105
+
Kepler.Analytic.eccentricity el
109
106
110
107
let inclination t =
111
-
let p = t.pos0 and v = t.vel0 in
108
+
let p = t.pos and v = t.vel in
112
109
let hx = (p.y *. v.z) -. (p.z *. v.y) in
113
110
let hy = (p.z *. v.x) -. (p.x *. v.z) in
114
111
let hz = (p.x *. v.y) -. (p.y *. v.x) in
+15
-48
lib/satellite.mli
+15
-48
lib/satellite.mli
···
1
1
(** Satellite state management for globe rendering.
2
2
3
-
Supports multiple propagation backends via the optional [~propagate]
4
-
parameter. Default: Kepler two-body from [~pos] and [~vel].
5
-
6
3
{[
7
-
(* Kepler (default — needs pos + vel): *)
4
+
(* Kepler propagation (default): *)
8
5
Satellite.v ~pos ~vel ~color ~epoch_unix ()
9
6
(* SGP4 from TLE: *)
10
-
Satellite.v
11
-
~propagate:(Satellite.sgp4 tle state)
12
-
~color ~epoch_unix ~period ()
13
-
(* Custom propagator: *)
14
-
Satellite.v
15
-
~propagate:(fun ~dt -> my_interp dt)
16
-
~color ~epoch_unix ~period ()
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 ()
17
10
]} *)
18
11
19
12
type t
···
25
18
(** {1 Propagator builders} *)
26
19
27
20
val kepler : pos:Kepler.Vec3.t -> vel:Kepler.Vec3.t -> propagator
28
-
(** [kepler ~pos ~vel] builds a two-body Kepler propagator. Uses
29
-
{!Kepler.Analytic.precompute} internally — fast, ~20 FLOPs per call.
30
-
Accurate within ±1 orbit of epoch. *)
21
+
(** Two-body Kepler. ~20 FLOPs/call. Accurate ±1 orbit. *)
31
22
32
23
(** {1 Constructor} *)
33
24
34
25
val v :
35
-
?propagate:propagator ->
36
-
?pos:Kepler.Vec3.t ->
37
-
?vel:Kepler.Vec3.t ->
26
+
pos:Kepler.Vec3.t ->
27
+
vel:Kepler.Vec3.t ->
38
28
color:Color.t ->
29
+
?propagate:propagator ->
39
30
?epoch_unix:float ->
40
31
?period:float ->
41
-
?ghost_duration:float ->
42
32
?trail_length:int ->
43
33
unit ->
44
34
t
45
-
(** [v ~color ()] creates a satellite.
35
+
(** [v ~pos ~vel ~color ()] creates a satellite.
46
36
47
-
Propagation is chosen by:
48
-
- [~propagate:p] — use propagator [p] (from {!kepler}, {!sgp4}, or custom)
49
-
- [~pos] + [~vel] without [~propagate] — auto-builds Kepler propagator
50
-
- [~propagate] without [~pos]/[~vel] — propagator-only (no orbital elements)
51
-
52
-
Optional parameters:
53
-
- [period]: orbital period in seconds (auto-detected for Kepler/SGP4)
54
-
- [ghost_duration]: ghost orbit arc in seconds (default: [period])
55
-
- [trail_length]: number of trail points (default 50) *)
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. *)
56
40
57
41
(** {1 Accessors} *)
58
42
59
43
val color : t -> Color.t
60
-
(** Satellite color. *)
61
-
62
44
val epoch_unix : t -> float
63
-
(** Unix timestamp of the propagation epoch. *)
64
-
65
45
val period : t -> float
66
-
(** Orbital period in seconds. *)
46
+
val pos : t -> Kepler.Vec3.t
47
+
val vel : t -> Kepler.Vec3.t
67
48
68
49
(** {1 Rendering} *)
69
50
70
51
val ghost_points : t -> Math.Vec3.t option array
71
-
(** Precomputed ghost orbit (GL coords). Computed once at creation. *)
72
-
73
52
val position_at : t -> dt:float -> Math.Vec3.t
74
-
(** [position_at t ~dt] returns the GL position at [dt] seconds from epoch. *)
75
-
76
53
val trail_positions : t -> dt:float -> Math.Vec3.t option array
77
-
(** Trail points for orbit rendering. *)
78
-
79
54
val dot : t -> dt:float -> Math.Vec3.t * Color.t
80
-
(** Current position and color for dot rendering. *)
81
55
82
-
(** {1 Orbital elements (Kepler only, 0. otherwise)} *)
56
+
(** {1 Orbital elements} *)
83
57
84
58
val eccentricity : t -> float
85
-
(** [eccentricity t] returns the orbital eccentricity. Returns [0.] for
86
-
non-Kepler propagators. *)
87
-
88
59
val inclination : t -> float
89
-
(** [inclination t] returns the orbital inclination in radians. Returns [0.] for
90
-
non-Kepler propagators. *)
91
-
92
60
val pp : t Fmt.t
93
-
(** Pretty-print a satellite. *)