Reusable 3D Earth globe widget (pure OCaml + WebGL)
feat(ocaml-globe): add visibility culling and LOD (pure math)
New module Globe.Visibility:
- is_visible: horizon culling via dot product
- lod: Full/Dot_only/Hidden based on distance + visibility
- partition_by_lod: split satellites into detail buckets
11 new tests. 92 native tests passing.
+221
+77
lib/visibility.ml
+77
lib/visibility.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Visibility culling and level-of-detail for satellites on the globe.
7
+
8
+
Determines which satellites are visible from the camera's perspective and at
9
+
what detail level they should be rendered. Pure math. *)
10
+
11
+
(** {1 Horizon culling} *)
12
+
13
+
(** Test if a point on/above the unit sphere is visible from the camera.
14
+
15
+
A point is visible if it's on the camera-facing hemisphere. For points above
16
+
the surface (satellites), we use a slightly relaxed test: the point is
17
+
visible if the angle between the camera direction and the point's surface
18
+
normal is less than ~100° (to include satellites just past the horizon that
19
+
are above the surface).
20
+
21
+
[camera_pos]: camera position in GL coordinates. [point]: satellite position
22
+
in GL coordinates. *)
23
+
let is_visible ~camera_pos point =
24
+
let to_point = Math.Vec3.sub point Math.Vec3.zero in
25
+
let to_camera = Math.Vec3.sub camera_pos Math.Vec3.zero in
26
+
(* Dot product of point normal (= point direction from origin)
27
+
with camera direction from origin *)
28
+
let d =
29
+
Math.Vec3.dot (Math.Vec3.normalize to_point) (Math.Vec3.normalize to_camera)
30
+
in
31
+
(* Visible if on the same hemisphere as camera.
32
+
Threshold -0.2 allows satellites slightly past the horizon
33
+
(they're above the surface so still geometrically visible). *)
34
+
d > -0.2
35
+
36
+
(** Filter a list keeping only visible elements. *)
37
+
let filter_visible ~camera_pos positions =
38
+
List.filter (is_visible ~camera_pos) positions
39
+
40
+
(** Filter with indices preserved. Returns [(index, position)] pairs. *)
41
+
let filter_visible_indexed ~camera_pos positions =
42
+
List.filteri (fun _i pos -> is_visible ~camera_pos pos) positions
43
+
44
+
(** {1 Level of detail} *)
45
+
46
+
type lod = Full | Dot_only | Hidden
47
+
48
+
(** Determine LOD for a satellite based on distance from camera.
49
+
50
+
- [Full]: trails + dot + coverage (distance < [near])
51
+
- [Dot_only]: just the position dot (distance < [far])
52
+
- [Hidden]: not rendered (distance >= [far] or behind horizon) *)
53
+
let lod_of_distance ~near ~far distance =
54
+
if distance < near then Full else if distance < far then Dot_only else Hidden
55
+
56
+
(** Compute LOD for a satellite position.
57
+
58
+
[camera_pos]: camera position in GL coordinates. [point]: satellite position
59
+
in GL coordinates. [near]: distance threshold for full detail (default 2.0).
60
+
[far]: distance threshold for dot-only (default 6.0). *)
61
+
let lod ?(near = 2.0) ?(far = 6.0) ~camera_pos point =
62
+
if not (is_visible ~camera_pos point) then Hidden
63
+
else
64
+
let d = Math.Vec3.length (Math.Vec3.sub camera_pos point) in
65
+
lod_of_distance ~near ~far d
66
+
67
+
(** Partition satellites by LOD. Returns [(full, dot_only, hidden)]. *)
68
+
let partition_by_lod ?(near = 2.0) ?(far = 6.0) ~camera_pos positions =
69
+
let full = ref [] and dots = ref [] and hidden = ref [] in
70
+
List.iteri
71
+
(fun i pos ->
72
+
match lod ~near ~far ~camera_pos pos with
73
+
| Full -> full := (i, pos) :: !full
74
+
| Dot_only -> dots := (i, pos) :: !dots
75
+
| Hidden -> hidden := (i, pos) :: !hidden)
76
+
positions;
77
+
(List.rev !full, List.rev !dots, List.rev !hidden)
+32
lib/visibility.mli
+32
lib/visibility.mli
···
1
+
(** Visibility culling and level-of-detail for satellites on the globe.
2
+
3
+
Pure math for determining which satellites are visible and at what detail
4
+
level to render them. *)
5
+
6
+
(** {1 Horizon culling} *)
7
+
8
+
val is_visible : camera_pos:Math.Vec3.t -> Math.Vec3.t -> bool
9
+
(** [is_visible ~camera_pos point] is [true] if [point] is on the camera-facing
10
+
hemisphere (with margin for above-surface objects). *)
11
+
12
+
val filter_visible :
13
+
camera_pos:Math.Vec3.t -> Math.Vec3.t list -> Math.Vec3.t list
14
+
(** [filter_visible ~camera_pos positions] keeps only visible positions. *)
15
+
16
+
(** {1 Level of detail} *)
17
+
18
+
type lod = Full | Dot_only | Hidden (** Rendering detail level. *)
19
+
20
+
val lod :
21
+
?near:float -> ?far:float -> camera_pos:Math.Vec3.t -> Math.Vec3.t -> lod
22
+
(** [lod ?near ?far ~camera_pos point] determines the detail level. [near]
23
+
(default 2.0) and [far] (default 6.0) are distance thresholds. *)
24
+
25
+
val partition_by_lod :
26
+
?near:float ->
27
+
?far:float ->
28
+
camera_pos:Math.Vec3.t ->
29
+
Math.Vec3.t list ->
30
+
(int * Math.Vec3.t) list * (int * Math.Vec3.t) list * (int * Math.Vec3.t) list
31
+
(** [partition_by_lod ~camera_pos positions] returns [(full, dot_only, hidden)]
32
+
with original indices preserved. *)
+1
test/test.ml
+1
test/test.ml
+109
test/test_visibility.ml
+109
test/test_visibility.ml
···
1
+
(** Visibility culling and LOD tests. *)
2
+
3
+
open Globe
4
+
5
+
let cam_front = Math.Vec3.create 0. 0. 3.5
6
+
let cam_above = Math.Vec3.create 0. 3.5 0.
7
+
8
+
let test_visible_front () =
9
+
let pt = Math.Vec3.create 0. 0. 1.06 in
10
+
Alcotest.(check bool)
11
+
"front visible" true
12
+
(Visibility.is_visible ~camera_pos:cam_front pt)
13
+
14
+
let test_hidden_back () =
15
+
let pt = Math.Vec3.create 0. 0. (-1.06) in
16
+
Alcotest.(check bool)
17
+
"back hidden" false
18
+
(Visibility.is_visible ~camera_pos:cam_front pt)
19
+
20
+
let test_visible_side () =
21
+
let pt = Math.Vec3.create 1.06 0. 0. in
22
+
Alcotest.(check bool)
23
+
"side visible" true
24
+
(Visibility.is_visible ~camera_pos:cam_front pt)
25
+
26
+
let test_visible_above () =
27
+
let pt = Math.Vec3.create 0. 1.06 0. in
28
+
Alcotest.(check bool)
29
+
"top from above" true
30
+
(Visibility.is_visible ~camera_pos:cam_above pt)
31
+
32
+
let test_hidden_below () =
33
+
let pt = Math.Vec3.create 0. (-1.06) 0. in
34
+
Alcotest.(check bool)
35
+
"bottom from above" false
36
+
(Visibility.is_visible ~camera_pos:cam_above pt)
37
+
38
+
let test_filter_visible () =
39
+
let points =
40
+
[
41
+
Math.Vec3.create 0. 0. 1.06;
42
+
Math.Vec3.create 0. 0. (-1.06);
43
+
Math.Vec3.create 1.06 0. 0.;
44
+
]
45
+
in
46
+
let visible = Visibility.filter_visible ~camera_pos:cam_front points in
47
+
Alcotest.(check int) "2 visible" 2 (List.length visible)
48
+
49
+
let test_lod_full () =
50
+
let pt = Math.Vec3.create 0. 0. 1.06 in
51
+
Alcotest.(check bool)
52
+
"full" true
53
+
(Visibility.lod ~near:3. ~camera_pos:cam_front pt = Full)
54
+
55
+
let test_lod_dot_only () =
56
+
let pt = Math.Vec3.create 0. 0. 1.06 in
57
+
let far_cam = Math.Vec3.create 0. 0. 8. in
58
+
Alcotest.(check bool)
59
+
"dot only" true
60
+
(Visibility.lod ~near:3. ~far:8. ~camera_pos:far_cam pt = Dot_only)
61
+
62
+
let test_lod_hidden_distance () =
63
+
let pt = Math.Vec3.create 0. 0. 1.06 in
64
+
let very_far = Math.Vec3.create 0. 0. 20. in
65
+
Alcotest.(check bool)
66
+
"hidden far" true
67
+
(Visibility.lod ~near:2. ~far:6. ~camera_pos:very_far pt = Hidden)
68
+
69
+
let test_lod_hidden_horizon () =
70
+
let pt = Math.Vec3.create 0. 0. (-1.06) in
71
+
Alcotest.(check bool)
72
+
"hidden back" true
73
+
(Visibility.lod ~camera_pos:cam_front pt = Hidden)
74
+
75
+
let test_partition () =
76
+
let points =
77
+
[
78
+
Math.Vec3.create 0. 0. 1.06;
79
+
(* close, visible → Full *)
80
+
Math.Vec3.create 0. 0. (-1.06);
81
+
(* back → Hidden *)
82
+
Math.Vec3.create 1.06 0. 0.;
83
+
(* side, visible → Full *)
84
+
]
85
+
in
86
+
let full, dots, hidden =
87
+
Visibility.partition_by_lod ~near:4. ~camera_pos:cam_front points
88
+
in
89
+
Alcotest.(check int) "full" 2 (List.length full);
90
+
Alcotest.(check int) "dots" 0 (List.length dots);
91
+
Alcotest.(check int) "hidden" 1 (List.length hidden);
92
+
let idx, _ = List.hd hidden in
93
+
Alcotest.(check int) "hidden idx" 1 idx
94
+
95
+
let suite =
96
+
( "visibility",
97
+
[
98
+
Alcotest.test_case "visible front" `Quick test_visible_front;
99
+
Alcotest.test_case "hidden back" `Quick test_hidden_back;
100
+
Alcotest.test_case "visible side" `Quick test_visible_side;
101
+
Alcotest.test_case "visible above" `Quick test_visible_above;
102
+
Alcotest.test_case "hidden below" `Quick test_hidden_below;
103
+
Alcotest.test_case "filter visible" `Quick test_filter_visible;
104
+
Alcotest.test_case "lod full" `Quick test_lod_full;
105
+
Alcotest.test_case "lod dot only" `Quick test_lod_dot_only;
106
+
Alcotest.test_case "lod hidden distance" `Quick test_lod_hidden_distance;
107
+
Alcotest.test_case "lod hidden horizon" `Quick test_lod_hidden_horizon;
108
+
Alcotest.test_case "partition" `Quick test_partition;
109
+
] )