Reusable 3D Earth globe widget (pure OCaml + WebGL)
Fix merlint E005/E010: split long functions and flatten deep nesting
Refactored 21 functions across 17 files to bring them under merlint
thresholds. Pure structural refactoring — no behavior changes.
Packages: irmin, merlint, monopam, ocaml-btree, ocaml-cdm, ocaml-git,
ocaml-globe, ocaml-kepler, ocaml-osv, ocaml-sigstore, ocaml-stix, prune.
+87
-84
+12
-5
lib/geometry.ml
+12
-5
lib/geometry.ml
···
22
22
23
23
Returns pairs of (x,y,z) endpoints in GL coordinates (Y=up). [spacing] is
24
24
degrees between lines. *)
25
-
let grid_lines ?(spacing = 30.) ?(segments = 72) () =
25
+
let latitude_lines ~r ~spacing ~segments vertices =
26
26
let deg_to_rad d = Coordinate.deg_to_rad d in
27
-
let vertices = ref [] in
28
-
let r = 1.002 in
29
27
let lat = ref (-90. +. spacing) in
30
28
while !lat < 90. do
31
29
let lat_rad = deg_to_rad !lat in
···
47
45
:: !vertices
48
46
done;
49
47
lat := !lat +. spacing
50
-
done;
48
+
done
49
+
50
+
let longitude_lines ~r ~spacing ~segments vertices =
51
+
let deg_to_rad d = Coordinate.deg_to_rad d in
51
52
let lon = ref (-180.) in
52
53
while !lon < 180. do
53
54
let lon_rad = deg_to_rad !lon in
···
72
73
:: !vertices
73
74
done;
74
75
lon := !lon +. spacing
75
-
done;
76
+
done
77
+
78
+
let grid_lines ?(spacing = 30.) ?(segments = 72) () =
79
+
let vertices = ref [] in
80
+
let r = 1.002 in
81
+
latitude_lines ~r ~spacing ~segments vertices;
82
+
longitude_lines ~r ~spacing ~segments vertices;
76
83
List.rev !vertices
77
84
78
85
(** Generate a circle of points on the unit sphere around [center].
+35
-41
lib/satellite.ml
+35
-41
lib/satellite.ml
···
77
77
in
78
78
make ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel
79
79
80
+
let estimate_velocity points ~mid ~n =
81
+
if n >= 2 then
82
+
let i0 = max 0 (mid - 1) and i1 = min (n - 1) (mid + 1) in
83
+
let t0, (p0 : Vec3.t) = points.(i0) and t1, (p1 : Vec3.t) = points.(i1) in
84
+
let dt = t1 -. t0 in
85
+
if dt > 0. then
86
+
Vec3.v ((p1.x -. p0.x) /. dt) ((p1.y -. p0.y) /. dt) ((p1.z -. p0.z) /. dt)
87
+
else Vec3.zero
88
+
else Vec3.zero
89
+
90
+
let interpolate_position points ~n ~epoch_unix ~dt =
91
+
let target = epoch_unix +. dt in
92
+
let rec find lo hi =
93
+
if lo >= hi - 1 then lo
94
+
else
95
+
let mid = (lo + hi) / 2 in
96
+
if fst points.(mid) <= target then find mid hi else find lo mid
97
+
in
98
+
let i = find 0 (n - 1) in
99
+
let t0, (p0 : Vec3.t) = points.(i) in
100
+
if i >= n - 1 then p0
101
+
else
102
+
let t1, (p1 : Vec3.t) = points.(i + 1) in
103
+
let dt = t1 -. t0 in
104
+
if dt < 1e-10 then p0
105
+
else
106
+
let frac = (target -. t0) /. dt in
107
+
let frac = Float.max 0. (Float.min 1. frac) in
108
+
Vec3.v
109
+
(p0.x +. (frac *. (p1.x -. p0.x)))
110
+
(p0.y +. (frac *. (p1.y -. p0.y)))
111
+
(p0.z +. (frac *. (p1.z -. p0.z)))
112
+
80
113
let of_ephemeris ~points ~color ?(trail_length = 50) () =
81
114
let n = Array.length points in
82
115
if n = 0 then
···
87
120
else
88
121
let mid = n / 2 in
89
122
let epoch_unix, pos = points.(mid) in
90
-
(* Estimate velocity from neighboring points *)
91
-
let vel =
92
-
if n >= 2 then
93
-
let i0 = max 0 (mid - 1) and i1 = min (n - 1) (mid + 1) in
94
-
let t0, (p0 : Vec3.t) = points.(i0)
95
-
and t1, (p1 : Vec3.t) = points.(i1) in
96
-
let dt = t1 -. t0 in
97
-
if dt > 0. then
98
-
Vec3.v
99
-
((p1.x -. p0.x) /. dt)
100
-
((p1.y -. p0.y) /. dt)
101
-
((p1.z -. p0.z) /. dt)
102
-
else Vec3.zero
103
-
else Vec3.zero
104
-
in
105
-
(* Estimate period from data span *)
123
+
let vel = estimate_velocity points ~mid ~n in
106
124
let t_start = fst points.(0) and t_end = fst points.(n - 1) in
107
125
let span = t_end -. t_start in
108
126
let period = if span > 0. then span else 5400. in
109
-
(* Linear interpolation *)
110
-
let propagate ~dt =
111
-
let target = epoch_unix +. dt in
112
-
(* Binary search for bracket *)
113
-
let rec find lo hi =
114
-
if lo >= hi - 1 then lo
115
-
else
116
-
let mid = (lo + hi) / 2 in
117
-
if fst points.(mid) <= target then find mid hi else find lo mid
118
-
in
119
-
let i = find 0 (n - 1) in
120
-
let t0, p0 = points.(i) in
121
-
if i >= n - 1 then p0
122
-
else
123
-
let t1, p1 = points.(i + 1) in
124
-
let dt = t1 -. t0 in
125
-
if dt < 1e-10 then p0
126
-
else
127
-
let frac = (target -. t0) /. dt in
128
-
let frac = Float.max 0. (Float.min 1. frac) in
129
-
Vec3.v
130
-
(p0.x +. (frac *. (p1.x -. p0.x)))
131
-
(p0.y +. (frac *. (p1.y -. p0.y)))
132
-
(p0.z +. (frac *. (p1.z -. p0.z)))
133
-
in
127
+
let propagate ~dt = interpolate_position points ~n ~epoch_unix ~dt in
134
128
make ~propagate ~color ~epoch_unix ~period ~trail_length ~pos ~vel
135
129
136
130
(* ── Accessors ─────────────────────────────────────────────────────── *)
+40
-38
lib/webgl/scene.ml
+40
-38
lib/webgl/scene.ml
···
98
98
99
99
let sat_dt sat current_unix = current_unix -. Globe.Satellite.epoch_unix sat
100
100
101
-
let update_time t current_unix =
102
-
t.current_unix <- current_unix;
103
-
let camera_pos = camera_position t in
104
-
(* Compute positions + LOD for all satellites *)
105
-
let sat_positions =
106
-
List.map
107
-
(fun sat ->
108
-
let dt = sat_dt sat current_unix in
109
-
(sat, Globe.Satellite.position_at sat ~dt))
110
-
t.satellites
111
-
in
112
-
let { Globe.Visibility.full; dot_only; hidden = _hidden } =
113
-
Globe.Visibility.partition_by_lod ~camera_pos
114
-
~pos:(fun (_sat, pos) -> pos)
115
-
sat_positions
116
-
in
117
-
(* Trails only for Full LOD satellites *)
118
-
Orbit.clear_trails t.orbit;
101
+
let add_full_trails t current_unix sats =
119
102
List.iter
120
103
(fun (sat, _pos) ->
121
104
let dt = sat_dt sat current_unix in
···
123
106
Orbit.add_trail t.gl t.orbit trail
124
107
~head_idx:(Array.length trail - 1)
125
108
~color:(Globe.Satellite.color sat))
126
-
full;
127
-
(* Also add short trails for dot_only (just 3 points for direction) *)
109
+
sats
110
+
111
+
let add_short_trails t current_unix sats =
128
112
List.iter
129
113
(fun (sat, _pos) ->
130
114
let dt = sat_dt sat current_unix in
···
135
119
Orbit.add_trail t.gl t.orbit short ~head_idx:2
136
120
~color:(Globe.Satellite.color sat)
137
121
end)
138
-
dot_only;
139
-
(* Coverage footprints for visible satellites *)
140
-
let visible = full @ dot_only in
141
-
let footprints =
142
-
List.filter_map
143
-
(fun (sat, pos) ->
144
-
let r = Globe.Math.Vec3.length pos in
145
-
if r < 1.01 then None
146
-
else
147
-
let alt_km = (r -. 1.) *. Coordinate.earth_radius in
148
-
let angle =
149
-
Globe.Geometry.footprint_angle ~altitude:alt_km ~min_elevation:0.
150
-
in
151
-
Some
152
-
Coverage.
153
-
{ pos; color = Globe.Satellite.color sat; half_angle = angle })
154
-
visible
122
+
sats
123
+
124
+
let compute_footprints visible =
125
+
List.filter_map
126
+
(fun (sat, pos) ->
127
+
let r = Globe.Math.Vec3.length pos in
128
+
if r < 1.01 then None
129
+
else
130
+
let alt_km = (r -. 1.) *. Coordinate.earth_radius in
131
+
let angle =
132
+
Globe.Geometry.footprint_angle ~altitude:alt_km ~min_elevation:0.
133
+
in
134
+
Some
135
+
Coverage.
136
+
{ pos; color = Globe.Satellite.color sat; half_angle = angle })
137
+
visible
138
+
139
+
let update_time t current_unix =
140
+
t.current_unix <- current_unix;
141
+
let camera_pos = camera_position t in
142
+
let sat_positions =
143
+
List.map
144
+
(fun sat ->
145
+
let dt = sat_dt sat current_unix in
146
+
(sat, Globe.Satellite.position_at sat ~dt))
147
+
t.satellites
148
+
in
149
+
let { Globe.Visibility.full; dot_only; hidden = _hidden } =
150
+
Globe.Visibility.partition_by_lod ~camera_pos
151
+
~pos:(fun (_sat, pos) -> pos)
152
+
sat_positions
155
153
in
156
-
Coverage.load t.gl t.coverage footprints
154
+
Orbit.clear_trails t.orbit;
155
+
add_full_trails t current_unix full;
156
+
add_short_trails t current_unix dot_only;
157
+
let visible = full @ dot_only in
158
+
Coverage.load t.gl t.coverage (compute_footprints visible)
157
159
158
160
let satellite_dots t =
159
161
let camera_pos = camera_position t in