Reusable 3D Earth globe widget (pure OCaml + WebGL)
feat(ocaml-globe): add grid overlay, coverage footprints, and geometry module
New modules in ocaml-globe:
- Globe.Geometry: pure-math footprint angles, grid line generation,
circle-on-sphere construction (10 native tests)
- Globe_webgl.Grid: lat/lon grid overlay renderer
- Globe_webgl.Coverage: satellite ground footprint circles
- Globe_webgl.Camera: add pp function
All pure geometry is in lib/ (testable natively), WebGL renderers in
webgl/ (tested via Node.js with js_of_ocaml). 25 native + 13 Node.js
tests passing.
+659
-1
+103
lib/geometry.ml
+103
lib/geometry.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Globe geometry computations (pure math, no WebGL). *)
7
+
8
+
let pi = Float.pi
9
+
10
+
(** Satellite ground footprint half-angle (radians).
11
+
12
+
Given a satellite at [altitude] km and a minimum elevation angle
13
+
[min_elevation] radians, returns the angular radius of the
14
+
ground footprint circle.
15
+
16
+
From geometry: rho = asin(R / (R + h)),
17
+
half_angle = pi/2 - elevation - rho. *)
18
+
let footprint_angle ~altitude ~min_elevation =
19
+
let r = Coordinate.earth_radius in
20
+
let rho = asin (r /. (r +. altitude)) in
21
+
(pi /. 2.) -. min_elevation -. rho
22
+
23
+
(** Generate lat/lon grid line vertices on the unit sphere.
24
+
25
+
Returns pairs of (x,y,z) endpoints in GL coordinates
26
+
(Y=up). [spacing] is degrees between lines. *)
27
+
let grid_lines ?(spacing = 30.) ?(segments = 72) () =
28
+
let deg_to_rad d = d *. pi /. 180. in
29
+
let vertices = ref [] in
30
+
let r = 1.002 in
31
+
let lat = ref (-.90. +. spacing) in
32
+
while !lat < 90. do
33
+
let lat_rad = deg_to_rad !lat in
34
+
let cos_lat = cos lat_rad and sin_lat = sin lat_rad in
35
+
for i = 0 to segments - 1 do
36
+
let lon0 = Float.of_int i *. 2. *. pi /. Float.of_int segments in
37
+
let lon1 =
38
+
Float.of_int (i + 1) *. 2. *. pi /. Float.of_int segments
39
+
in
40
+
vertices :=
41
+
Math.Vec3.create
42
+
(r *. cos_lat *. cos lon0) (r *. sin_lat)
43
+
(r *. cos_lat *. sin lon0)
44
+
:: Math.Vec3.create
45
+
(r *. cos_lat *. cos lon1) (r *. sin_lat)
46
+
(r *. cos_lat *. sin lon1)
47
+
:: !vertices
48
+
done;
49
+
lat := !lat +. spacing
50
+
done;
51
+
let lon = ref (-.180.) in
52
+
while !lon < 180. do
53
+
let lon_rad = deg_to_rad !lon in
54
+
for i = 0 to segments - 1 do
55
+
let lat0 =
56
+
-.pi /. 2. +. (Float.of_int i *. pi /. Float.of_int segments)
57
+
in
58
+
let lat1 =
59
+
-.pi /. 2.
60
+
+. (Float.of_int (i + 1) *. pi /. Float.of_int segments)
61
+
in
62
+
vertices :=
63
+
Math.Vec3.create
64
+
(r *. cos lat0 *. cos lon_rad) (r *. sin lat0)
65
+
(r *. cos lat0 *. sin lon_rad)
66
+
:: Math.Vec3.create
67
+
(r *. cos lat1 *. cos lon_rad) (r *. sin lat1)
68
+
(r *. cos lat1 *. sin lon_rad)
69
+
:: !vertices
70
+
done;
71
+
lon := !lon +. spacing
72
+
done;
73
+
List.rev !vertices
74
+
75
+
(** Generate a circle of points on the unit sphere around [center].
76
+
77
+
[center] is a GL-coordinate unit vector. [half_angle] is the
78
+
angular radius in radians. Returns [segments] pairs of line
79
+
endpoints. *)
80
+
let circle_on_sphere center ~half_angle ~segments =
81
+
let open Math.Vec3 in
82
+
let n = normalize center in
83
+
let arbitrary =
84
+
if abs_float n.y < 0.9 then create 0. 1. 0. else create 1. 0. 0.
85
+
in
86
+
let u = normalize (cross n arbitrary) in
87
+
let v = cross n u in
88
+
let cos_a = cos half_angle and sin_a = sin half_angle in
89
+
let r = 1.003 in
90
+
let verts = ref [] in
91
+
for i = 0 to segments - 1 do
92
+
let t0 = Float.of_int i *. 2. *. pi /. Float.of_int segments in
93
+
let t1 = Float.of_int (i + 1) *. 2. *. pi /. Float.of_int segments in
94
+
let point t =
95
+
let ct = cos t and st = sin t in
96
+
create
97
+
(r *. ((cos_a *. n.x) +. (sin_a *. ct *. u.x) +. (sin_a *. st *. v.x)))
98
+
(r *. ((cos_a *. n.y) +. (sin_a *. ct *. u.y) +. (sin_a *. st *. v.y)))
99
+
(r *. ((cos_a *. n.z) +. (sin_a *. ct *. u.z) +. (sin_a *. st *. v.z)))
100
+
in
101
+
verts := point t0 :: point t1 :: !verts
102
+
done;
103
+
List.rev !verts
+20
lib/geometry.mli
+20
lib/geometry.mli
···
1
+
(** Globe geometry computations (pure math, no WebGL).
2
+
3
+
Footprint angles, grid line generation, and circle-on-sphere
4
+
construction — all testable without a GL context. *)
5
+
6
+
val footprint_angle : altitude:float -> min_elevation:float -> float
7
+
(** [footprint_angle ~altitude ~min_elevation] computes the ground
8
+
footprint half-angle (radians) for a satellite at [altitude] km
9
+
with minimum elevation angle [min_elevation] radians. *)
10
+
11
+
val grid_lines :
12
+
?spacing:float -> ?segments:int -> unit -> Math.Vec3.t list
13
+
(** [grid_lines ?spacing ?segments ()] generates lat/lon grid line
14
+
endpoints on the unit sphere. Returns pairs of vertices for
15
+
GL_LINES. [spacing] defaults to 30°. *)
16
+
17
+
val circle_on_sphere :
18
+
Math.Vec3.t -> half_angle:float -> segments:int -> Math.Vec3.t list
19
+
(** [circle_on_sphere center ~half_angle ~segments] generates a circle
20
+
of line endpoints on the unit sphere around [center]. *)
+6
-1
test/test.ml
+6
-1
test/test.ml
+121
test/test_geometry.ml
+121
test/test_geometry.ml
···
1
+
(** Geometry computation tests.
2
+
3
+
Test vectors for footprint angles, grid generation,
4
+
and circle-on-sphere construction. *)
5
+
6
+
open Globe
7
+
8
+
let eps = 1e-3
9
+
10
+
let check_float msg expected actual =
11
+
Alcotest.(check (float eps)) msg expected actual
12
+
13
+
(* --- Footprint angle --- *)
14
+
15
+
(** ISS at 408 km, 0° elevation: footprint ~21°. *)
16
+
let test_footprint_iss () =
17
+
let angle = Geometry.footprint_angle ~altitude:408. ~min_elevation:0. in
18
+
let deg = angle *. 180. /. Float.pi in
19
+
Alcotest.(check bool) "ISS footprint ~21°" true (deg > 18. && deg < 25.)
20
+
21
+
(** GEO at 35786 km, 0° elevation: footprint ~81°. *)
22
+
let test_footprint_geo () =
23
+
let angle = Geometry.footprint_angle ~altitude:35786. ~min_elevation:0. in
24
+
let deg = angle *. 180. /. Float.pi in
25
+
Alcotest.(check bool) "GEO footprint ~81°" true (deg > 78. && deg < 84.)
26
+
27
+
(** Higher elevation → smaller footprint. *)
28
+
let test_footprint_elevation () =
29
+
let a0 = Geometry.footprint_angle ~altitude:408. ~min_elevation:0. in
30
+
let a10 =
31
+
Geometry.footprint_angle ~altitude:408.
32
+
~min_elevation:(10. *. Float.pi /. 180.)
33
+
in
34
+
Alcotest.(check bool) "elevation reduces footprint" true (a10 < a0)
35
+
36
+
(** Zero altitude → zero footprint. *)
37
+
let test_footprint_surface () =
38
+
let angle = Geometry.footprint_angle ~altitude:0. ~min_elevation:0. in
39
+
check_float "surface footprint" 0. angle
40
+
41
+
(* --- Grid lines --- *)
42
+
43
+
(** Grid generation produces non-empty output. *)
44
+
let test_grid_nonempty () =
45
+
let verts = Geometry.grid_lines ~spacing:30. () in
46
+
Alcotest.(check bool) "non-empty" true (List.length verts > 100)
47
+
48
+
(** Grid vertices come in pairs (for GL_LINES). *)
49
+
let test_grid_even () =
50
+
let verts = Geometry.grid_lines ~spacing:45. () in
51
+
Alcotest.(check bool) "even count" true (List.length verts mod 2 = 0)
52
+
53
+
(** Grid vertices are near unit sphere. *)
54
+
let test_grid_radius () =
55
+
let verts = Geometry.grid_lines ~spacing:90. ~segments:8 () in
56
+
List.iter
57
+
(fun (v : Math.Vec3.t) ->
58
+
let r = Math.Vec3.length v in
59
+
Alcotest.(check bool) "near unit sphere" true
60
+
(r > 0.99 && r < 1.01))
61
+
verts
62
+
63
+
(* --- Circle on sphere --- *)
64
+
65
+
(** Circle around north pole (0,1,0) with small angle. *)
66
+
let test_circle_pole () =
67
+
let center = Math.Vec3.create 0. 1. 0. in
68
+
let verts =
69
+
Geometry.circle_on_sphere center
70
+
~half_angle:(10. *. Float.pi /. 180.) ~segments:16
71
+
in
72
+
Alcotest.(check int) "32 vertices" 32 (List.length verts);
73
+
(* All points should be near the top of the sphere *)
74
+
List.iter
75
+
(fun (v : Math.Vec3.t) ->
76
+
Alcotest.(check bool) "near top" true (v.y > 0.9))
77
+
verts
78
+
79
+
(** Circle around equator point. *)
80
+
let test_circle_equator () =
81
+
let center = Math.Vec3.create 1. 0. 0. in
82
+
let verts =
83
+
Geometry.circle_on_sphere center
84
+
~half_angle:(5. *. Float.pi /. 180.) ~segments:16
85
+
in
86
+
(* All points should be near x=1 *)
87
+
List.iter
88
+
(fun (v : Math.Vec3.t) ->
89
+
Alcotest.(check bool) "near x=1" true (v.x > 0.9))
90
+
verts
91
+
92
+
(** Circle vertices are near unit sphere. *)
93
+
let test_circle_radius () =
94
+
let center = Math.Vec3.create 0.5 0.5 0.707 in
95
+
let center = Math.Vec3.normalize center in
96
+
let verts =
97
+
Geometry.circle_on_sphere center
98
+
~half_angle:(20. *. Float.pi /. 180.) ~segments:24
99
+
in
100
+
List.iter
101
+
(fun (v : Math.Vec3.t) ->
102
+
let r = Math.Vec3.length v in
103
+
Alcotest.(check bool) "near unit sphere" true
104
+
(r > 0.99 && r < 1.01))
105
+
verts
106
+
107
+
let suite =
108
+
( "geometry",
109
+
[
110
+
Alcotest.test_case "footprint ISS" `Quick test_footprint_iss;
111
+
Alcotest.test_case "footprint GEO" `Quick test_footprint_geo;
112
+
Alcotest.test_case "footprint elevation" `Quick
113
+
test_footprint_elevation;
114
+
Alcotest.test_case "footprint surface" `Quick test_footprint_surface;
115
+
Alcotest.test_case "grid non-empty" `Quick test_grid_nonempty;
116
+
Alcotest.test_case "grid even" `Quick test_grid_even;
117
+
Alcotest.test_case "grid radius" `Quick test_grid_radius;
118
+
Alcotest.test_case "circle pole" `Quick test_circle_pole;
119
+
Alcotest.test_case "circle equator" `Quick test_circle_equator;
120
+
Alcotest.test_case "circle radius" `Quick test_circle_radius;
121
+
] )
+2
test/test_geometry.mli
+2
test/test_geometry.mli
+6
test/webgl/dune
+6
test/webgl/dune
+11
test/webgl/test.ml
+11
test/webgl/test.ml
+46
test/webgl/test_camera.ml
+46
test/webgl/test_camera.ml
···
1
+
(** Camera logic tests (runs under Node.js, no DOM required). *)
2
+
3
+
let eps = 1e-6
4
+
5
+
let check_float msg expected actual =
6
+
Alcotest.(check (float eps)) msg expected actual
7
+
8
+
let test_default () =
9
+
let cam = Globe_webgl.Camera.v () in
10
+
check_float "theta" 0. cam.theta;
11
+
check_float "phi" 0.3 cam.phi;
12
+
check_float "distance" 3.5 cam.distance;
13
+
Alcotest.(check bool) "auto_rotate" true cam.auto_rotate
14
+
15
+
let test_look_at () =
16
+
let cam = Globe_webgl.Camera.v () in
17
+
Globe_webgl.Camera.look_at_position cam
18
+
(Globe.Math.Vec3.create 1. 0. 0.);
19
+
check_float "theta" (Float.pi /. 2.) cam.theta;
20
+
check_float "phi" 0. cam.phi
21
+
22
+
let test_auto_rotate () =
23
+
let cam = Globe_webgl.Camera.v () in
24
+
let t0 = cam.theta in
25
+
Globe_webgl.Camera.update cam 1.;
26
+
Alcotest.(check bool) "theta increased" true (cam.theta > t0)
27
+
28
+
let test_view_matrix () =
29
+
let cam = Globe_webgl.Camera.v () in
30
+
let m = Globe_webgl.Camera.view_matrix cam in
31
+
Alcotest.(check int) "16 elements" 16 (Array.length m)
32
+
33
+
let test_pp () =
34
+
let cam = Globe_webgl.Camera.v () in
35
+
let s = Fmt.str "%a" Globe_webgl.Camera.pp cam in
36
+
Alcotest.(check bool) "pp non-empty" true (String.length s > 10)
37
+
38
+
let suite =
39
+
( "camera",
40
+
[
41
+
Alcotest.test_case "default" `Quick test_default;
42
+
Alcotest.test_case "look at" `Quick test_look_at;
43
+
Alcotest.test_case "auto rotate" `Quick test_auto_rotate;
44
+
Alcotest.test_case "view matrix" `Quick test_view_matrix;
45
+
Alcotest.test_case "pp" `Quick test_pp;
46
+
] )
+2
test/webgl/test_camera.mli
+2
test/webgl/test_camera.mli
+18
test/webgl/test_coverage.ml
+18
test/webgl/test_coverage.ml
···
1
+
(** Coverage renderer tests (uses pure Geometry under the hood). *)
2
+
3
+
let test_footprint () =
4
+
let angle = Globe.Geometry.footprint_angle ~altitude:408. ~min_elevation:0. in
5
+
Alcotest.(check bool) "positive angle" true (angle > 0.)
6
+
7
+
let test_circle () =
8
+
let center = Globe.Math.Vec3.create 0. 1. 0. in
9
+
let verts = Globe.Geometry.circle_on_sphere center
10
+
~half_angle:0.1 ~segments:8 in
11
+
Alcotest.(check int) "16 vertices" 16 (List.length verts)
12
+
13
+
let suite =
14
+
( "coverage",
15
+
[
16
+
Alcotest.test_case "footprint" `Quick test_footprint;
17
+
Alcotest.test_case "circle" `Quick test_circle;
18
+
] )
+2
test/webgl/test_coverage.mli
+2
test/webgl/test_coverage.mli
+8
test/webgl/test_earth.ml
+8
test/webgl/test_earth.ml
···
1
+
(** Earth renderer tests (no GL context, checks inputs). *)
2
+
3
+
let test_sphere_input () =
4
+
let points = Globe.Sphere.generate_cloud ~num_points:100 in
5
+
Alcotest.(check int) "100 points" 100 (Array.length points)
6
+
7
+
let suite =
8
+
("earth", [ Alcotest.test_case "sphere input" `Quick test_sphere_input ])
+2
test/webgl/test_earth.mli
+2
test/webgl/test_earth.mli
+8
test/webgl/test_grid.ml
+8
test/webgl/test_grid.ml
···
1
+
(** Grid renderer tests (uses pure Geometry under the hood). *)
2
+
3
+
let test_geometry_used () =
4
+
let lines = Globe.Geometry.grid_lines ~spacing:90. () in
5
+
Alcotest.(check bool) "grid lines" true (List.length lines > 0)
6
+
7
+
let suite =
8
+
("grid", [ Alcotest.test_case "geometry" `Quick test_geometry_used ])
+2
test/webgl/test_grid.mli
+2
test/webgl/test_grid.mli
+10
test/webgl/test_orbit.ml
+10
test/webgl/test_orbit.ml
···
1
+
(** Orbit renderer tests (type accessibility). *)
2
+
3
+
let test_dot_type () =
4
+
let dot : Globe_webgl.Orbit.dot =
5
+
{ pos = Globe.Math.Vec3.create 1. 0. 0.; color = (1., 1., 1.) }
6
+
in
7
+
Alcotest.(check bool) "dot created" true (dot.pos.x > 0.)
8
+
9
+
let suite =
10
+
("orbit", [ Alcotest.test_case "dot type" `Quick test_dot_type ])
+2
test/webgl/test_orbit.mli
+2
test/webgl/test_orbit.mli
+26
test/webgl/test_shader.ml
+26
test/webgl/test_shader.ml
···
1
+
(** Shader source string tests (runs under Node.js). *)
2
+
3
+
let has_prefix ~prefix s =
4
+
String.length s >= String.length prefix
5
+
&& String.sub s 0 (String.length prefix) = prefix
6
+
7
+
let test_earth_shaders () =
8
+
Alcotest.(check bool) "vert non-empty" true
9
+
(String.length Globe_webgl.Shader.earth_vertex > 50);
10
+
Alcotest.(check bool) "frag non-empty" true
11
+
(String.length Globe_webgl.Shader.earth_fragment > 50);
12
+
Alcotest.(check bool) "vert version" true
13
+
(has_prefix ~prefix:"#version" Globe_webgl.Shader.earth_vertex)
14
+
15
+
let test_star_shaders () =
16
+
Alcotest.(check bool) "vert non-empty" true
17
+
(String.length Globe_webgl.Shader.star_vertex > 50);
18
+
Alcotest.(check bool) "frag non-empty" true
19
+
(String.length Globe_webgl.Shader.star_fragment > 50)
20
+
21
+
let suite =
22
+
( "shader",
23
+
[
24
+
Alcotest.test_case "earth shaders" `Quick test_earth_shaders;
25
+
Alcotest.test_case "star shaders" `Quick test_star_shaders;
26
+
] )
+2
test/webgl/test_shader.mli
+2
test/webgl/test_shader.mli
+7
test/webgl/test_stars.ml
+7
test/webgl/test_stars.ml
+2
test/webgl/test_stars.mli
+2
test/webgl/test_stars.mli
+3
webgl/camera.ml
+3
webgl/camera.ml
+3
webgl/camera.mli
+3
webgl/camera.mli
+111
webgl/coverage.ml
+111
webgl/coverage.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Satellite ground coverage rendering.
7
+
8
+
Uses {!Globe.Geometry} for circle generation. *)
9
+
10
+
open Brr
11
+
open Brr_canvas
12
+
13
+
let vert =
14
+
{|#version 300 es
15
+
precision highp float;
16
+
layout(location = 0) in vec3 a_position;
17
+
layout(location = 1) in vec3 a_color;
18
+
uniform mat4 u_projection;
19
+
uniform mat4 u_view;
20
+
out vec3 v_color;
21
+
void main() {
22
+
gl_Position = u_projection * u_view * vec4(a_position, 1.0);
23
+
v_color = a_color;
24
+
}
25
+
|}
26
+
27
+
let frag =
28
+
{|#version 300 es
29
+
precision highp float;
30
+
in vec3 v_color;
31
+
uniform float u_alpha;
32
+
out vec4 fragColor;
33
+
void main() { fragColor = vec4(v_color, u_alpha); }
34
+
|}
35
+
36
+
type footprint = {
37
+
pos : Globe.Math.Vec3.t;
38
+
color : float * float * float;
39
+
half_angle : float;
40
+
}
41
+
42
+
type t = {
43
+
prog : Gl.program;
44
+
vao : Gl.vertex_array_object;
45
+
vbo : Gl.buffer;
46
+
mutable num_vertices : int;
47
+
u_proj : Gl.uniform_location;
48
+
u_view : Gl.uniform_location;
49
+
u_alpha : Gl.uniform_location;
50
+
}
51
+
52
+
let v gl =
53
+
let prog = Shader.program gl ~vert ~frag in
54
+
let vao = Gl.create_vertex_array gl in
55
+
let vbo = Gl.create_buffer gl in
56
+
Gl.bind_vertex_array gl (Some vao);
57
+
Gl.bind_buffer gl Gl.array_buffer (Some vbo);
58
+
Gl.enable_vertex_attrib_array gl 0;
59
+
Gl.vertex_attrib_pointer gl 0 3 Gl.float false 24 0;
60
+
Gl.enable_vertex_attrib_array gl 1;
61
+
Gl.vertex_attrib_pointer gl 1 3 Gl.float false 24 12;
62
+
Gl.bind_vertex_array gl None;
63
+
let u name = Gl.get_uniform_location gl prog (Jstr.of_string name) in
64
+
{
65
+
prog; vao; vbo; num_vertices = 0;
66
+
u_proj = u "u_projection"; u_view = u "u_view"; u_alpha = u "u_alpha";
67
+
}
68
+
69
+
let load gl t (footprints : footprint list) =
70
+
if footprints = [] then t.num_vertices <- 0
71
+
else begin
72
+
let all_verts =
73
+
List.concat_map
74
+
(fun (fp : footprint) ->
75
+
let center = Globe.Math.Vec3.normalize fp.pos in
76
+
let r, g, b = fp.color in
77
+
Globe.Geometry.circle_on_sphere center
78
+
~half_angle:fp.half_angle ~segments:48
79
+
|> List.map (fun (v : Globe.Math.Vec3.t) -> (v, r, g, b)))
80
+
footprints
81
+
in
82
+
let n = List.length all_verts in
83
+
let data = Array.make (n * 6) 0. in
84
+
List.iteri
85
+
(fun i ((v : Globe.Math.Vec3.t), r, g, b) ->
86
+
let off = i * 6 in
87
+
data.(off) <- v.x;
88
+
data.(off + 1) <- v.y;
89
+
data.(off + 2) <- v.z;
90
+
data.(off + 3) <- r;
91
+
data.(off + 4) <- g;
92
+
data.(off + 5) <- b)
93
+
all_verts;
94
+
let buf = Tarray.of_float_array Tarray.Float32 data in
95
+
Gl.bind_buffer gl Gl.array_buffer (Some t.vbo);
96
+
Gl.buffer_data gl Gl.array_buffer buf Gl.dynamic_draw;
97
+
t.num_vertices <- n
98
+
end
99
+
100
+
let draw gl t ~projection ~view ?(alpha = 0.25) () =
101
+
if t.num_vertices > 0 then begin
102
+
Gl.use_program gl t.prog;
103
+
Gl.uniform_matrix4fv gl t.u_proj false
104
+
(Tarray.of_float_array Tarray.Float32 projection);
105
+
Gl.uniform_matrix4fv gl t.u_view false
106
+
(Tarray.of_float_array Tarray.Float32 view);
107
+
Gl.uniform1f gl t.u_alpha alpha;
108
+
Gl.bind_vertex_array gl (Some t.vao);
109
+
Gl.draw_arrays gl Gl.lines 0 t.num_vertices;
110
+
Gl.bind_vertex_array gl None
111
+
end
+33
webgl/coverage.mli
+33
webgl/coverage.mli
···
1
+
(** Satellite ground coverage (footprint) rendering.
2
+
3
+
Draws circles on the globe representing what a satellite can see
4
+
from its position. Footprint size depends on altitude and minimum
5
+
elevation angle. *)
6
+
7
+
type footprint = {
8
+
pos : Globe.Math.Vec3.t;
9
+
color : float * float * float;
10
+
half_angle : float;
11
+
}
12
+
(** A ground footprint: satellite GL position, color, and angular radius
13
+
(radians) on the unit sphere. *)
14
+
15
+
type t
16
+
(** Opaque coverage renderer state. *)
17
+
18
+
val v : Brr_canvas.Gl.t -> t
19
+
(** [v gl] creates a coverage renderer. *)
20
+
21
+
val load : Brr_canvas.Gl.t -> t -> footprint list -> unit
22
+
(** [load gl t footprints] uploads footprint circles for rendering. *)
23
+
24
+
val draw :
25
+
Brr_canvas.Gl.t ->
26
+
t ->
27
+
projection:float array ->
28
+
view:float array ->
29
+
?alpha:float ->
30
+
unit ->
31
+
unit
32
+
(** [draw gl t ~projection ~view ?alpha ()] renders all loaded footprints.
33
+
Default alpha is [0.25]. *)
+80
webgl/grid.ml
+80
webgl/grid.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Latitude/longitude grid overlay on the globe.
7
+
8
+
Uses {!Globe.Geometry.grid_lines} for vertex generation. *)
9
+
10
+
open Brr
11
+
open Brr_canvas
12
+
13
+
let vert =
14
+
{|#version 300 es
15
+
precision highp float;
16
+
layout(location = 0) in vec3 a_position;
17
+
uniform mat4 u_projection;
18
+
uniform mat4 u_view;
19
+
void main() { gl_Position = u_projection * u_view * vec4(a_position, 1.0); }
20
+
|}
21
+
22
+
let frag =
23
+
{|#version 300 es
24
+
precision highp float;
25
+
uniform vec3 u_color;
26
+
uniform float u_alpha;
27
+
out vec4 fragColor;
28
+
void main() { fragColor = vec4(u_color, u_alpha); }
29
+
|}
30
+
31
+
type t = {
32
+
prog : Gl.program;
33
+
vao : Gl.vertex_array_object;
34
+
num_vertices : int;
35
+
u_proj : Gl.uniform_location;
36
+
u_view : Gl.uniform_location;
37
+
u_color : Gl.uniform_location;
38
+
u_alpha : Gl.uniform_location;
39
+
}
40
+
41
+
let v ?(spacing = 30.) gl =
42
+
let verts = Globe.Geometry.grid_lines ~spacing () in
43
+
let n = List.length verts in
44
+
let data = Array.make (n * 3) 0. in
45
+
List.iteri
46
+
(fun i (v : Globe.Math.Vec3.t) ->
47
+
data.(i * 3) <- v.x;
48
+
data.((i * 3) + 1) <- v.y;
49
+
data.((i * 3) + 2) <- v.z)
50
+
verts;
51
+
let buf = Tarray.of_float_array Tarray.Float32 data in
52
+
let prog = Shader.program gl ~vert ~frag in
53
+
let vao = Gl.create_vertex_array gl in
54
+
Gl.bind_vertex_array gl (Some vao);
55
+
let vbo = Gl.create_buffer gl in
56
+
Gl.bind_buffer gl Gl.array_buffer (Some vbo);
57
+
Gl.buffer_data gl Gl.array_buffer buf Gl.static_draw;
58
+
Gl.enable_vertex_attrib_array gl 0;
59
+
Gl.vertex_attrib_pointer gl 0 3 Gl.float false 0 0;
60
+
Gl.bind_vertex_array gl None;
61
+
let u name = Gl.get_uniform_location gl prog (Jstr.of_string name) in
62
+
{
63
+
prog; vao; num_vertices = n;
64
+
u_proj = u "u_projection"; u_view = u "u_view";
65
+
u_color = u "u_color"; u_alpha = u "u_alpha";
66
+
}
67
+
68
+
let draw gl t ~projection ~view
69
+
?(color = (0.15, 0.35, 0.5)) ?(alpha = 0.3) () =
70
+
Gl.use_program gl t.prog;
71
+
Gl.uniform_matrix4fv gl t.u_proj false
72
+
(Tarray.of_float_array Tarray.Float32 projection);
73
+
Gl.uniform_matrix4fv gl t.u_view false
74
+
(Tarray.of_float_array Tarray.Float32 view);
75
+
let r, g, b = color in
76
+
Gl.uniform3f gl t.u_color r g b;
77
+
Gl.uniform1f gl t.u_alpha alpha;
78
+
Gl.bind_vertex_array gl (Some t.vao);
79
+
Gl.draw_arrays gl Gl.lines 0 t.num_vertices;
80
+
Gl.bind_vertex_array gl None
+23
webgl/grid.mli
+23
webgl/grid.mli
···
1
+
(** Latitude/longitude grid overlay on the globe.
2
+
3
+
Renders lat/lon lines on a unit sphere for orientation
4
+
and ground track reference. *)
5
+
6
+
type t
7
+
(** Opaque grid renderer state. *)
8
+
9
+
val v : ?spacing:float -> Brr_canvas.Gl.t -> t
10
+
(** [v ?spacing gl] creates a grid with lines every [spacing] degrees
11
+
(default 30). *)
12
+
13
+
val draw :
14
+
Brr_canvas.Gl.t ->
15
+
t ->
16
+
projection:float array ->
17
+
view:float array ->
18
+
?color:float * float * float ->
19
+
?alpha:float ->
20
+
unit ->
21
+
unit
22
+
(** [draw gl t ~projection ~view ?color ?alpha ()] renders the grid.
23
+
Default color is muted blue [(0.15, 0.35, 0.5)] at alpha [0.3]. *)