Reusable 3D Earth globe widget (pure OCaml + WebGL)
Bound monotonic timestamp drift; return receipt_summary from verify
monotonic_now: increment changed from 1μs to 1ms, drift capped at 300s.
Rejects registration if clock drift exceeds cap instead of silently
issuing synthetic timestamps indefinitely.
verify/verify_receipt_only now return receipt_summary with total,
verified, failed, skipped counts so callers can detect partial
verification (e.g. 2 of 3 receipts tampered).
+296
-34
+2
-2
lib/visibility.ml
+2
-2
lib/visibility.ml
···
58
58
[camera_pos]: camera position in GL coordinates. [point]: satellite position
59
59
in GL coordinates. [near]: distance threshold for full detail (default 2.0).
60
60
[far]: distance threshold for dot-only (default 6.0). *)
61
-
let lod ?(near = 2.0) ?(far = 6.0) ~camera_pos point =
61
+
let lod ?(near = 4.0) ?(far = 12.0) ~camera_pos point =
62
62
if not (is_visible ~camera_pos point) then Hidden
63
63
else
64
64
let d = Math.Vec3.length (Math.Vec3.sub camera_pos point) in
···
67
67
type 'a lod_partition = { full : 'a list; dot_only : 'a list; hidden : 'a list }
68
68
69
69
(** Partition items by LOD. [pos] extracts position from each item. *)
70
-
let partition_by_lod ?(near = 2.0) ?(far = 6.0) ~camera_pos ~pos items =
70
+
let partition_by_lod ?(near = 4.0) ?(far = 12.0) ~camera_pos ~pos items =
71
71
let full = ref [] and dots = ref [] and hidden = ref [] in
72
72
List.iter
73
73
(fun item ->
+1
-1
lib/visibility.mli
+1
-1
lib/visibility.mli
···
20
20
val lod :
21
21
?near:float -> ?far:float -> camera_pos:Math.Vec3.t -> Math.Vec3.t -> lod
22
22
(** [lod ?near ?far ~camera_pos point] determines the detail level. [near]
23
-
(default 2.0) and [far] (default 6.0) are distance thresholds. *)
23
+
(default 4.0) and [far] (default 12.0) are distance thresholds. *)
24
24
25
25
type 'a lod_partition = { full : 'a list; dot_only : 'a list; hidden : 'a list }
26
26
(** Result of partitioning items by level of detail. *)
+19
-4
lib/webgl/orbit.ml
+19
-4
lib/webgl/orbit.ml
···
14
14
15
15
(* --- Shaders --- *)
16
16
17
-
(** Trail line: per-vertex progress [0=tail, 1=head] controls alpha. *)
17
+
(** Trail line: per-vertex progress [0=tail, 1=head] and distance-based fade. *)
18
18
let trail_vertex =
19
19
{|#version 300 es
20
20
precision highp float;
···
22
22
layout(location = 1) in float a_progress;
23
23
uniform mat4 u_projection;
24
24
uniform mat4 u_view;
25
+
uniform vec3 u_camera_pos;
26
+
uniform float u_far;
25
27
out float v_progress;
28
+
out float v_dist_fade;
26
29
void main() {
27
30
gl_Position = u_projection * u_view * vec4(a_position, 1.0);
28
31
v_progress = a_progress;
32
+
// Per-vertex distance fade: 1.0 when close, 0.0 at u_far
33
+
float d = distance(u_camera_pos, a_position);
34
+
v_dist_fade = clamp(1.0 - d / u_far, 0.0, 1.0);
29
35
}
30
36
|}
31
37
···
34
40
precision highp float;
35
41
uniform vec3 u_color;
36
42
in float v_progress;
43
+
in float v_dist_fade;
37
44
out vec4 fragColor;
38
45
void main() {
39
-
// Fade: bright at head (progress=1), transparent at tail (progress=0)
40
-
float alpha = v_progress * v_progress * 0.9;
46
+
float progress_alpha = v_progress * v_progress * 0.9;
47
+
float alpha = progress_alpha * v_dist_fade;
48
+
if (alpha < 0.005) discard;
41
49
fragColor = vec4(u_color, alpha);
42
50
}
43
51
|}
···
89
97
trail_u_proj : Gl.uniform_location;
90
98
trail_u_view : Gl.uniform_location;
91
99
trail_u_color : Gl.uniform_location;
100
+
trail_u_camera : Gl.uniform_location;
101
+
trail_u_far : Gl.uniform_location;
92
102
dot_prog : Gl.program;
93
103
dot_u_proj : Gl.uniform_location;
94
104
dot_u_view : Gl.uniform_location;
···
120
130
trail_u_proj = u "u_projection" trail_prog;
121
131
trail_u_view = u "u_view" trail_prog;
122
132
trail_u_color = u "u_color" trail_prog;
133
+
trail_u_camera = u "u_camera_pos" trail_prog;
134
+
trail_u_far = u "u_far" trail_prog;
123
135
dot_prog;
124
136
dot_u_proj = u "u_projection" dot_prog;
125
137
dot_u_view = u "u_view" dot_prog;
···
218
230
Gl.bind_vertex_array gl None)
219
231
trails
220
232
221
-
let draw gl t ~projection ~view ~dots =
233
+
let draw gl t ~projection ~view ~camera_pos ~far ~dots =
222
234
let proj = Tarray.of_float_array Tarray.Float32 projection in
223
235
let vw = Tarray.of_float_array Tarray.Float32 view in
224
236
Gl.use_program gl t.trail_prog;
225
237
Gl.uniform_matrix4fv gl t.trail_u_proj false proj;
226
238
Gl.uniform_matrix4fv gl t.trail_u_view false vw;
239
+
let (cp : Globe.Math.Vec3.t) = camera_pos in
240
+
Gl.uniform3f gl t.trail_u_camera cp.x cp.y cp.z;
241
+
Gl.uniform1f gl t.trail_u_far far;
227
242
(* Ghost orbits first (behind trails) *)
228
243
draw_trails gl t ~proj ~vw t.ghosts;
229
244
(* Active trails *)
+5
-2
lib/webgl/orbit.mli
+5
-2
lib/webgl/orbit.mli
···
62
62
t ->
63
63
projection:float array ->
64
64
view:float array ->
65
+
camera_pos:Globe.Math.Vec3.t ->
66
+
far:float ->
65
67
dots:dot list ->
66
68
unit
67
-
(** [draw gl t ~projection ~view ~dots] renders ghosts, then trails, then
68
-
satellite position dots. *)
69
+
(** [draw gl t ~projection ~view ~camera_pos ~far ~dots] renders ghosts, then
70
+
trails, then satellite position dots. Trail points fade smoothly to
71
+
transparent as their distance from [camera_pos] approaches [far]. *)
69
72
70
73
val draw_dot :
71
74
Brr_canvas.Gl.t ->
+39
-20
lib/webgl/scene.ml
+39
-20
lib/webgl/scene.ml
···
35
35
mutable current_unix : float;
36
36
mutable hovered : int option;
37
37
mutable last_frame : frame option;
38
+
mutable disable_lod : bool;
38
39
}
39
40
40
41
let v ?(num_points = 30000) ?(grid_spacing = 30.) canvas_el =
···
72
73
current_unix = 0.;
73
74
hovered = None;
74
75
last_frame = None;
76
+
disable_lod = false;
75
77
}
76
78
77
79
let gl t = t.gl
···
81
83
let satellites t = t.satellites
82
84
let camera_position t = Camera.position t.camera
83
85
let set_grid_spacing t spacing = t.grid <- Some (Grid.v ~spacing t.gl)
86
+
let set_disable_lod t b = t.disable_lod <- b
84
87
85
88
(* ------------------------------------------------------------------ *)
86
89
(* Satellite management *)
···
138
141
139
142
let update_time t current_unix =
140
143
t.current_unix <- current_unix;
141
-
let camera_pos = camera_position t in
142
144
let sat_positions =
143
145
List.map
144
146
(fun sat ->
···
146
148
(sat, Globe.Satellite.position_at sat ~dt))
147
149
t.satellites
148
150
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
153
-
in
154
151
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)
152
+
if t.disable_lod then begin
153
+
add_full_trails t current_unix sat_positions;
154
+
Coverage.load t.gl t.coverage (compute_footprints sat_positions)
155
+
end
156
+
else begin
157
+
let camera_pos = camera_position t in
158
+
let { Globe.Visibility.full; dot_only; hidden = _hidden } =
159
+
Globe.Visibility.partition_by_lod ~camera_pos
160
+
~pos:(fun (_sat, pos) -> pos)
161
+
sat_positions
162
+
in
163
+
add_full_trails t current_unix full;
164
+
add_short_trails t current_unix dot_only;
165
+
let visible = full @ dot_only in
166
+
Coverage.load t.gl t.coverage (compute_footprints visible)
167
+
end
159
168
160
169
let satellite_dots t =
161
-
let camera_pos = camera_position t in
162
-
List.filter_map
163
-
(fun sat ->
164
-
let dt = sat_dt sat t.current_unix in
165
-
let pos, color = Globe.Satellite.dot sat ~dt in
166
-
match Globe.Visibility.lod ~camera_pos pos with
167
-
| Globe.Visibility.Hidden -> None
168
-
| _ -> Some Orbit.{ pos; color })
169
-
t.satellites
170
+
if t.disable_lod then
171
+
List.map
172
+
(fun sat ->
173
+
let dt = sat_dt sat t.current_unix in
174
+
let pos, color = Globe.Satellite.dot sat ~dt in
175
+
Orbit.{ pos; color })
176
+
t.satellites
177
+
else
178
+
let camera_pos = camera_position t in
179
+
List.filter_map
180
+
(fun sat ->
181
+
let dt = sat_dt sat t.current_unix in
182
+
let pos, color = Globe.Satellite.dot sat ~dt in
183
+
match Globe.Visibility.lod ~camera_pos pos with
184
+
| Globe.Visibility.Hidden -> None
185
+
| _ -> Some Orbit.{ pos; color })
186
+
t.satellites
170
187
171
188
let satellite_positions t =
172
189
List.map
···
244
261
| None -> ());
245
262
if layers.show_orbits then begin
246
263
let dots = satellite_dots t in
247
-
Orbit.draw gl t.orbit ~projection:p ~view:v ~dots;
264
+
let cam_pos = camera_position t in
265
+
Orbit.draw gl t.orbit ~projection:p ~view:v ~camera_pos:cam_pos ~far:12.0
266
+
~dots;
248
267
(* Draw hovered satellite larger *)
249
268
match t.hovered with
250
269
| Some idx -> (
+4
lib/webgl/scene.mli
+4
lib/webgl/scene.mli
···
31
31
val set_grid_spacing : t -> float -> unit
32
32
(** [set_grid_spacing t spacing] rebuilds the grid. *)
33
33
34
+
val set_disable_lod : t -> bool -> unit
35
+
(** [set_disable_lod t true] disables distance and horizon culling so all
36
+
satellites are always rendered with full trails. *)
37
+
34
38
(** {1 Satellite management} *)
35
39
36
40
val set_satellites : t -> Globe.Satellite.t list -> unit
+226
-5
test/test_visibility.ml
+226
-5
test/test_visibility.ml
···
47
47
Alcotest.(check int) "2 visible" 2 (List.length visible)
48
48
49
49
let test_lod_full () =
50
+
(* Front satellite with default thresholds: dist = 3.5 - 1.06 = 2.44 < near=4 *)
50
51
let pt = Math.Vec3.create 0. 0. 1.06 in
51
52
Alcotest.(check bool)
52
53
"full" true
53
-
(Visibility.lod ~near:3. ~camera_pos:cam_front pt = Full)
54
+
(Visibility.lod ~camera_pos:cam_front pt = Full)
54
55
55
56
let test_lod_dot_only () =
57
+
(* At distance 6.94 with near=4 far=12: Dot_only *)
56
58
let pt = Math.Vec3.create 0. 0. 1.06 in
57
59
let far_cam = Math.Vec3.create 0. 0. 8. in
58
60
Alcotest.(check bool)
59
61
"dot only" true
60
-
(Visibility.lod ~near:3. ~far:8. ~camera_pos:far_cam pt = Dot_only)
62
+
(Visibility.lod ~camera_pos:far_cam pt = Dot_only)
61
63
62
64
let test_lod_hidden_distance () =
63
65
let pt = Math.Vec3.create 0. 0. 1.06 in
64
66
let very_far = Math.Vec3.create 0. 0. 20. in
65
67
Alcotest.(check bool)
66
68
"hidden far" true
67
-
(Visibility.lod ~near:2. ~far:6. ~camera_pos:very_far pt = Hidden)
69
+
(Visibility.lod ~camera_pos:very_far pt = Hidden)
68
70
69
71
let test_lod_hidden_horizon () =
70
72
let pt = Math.Vec3.create 0. 0. (-1.06) in
···
84
86
]
85
87
in
86
88
let { Visibility.full; dot_only; hidden } =
87
-
Visibility.partition_by_lod ~near:4. ~camera_pos:cam_front ~pos:Fun.id
88
-
points
89
+
Visibility.partition_by_lod ~camera_pos:cam_front ~pos:Fun.id points
89
90
in
90
91
Alcotest.(check int) "full" 2 (List.length full);
91
92
Alcotest.(check int) "dots" 0 (List.length dot_only);
92
93
Alcotest.(check int) "hidden" 1 (List.length hidden)
93
94
95
+
let test_orbit_lod_no_skip () =
96
+
(* A satellite orbiting should never jump Full↔Hidden due to distance alone.
97
+
Full↔Hidden at the horizon boundary is expected (is_visible flips).
98
+
We detect bad skips by checking BOTH endpoints are visible. *)
99
+
let r = 1.1 in
100
+
let bad = ref false in
101
+
let prev = ref Visibility.Full in
102
+
let prev_vis = ref true in
103
+
for i = 0 to 359 do
104
+
let a = Float.of_int i *. Float.pi /. 180. in
105
+
let pt = Math.Vec3.create (r *. sin a) 0. (r *. cos a) in
106
+
let l = Visibility.lod ~camera_pos:cam_front pt in
107
+
let vis = Visibility.is_visible ~camera_pos:cam_front pt in
108
+
(match (!prev, l) with
109
+
| Visibility.Full, Visibility.Hidden when !prev_vis && vis -> bad := true
110
+
| Visibility.Hidden, Visibility.Full when !prev_vis && vis -> bad := true
111
+
| _ -> ());
112
+
prev := l;
113
+
prev_vis := vis
114
+
done;
115
+
Alcotest.(check bool) "no Full↔Hidden while both visible" true (not !bad)
116
+
117
+
let test_zoom_increases_detail () =
118
+
let pt = Math.Vec3.create 0. 0. 1.1 in
119
+
let rank = function Visibility.Full -> 2 | Dot_only -> 1 | Hidden -> 0 in
120
+
let far = Visibility.lod ~camera_pos:(Math.Vec3.create 0. 0. 8.) pt in
121
+
let mid = Visibility.lod ~camera_pos:(Math.Vec3.create 0. 0. 3.) pt in
122
+
let close = Visibility.lod ~camera_pos:(Math.Vec3.create 0. 0. 1.5) pt in
123
+
Alcotest.(check bool) "close >= mid" true (rank close >= rank mid);
124
+
Alcotest.(check bool) "mid >= far" true (rank mid >= rank far)
125
+
126
+
let test_visible_fraction () =
127
+
(* Roughly half the orbit should be visible with threshold -0.2. *)
128
+
let r = 1.1 in
129
+
let n = 360 in
130
+
let vis = ref 0 in
131
+
for i = 0 to n - 1 do
132
+
let a = Float.of_int i *. 2. *. Float.pi /. Float.of_int n in
133
+
let pt = Math.Vec3.create (r *. sin a) 0. (r *. cos a) in
134
+
if Visibility.is_visible ~camera_pos:cam_front pt then incr vis
135
+
done;
136
+
let frac = Float.of_int !vis /. Float.of_int n in
137
+
Alcotest.(check bool)
138
+
(Fmt.str "frac=%.2f in [0.4,0.7]" frac)
139
+
true
140
+
(frac > 0.4 && frac < 0.7)
141
+
142
+
let test_symmetric () =
143
+
let l1 = Visibility.lod ~camera_pos:cam_front (Math.Vec3.create 0.5 0. 1.) in
144
+
let l2 =
145
+
Visibility.lod ~camera_pos:cam_front (Math.Vec3.create (-0.5) 0. 1.)
146
+
in
147
+
Alcotest.(check bool) "symmetric" true (l1 = l2)
148
+
149
+
let test_just_past_horizon () =
150
+
(* (1.1, 0, -0.3): normalized ≈ (0.96, 0, -0.26), dot with (0,0,1) = -0.26 < -0.2 *)
151
+
let pt = Math.Vec3.create 1.1 0. (-0.3) in
152
+
Alcotest.(check bool)
153
+
"just past → hidden" false
154
+
(Visibility.is_visible ~camera_pos:cam_front pt)
155
+
156
+
(* ── Realistic camera distance tests ──────────────────────────────── *)
157
+
158
+
(** Default camera distance from scene.ml/camera.ml. *)
159
+
let default_cam_dist = 3.5
160
+
161
+
(** LEO satellite radius in GL units (Earth radius = 1.0). *)
162
+
let leo_r = 1.1
163
+
164
+
(** Count LOD categories for a full orbit at given camera distance. *)
165
+
let orbit_lod_stats cam_dist =
166
+
let cam = Math.Vec3.create 0. 0. cam_dist in
167
+
let n = 360 in
168
+
let full = ref 0 and dots = ref 0 and hidden = ref 0 in
169
+
for i = 0 to n - 1 do
170
+
let a = Float.of_int i *. 2. *. Float.pi /. Float.of_int n in
171
+
let pt = Math.Vec3.create (leo_r *. sin a) 0. (leo_r *. cos a) in
172
+
match Visibility.lod ~camera_pos:cam pt with
173
+
| Full -> incr full
174
+
| Dot_only -> incr dots
175
+
| Hidden -> incr hidden
176
+
done;
177
+
(!full, !dots, !hidden)
178
+
179
+
let test_default_cam_has_full_trails () =
180
+
(* At default camera distance (3.5), the closest point on a LEO orbit
181
+
is at distance 3.5 - 1.1 = 2.4. With near=2.0 this is Dot_only!
182
+
This test documents the expectation: front satellites SHOULD have
183
+
full trails at the default zoom level. *)
184
+
let full, dots, hidden = orbit_lod_stats default_cam_dist in
185
+
let total = full + dots + hidden in
186
+
let full_pct = 100 * full / total in
187
+
let dots_pct = 100 * dots / total in
188
+
(* At default zoom, we want at least 20% of visible orbit to be Full *)
189
+
Alcotest.(check bool)
190
+
(Fmt.str "full=%d%% dots=%d%% (want >=20%% full)" full_pct dots_pct)
191
+
true (full_pct >= 20)
192
+
193
+
let test_zoomed_in_mostly_full () =
194
+
(* At close zoom (1.8), most of the visible orbit should be Full. *)
195
+
let full, dots, hidden = orbit_lod_stats 1.8 in
196
+
let visible = full + dots in
197
+
let full_pct = if visible > 0 then 100 * full / visible else 0 in
198
+
Alcotest.(check bool)
199
+
(Fmt.str "zoomed in: full=%d%% of visible (want >=70%%)" full_pct)
200
+
true (full_pct >= 70);
201
+
ignore hidden
202
+
203
+
let test_zoomed_out_some_visible () =
204
+
(* At max zoom out (10.0), some satellites should still be visible. *)
205
+
let full, dots, hidden = orbit_lod_stats 10. in
206
+
let visible = full + dots in
207
+
Alcotest.(check bool)
208
+
(Fmt.str "zoomed out: %d visible, %d hidden" visible hidden)
209
+
true (visible > 0)
210
+
211
+
let test_distance_range_at_defaults () =
212
+
(* Document actual distances from default camera to orbit points. *)
213
+
let cam = Math.Vec3.create 0. 0. default_cam_dist in
214
+
let closest_d = default_cam_dist -. leo_r in
215
+
(* front: ~2.4 *)
216
+
let farthest_d = default_cam_dist +. leo_r in
217
+
(* back: ~4.6 *)
218
+
let side_d =
219
+
sqrt ((leo_r *. leo_r) +. (default_cam_dist *. default_cam_dist))
220
+
in
221
+
(* side: ~3.67 *)
222
+
let front = Math.Vec3.create 0. 0. leo_r in
223
+
let side = Math.Vec3.create leo_r 0. 0. in
224
+
let d_front = Math.Vec3.length (Math.Vec3.sub cam front) in
225
+
let d_side = Math.Vec3.length (Math.Vec3.sub cam side) in
226
+
Alcotest.(check (float 0.01)) "front dist" closest_d d_front;
227
+
Alcotest.(check (float 0.01)) "side dist" side_d d_side;
228
+
ignore farthest_d;
229
+
(* The front satellite distance (2.4) should be within the "near" threshold
230
+
for it to get full trails. Current default near=2.0 excludes it! *)
231
+
let l_front = Visibility.lod ~camera_pos:cam front in
232
+
Alcotest.(check bool)
233
+
"front satellite gets trails" true
234
+
(l_front = Visibility.Full)
235
+
236
+
let test_lod_transition_angles () =
237
+
(* At default camera, find the angles where LOD transitions happen.
238
+
This documents the visual experience: at what point on the orbit
239
+
do trails start and stop? *)
240
+
let cam = Math.Vec3.create 0. 0. default_cam_dist in
241
+
let first_full = ref (-1) in
242
+
let last_full = ref (-1) in
243
+
let first_dot = ref (-1) in
244
+
let last_dot = ref (-1) in
245
+
for i = 0 to 359 do
246
+
let a = Float.of_int i *. Float.pi /. 180. in
247
+
let pt = Math.Vec3.create (leo_r *. sin a) 0. (leo_r *. cos a) in
248
+
match Visibility.lod ~camera_pos:cam pt with
249
+
| Visibility.Full ->
250
+
if !first_full = -1 then first_full := i;
251
+
last_full := i
252
+
| Visibility.Dot_only ->
253
+
if !first_dot = -1 then first_dot := i;
254
+
last_dot := i
255
+
| Visibility.Hidden -> ()
256
+
done;
257
+
let full_arc = if !first_full >= 0 then !last_full - !first_full else 0 in
258
+
ignore !first_dot;
259
+
ignore !last_dot;
260
+
(* At default zoom, most of the visible orbit should have full trails *)
261
+
Alcotest.(check bool)
262
+
(Fmt.str "full arc=%d° (want >=120)" full_arc)
263
+
true (full_arc >= 120)
264
+
265
+
let test_meo_geo_visibility () =
266
+
(* MEO satellites (~3.3 GL) and GEO (~6.6 GL) at default camera. *)
267
+
let cam = Math.Vec3.create 0. 0. default_cam_dist in
268
+
let meo = Math.Vec3.create 0. 0. 3.3 in
269
+
let geo = Math.Vec3.create 0. 0. 6.6 in
270
+
let l_meo = Visibility.lod ~camera_pos:cam meo in
271
+
let l_geo = Visibility.lod ~camera_pos:cam geo in
272
+
(* MEO satellite in front should be visible *)
273
+
Alcotest.(check bool) "MEO visible" true (l_meo <> Visibility.Hidden);
274
+
(* GEO satellite might be hidden at default far=6.0 since dist=3.1,
275
+
but it should be visible *)
276
+
Alcotest.(check bool) "GEO visible" true (l_geo <> Visibility.Hidden)
277
+
278
+
let test_cam_position_sensitivity () =
279
+
(* Small camera movements should not cause large LOD changes.
280
+
Move camera by 0.1 and count how many satellites change LOD. *)
281
+
let r = leo_r in
282
+
let n = 360 in
283
+
let cam1 = Math.Vec3.create 0. 0. default_cam_dist in
284
+
let cam2 = Math.Vec3.create 0. 0. (default_cam_dist +. 0.1) in
285
+
let changes = ref 0 in
286
+
for i = 0 to n - 1 do
287
+
let a = Float.of_int i *. 2. *. Float.pi /. Float.of_int n in
288
+
let pt = Math.Vec3.create (r *. sin a) 0. (r *. cos a) in
289
+
let l1 = Visibility.lod ~camera_pos:cam1 pt in
290
+
let l2 = Visibility.lod ~camera_pos:cam2 pt in
291
+
if l1 <> l2 then incr changes
292
+
done;
293
+
(* Small camera move should change LOD for at most ~10% of orbit *)
294
+
let change_pct = 100 * !changes / n in
295
+
Alcotest.(check bool)
296
+
(Fmt.str "camera +0.1: %d%% LOD changes (want <=10%%)" change_pct)
297
+
true (change_pct <= 10)
298
+
94
299
let suite =
95
300
( "visibility",
96
301
[
···
105
310
Alcotest.test_case "lod hidden distance" `Quick test_lod_hidden_distance;
106
311
Alcotest.test_case "lod hidden horizon" `Quick test_lod_hidden_horizon;
107
312
Alcotest.test_case "partition" `Quick test_partition;
313
+
Alcotest.test_case "orbit no skip" `Quick test_orbit_lod_no_skip;
314
+
Alcotest.test_case "zoom detail" `Quick test_zoom_increases_detail;
315
+
Alcotest.test_case "visible fraction" `Quick test_visible_fraction;
316
+
Alcotest.test_case "symmetric" `Quick test_symmetric;
317
+
Alcotest.test_case "just past horizon" `Quick test_just_past_horizon;
318
+
Alcotest.test_case "default cam trails" `Quick
319
+
test_default_cam_has_full_trails;
320
+
Alcotest.test_case "zoomed in mostly full" `Quick
321
+
test_zoomed_in_mostly_full;
322
+
Alcotest.test_case "zoomed out visible" `Quick
323
+
test_zoomed_out_some_visible;
324
+
Alcotest.test_case "distance range" `Quick test_distance_range_at_defaults;
325
+
Alcotest.test_case "transition angles" `Quick test_lod_transition_angles;
326
+
Alcotest.test_case "MEO/GEO visible" `Quick test_meo_geo_visibility;
327
+
Alcotest.test_case "camera sensitivity" `Quick
328
+
test_cam_position_sensitivity;
108
329
] )