Reusable 3D Earth globe widget (pure OCaml + WebGL)
Replace Printf/Format with Fmt, rename test_cara
Style: Fmt.pr/str/pf across collision, spacedata, stix, ocm.
Rename test_cara → test_collision_properties.
+73
-49
+1
-1
demo/dune
+1
-1
demo/dune
···
1
1
(executable
2
2
(name main)
3
3
(modes js)
4
-
(libraries globe globe.webgl brr helix helix.html helix.stdweb helix.jx.jsoo signal fmt)
4
+
(libraries globe vec3 globe.webgl brr helix helix.html helix.stdweb helix.jx.jsoo signal fmt)
5
5
(js_of_ocaml
6
6
(flags (:standard --target-env=browser)))
7
7
(promote (until-clean)))
+2
-2
demo/main.ml
+2
-2
demo/main.ml
···
32
32
(* km, ISS-like altitude *)
33
33
let v = 7.669 in
34
34
(* km/s, circular velocity *)
35
-
let pos = Kepler.Vec3.v r 0. 0. in
36
-
let vel = Kepler.Vec3.v 0. (v *. cos incl) (v *. sin incl) in
35
+
let pos = Vec3.v r 0. 0. in
36
+
let vel = Vec3.v 0. (v *. cos incl) (v *. sin incl) in
37
37
Globe.Satellite.v ~pos ~vel ~color ())
38
38
colors
39
39
+1
-1
fuzz/dune
+1
-1
fuzz/dune
+14
-4
fuzz/fuzz_satellite.ml
+14
-4
fuzz/fuzz_satellite.ml
···
29
29
&& is_finite vy && is_finite vz
30
30
&& (px *. px) +. (py *. py) +. (pz *. pz) > 1e-10
31
31
&& (vx *. vx) +. (vy *. vy) +. (vz *. vz) > 1e-10
32
-
then Some (Kepler.Vec3.v px py pz, Kepler.Vec3.v vx vy vz)
32
+
then Some (Vec3.v px py pz, Vec3.v vx vy vz)
33
33
else None
34
34
35
35
(** 1. Satellite.v must not crash on any valid state vector. *)
···
76
76
| Some (pos, vel) ->
77
77
let sat = Satellite.v ~pos ~vel ~color:Color.cyan () in
78
78
let period = Satellite.period sat in
79
-
if (not (is_finite period)) || period < 1. then ()
79
+
let eccentricity = Satellite.eccentricity sat in
80
+
if
81
+
(not (is_finite period))
82
+
|| period < 1.
83
+
|| (not (is_finite eccentricity))
84
+
|| eccentricity >= 1.
85
+
then ()
80
86
else begin
81
87
let frame_dt = period /. 60. in
82
88
let prev = ref (Satellite.position_at sat ~dt:0.) in
···
88
94
let dy = p.y -. !prev.y in
89
95
let dz = p.z -. !prev.z in
90
96
let jump = sqrt ((dx *. dx) +. (dy *. dy) +. (dz *. dz)) in
91
-
let radius = Math.Vec3.length !prev in
92
-
let max_jump = Float.max 0.1 (radius *. 0.05) in
97
+
let radius =
98
+
Float.max (Math.Vec3.length !prev) (Math.Vec3.length p)
99
+
in
100
+
(* 60 samples/orbit gives a circular-orbit chord of ~0.105 * radius.
101
+
Allow extra headroom for eccentric bound orbits and numeric error. *)
102
+
let max_jump = Float.max 0.1 (radius *. 0.25) in
93
103
assert (jump < max_jump)
94
104
end;
95
105
prev := p
+1
-1
lib/dune
+1
-1
lib/dune
+9
-9
lib/gl_coord.ml
+9
-9
lib/gl_coord.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
-
(** GL coordinate mapping for Earth-centered frames.
7
-
8
-
Maps astrodynamics conventions (X,Y = equatorial, Z = north pole) to WebGL
9
-
conventions (X,Z = equatorial, Y = up/north pole), scaled so Earth radius =
10
-
1.0. *)
6
+
(** GL coordinate mapping: astro (km, X/Y equatorial, Z north) → WebGL (Earth
7
+
radius = 1.0, Y up). *)
11
8
12
9
let scale = 1. /. Coordinate.earth_radius
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
10
+
11
+
let of_vec3 (v : Vec3.t) =
12
+
Math.Vec3.create (v.x *. scale) (v.z *. scale) (v.y *. scale)
13
+
14
+
let of_kepler = of_vec3
15
+
let of_coordinate = of_vec3
16
+
let of_astro ~x ~y ~z = of_vec3 (Vec3.v x y z)
+8
-6
lib/gl_coord.mli
+8
-6
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_kepler : Kepler.Vec3.t -> Math.Vec3.t
7
-
(** [of_kepler v] converts a Kepler position vector (km) to GL coordinates. *)
6
+
val of_vec3 : Vec3.t -> Math.Vec3.t
7
+
(** [of_vec3 v] converts a position vector (km, any frame) to GL coordinates. *)
8
8
9
-
val of_coordinate : Coordinate.vec3 -> Math.Vec3.t
10
-
(** [of_coordinate v] converts a {!Coordinate.vec3} to GL coordinates. *)
9
+
val of_kepler : Vec3.t -> Math.Vec3.t
10
+
(** Alias for {!of_vec3}. *)
11
+
12
+
val of_coordinate : Vec3.t -> Math.Vec3.t
13
+
(** Alias for {!of_vec3}. *)
11
14
12
15
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. *)
16
+
(** [of_astro ~x ~y ~z] maps (x, y, z) in km to GL coordinates. *)
+18
-16
lib/satellite.ml
+18
-16
lib/satellite.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
-
type propagator = dt:float -> Kepler.Vec3.t
6
+
type propagator = dt:float -> Vec3.t
7
7
8
8
type t = {
9
9
propagate : propagator;
···
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
+
pos : Vec3.t;
16
+
vel : Vec3.t;
17
17
}
18
18
19
19
(* ── Helpers ───────────────────────────────────────────────────────── *)
20
20
21
-
let safe_gl fallback (p : Kepler.Vec3.t) =
21
+
let safe_gl fallback (p : Vec3.t) =
22
22
if Float.is_finite p.x && Float.is_finite p.y && Float.is_finite p.z then
23
23
Gl_coord.of_kepler p
24
24
else fallback
···
57
57
let propagate ~dt = Kepler.Analytic.at_precomputed el ~dt in
58
58
make ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel
59
59
60
+
let v = of_state_vector
61
+
60
62
let of_tle ~tle ~state ~color ?(trail_length = 50) () =
61
63
let epoch_unix = Sgp4.epoch_unix tle in
62
64
let period = 2. *. Float.pi /. tle.no *. 60. in
···
64
66
(* Extract pos/vel at epoch *)
65
67
let pos, vel =
66
68
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)
69
+
| Ok (p, v) -> (Vec3.v p.x p.y p.z, Vec3.v v.vx v.vy v.vz)
70
+
| Error _ -> (Vec3.zero, Vec3.zero)
69
71
in
70
72
let propagate ~dt =
71
73
let tsince = dt /. 60. in
72
74
match Sgp4.propagate state tle tsince with
73
-
| Ok (p, _v) -> Kepler.Vec3.v p.x p.y p.z
75
+
| Ok (p, _v) -> Vec3.v p.x p.y p.z
74
76
| Error _ -> pos (* fallback to epoch position *)
75
77
in
76
78
make ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel
···
79
81
let n = Array.length points in
80
82
if n = 0 then
81
83
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
84
+
~propagate:(fun ~dt:_ -> Vec3.zero)
85
+
~color ~epoch_unix:0. ~period:5400. ~trail_length ~pos:Vec3.zero
86
+
~vel:Vec3.zero
85
87
else
86
88
let mid = n / 2 in
87
89
let epoch_unix, pos = points.(mid) in
···
89
91
let vel =
90
92
if n >= 2 then
91
93
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 t0, (p0 : Vec3.t) = points.(i0)
95
+
and t1, (p1 : Vec3.t) = points.(i1) in
94
96
let dt = t1 -. t0 in
95
97
if dt > 0. then
96
-
Kepler.Vec3.v
98
+
Vec3.v
97
99
((p1.x -. p0.x) /. dt)
98
100
((p1.y -. p0.y) /. dt)
99
101
((p1.z -. p0.z) /. dt)
100
-
else Kepler.Vec3.zero
101
-
else Kepler.Vec3.zero
102
+
else Vec3.zero
103
+
else Vec3.zero
102
104
in
103
105
(* Estimate period from data span *)
104
106
let t_start = fst points.(0) and t_end = fst points.(n - 1) in
···
124
126
else
125
127
let frac = (target -. t0) /. dt in
126
128
let frac = Float.max 0. (Float.min 1. frac) in
127
-
Kepler.Vec3.v
129
+
Vec3.v
128
130
(p0.x +. (frac *. (p1.x -. p0.x)))
129
131
(p0.y +. (frac *. (p1.y -. p0.y)))
130
132
(p0.z +. (frac *. (p1.z -. p0.z)))
+15
-5
lib/satellite.mli
+15
-5
lib/satellite.mli
···
17
17
(** {1 Constructors} *)
18
18
19
19
val of_state_vector :
20
-
pos:Kepler.Vec3.t ->
21
-
vel:Kepler.Vec3.t ->
20
+
pos:Vec3.t ->
21
+
vel:Vec3.t ->
22
22
color:Color.t ->
23
23
?epoch_unix:float ->
24
24
?trail_length:int ->
···
27
27
(** From a J2000 state vector. Uses Kepler two-body propagation. Accurate within
28
28
±1 orbit of epoch. *)
29
29
30
+
val v :
31
+
pos:Vec3.t ->
32
+
vel:Vec3.t ->
33
+
color:Color.t ->
34
+
?epoch_unix:float ->
35
+
?trail_length:int ->
36
+
unit ->
37
+
t
38
+
(** Backward-compatible alias for {!of_state_vector}. *)
39
+
30
40
val of_tle :
31
41
tle:Sgp4.tle ->
32
42
state:Sgp4.state ->
···
38
48
Epoch and period extracted from TLE. *)
39
49
40
50
val of_ephemeris :
41
-
points:(float * Kepler.Vec3.t) array ->
51
+
points:(float * Vec3.t) array ->
42
52
color:Color.t ->
43
53
?trail_length:int ->
44
54
unit ->
···
52
62
val color : t -> Color.t
53
63
val epoch_unix : t -> float
54
64
val period : t -> float
55
-
val pos : t -> Kepler.Vec3.t
56
-
val vel : t -> Kepler.Vec3.t
65
+
val pos : t -> Vec3.t
66
+
val vel : t -> Vec3.t
57
67
58
68
(** {1 Rendering} *)
59
69
+1
-1
test/dune
+1
-1
test/dune
+1
-1
test/test_gl_coord.ml
+1
-1
test/test_gl_coord.ml
+2
-2
test/test_satellite.ml
+2
-2
test/test_satellite.ml
···
10
10
let check_float msg expected actual =
11
11
Alcotest.(check (float eps)) msg expected actual
12
12
13
-
let iss_pos = Kepler.Vec3.v 6778. 0. 0.
14
-
let iss_vel = Kepler.Vec3.v 0. (sqrt (398600.4418 /. 6778.)) 0.
13
+
let iss_pos = Vec3.v 6778. 0. 0.
14
+
let iss_vel = Vec3.v 0. (sqrt (398600.4418 /. 6778.)) 0.
15
15
16
16
let test_period () =
17
17
let sat = Satellite.v ~pos:iss_pos ~vel:iss_vel ~color:Color.cyan () in