Reusable 3D Earth globe widget (pure OCaml + WebGL)
feat: add orbis 4D conjunction viewer + extract reusable space libraries
New libraries:
- ocaml-kepler: two-body Keplerian orbit propagation (RK4)
- ocaml-oem: CCSDS 502.0-B-3 OEM parser + Hermite interpolation
- ocaml-coordinate: astrodynamics frame transforms (TEME/ECEF/J2000/geodetic)
- ocaml-globe: reusable 3D Earth globe widget (dot cloud + WebGL renderers)
orbis: 4D conjunction viewer app
- Visualizes 11K+ TraCSS conjunctions (Jan 1-8 2025)
- Time-filtered conjunction display with Pc color coding
- Keplerian propagation of satellite positions from CDM state vectors
- Timeline slider, tabbed sidebar, click-to-zoom on conjunctions
- Helix UI with Tailwind CSS, pure OCaml compiled via js_of_ocaml
Refactored:
- Removed Sgp4.to_geodetic (now Coordinate.ecef_to_geodetic, WGS-84)
- Updated space-sim to use ocaml-coordinate
- orbis is now a pure web app (no library), all domain logic in separate libs
+1070
+1
.ocamlformat
+1
.ocamlformat
···
1
+
profile = default
+4
dune-project
+4
dune-project
+5
globe.opam
+5
globe.opam
+4
lib/dune
+4
lib/dune
+16
lib/gl_coord.ml
+16
lib/gl_coord.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** GL coordinate mapping for Earth-centered frames.
7
+
8
+
Maps astrodynamics conventions (X,Y = equatorial, Z = north pole)
9
+
to WebGL conventions (X,Z = equatorial, Y = up/north pole),
10
+
scaled so Earth radius = 1.0. *)
11
+
12
+
let scale = 1. /. Coordinate.earth_radius
13
+
14
+
let of_astro x y z = Math.Vec3.create (x *. scale) (z *. scale) (y *. scale)
15
+
16
+
let of_coordinate (v : Coordinate.vec3) = of_astro v.x v.y v.z
+10
lib/gl_coord.mli
+10
lib/gl_coord.mli
···
1
+
(** GL coordinate mapping for Earth-centered frames.
2
+
3
+
Converts astrodynamics position vectors (km) to GL coordinates
4
+
where Earth radius = 1.0 and Y axis points north. *)
5
+
6
+
val of_astro : float -> float -> float -> Math.Vec3.t
7
+
(** [of_astro x y z] maps (x, y, z) in km to GL coordinates. *)
8
+
9
+
val of_coordinate : Coordinate.vec3 -> Math.Vec3.t
10
+
(** [of_coordinate v] converts a {!Coordinate.vec3} to GL coordinates. *)
+102
lib/math.ml
+102
lib/math.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Linear algebra primitives for 3D rendering: Vec3 and Mat4. *)
7
+
8
+
module Vec3 = struct
9
+
type t = { x : float; y : float; z : float }
10
+
11
+
let create x y z = { x; y; z }
12
+
let zero = { x = 0.; y = 0.; z = 0. }
13
+
let add a b = { x = a.x +. b.x; y = a.y +. b.y; z = a.z +. b.z }
14
+
let sub a b = { x = a.x -. b.x; y = a.y -. b.y; z = a.z -. b.z }
15
+
let scale s v = { x = s *. v.x; y = s *. v.y; z = s *. v.z }
16
+
let dot a b = (a.x *. b.x) +. (a.y *. b.y) +. (a.z *. b.z)
17
+
18
+
let cross a b =
19
+
{
20
+
x = (a.y *. b.z) -. (a.z *. b.y);
21
+
y = (a.z *. b.x) -. (a.x *. b.z);
22
+
z = (a.x *. b.y) -. (a.y *. b.x);
23
+
}
24
+
25
+
let length v = sqrt (dot v v)
26
+
27
+
let normalize v =
28
+
let l = length v in
29
+
if l > 1e-10 then scale (1. /. l) v else zero
30
+
31
+
let negate v = { x = -.v.x; y = -.v.y; z = -.v.z }
32
+
end
33
+
34
+
module Mat4 = struct
35
+
(** Column-major 4x4 matrix stored as a flat 16-element array.
36
+
Layout: [m0 m1 m2 m3 | m4 m5 m6 m7 | m8 m9 m10 m11 | m12 m13 m14 m15]
37
+
where each group of 4 is one column. *)
38
+
type t = float array
39
+
40
+
let identity () =
41
+
[|
42
+
1.; 0.; 0.; 0.;
43
+
0.; 1.; 0.; 0.;
44
+
0.; 0.; 1.; 0.;
45
+
0.; 0.; 0.; 1.;
46
+
|]
47
+
48
+
let multiply (a : t) (b : t) : t =
49
+
let r = Array.make 16 0. in
50
+
for col = 0 to 3 do
51
+
for row = 0 to 3 do
52
+
let v = ref 0. in
53
+
for k = 0 to 3 do
54
+
v := !v +. (a.((k * 4) + row) *. b.((col * 4) + k))
55
+
done;
56
+
r.((col * 4) + row) <- !v
57
+
done
58
+
done;
59
+
r
60
+
61
+
let perspective ~fovy ~aspect ~near ~far =
62
+
let f = 1. /. tan (fovy /. 2.) in
63
+
let nf = 1. /. (near -. far) in
64
+
[|
65
+
f /. aspect; 0.; 0.; 0.;
66
+
0.; f; 0.; 0.;
67
+
0.; 0.; (far +. near) *. nf; -1.;
68
+
0.; 0.; 2. *. far *. near *. nf; 0.;
69
+
|]
70
+
71
+
let look_at ~eye ~center ~up =
72
+
let open Vec3 in
73
+
let f = normalize (sub center eye) in
74
+
let s = normalize (cross f up) in
75
+
let u = cross s f in
76
+
[|
77
+
s.x; u.x; -.f.x; 0.;
78
+
s.y; u.y; -.f.y; 0.;
79
+
s.z; u.z; -.f.z; 0.;
80
+
-.dot s eye; -.dot u eye; dot f eye; 1.;
81
+
|]
82
+
83
+
let rotate_x angle =
84
+
let c = cos angle and s = sin angle in
85
+
[|
86
+
1.; 0.; 0.; 0.;
87
+
0.; c; s; 0.;
88
+
0.; -.s; c; 0.;
89
+
0.; 0.; 0.; 1.;
90
+
|]
91
+
92
+
let rotate_y angle =
93
+
let c = cos angle and s = sin angle in
94
+
[|
95
+
c; 0.; -.s; 0.;
96
+
0.; 1.; 0.; 0.;
97
+
s; 0.; c; 0.;
98
+
0.; 0.; 0.; 1.;
99
+
|]
100
+
101
+
let to_float_array (m : t) : float array = Array.copy m
102
+
end
+61
lib/math.mli
+61
lib/math.mli
···
1
+
(** Linear algebra primitives for 3D rendering: Vec3 and Mat4. *)
2
+
3
+
module Vec3 : sig
4
+
type t = { x : float; y : float; z : float }
5
+
6
+
val create : float -> float -> float -> t
7
+
(** [create x y z] is the vector [(x, y, z)]. *)
8
+
9
+
val zero : t
10
+
(** [zero] is the origin [(0, 0, 0)]. *)
11
+
12
+
val add : t -> t -> t
13
+
(** [add a b] is the component-wise sum of [a] and [b]. *)
14
+
15
+
val sub : t -> t -> t
16
+
(** [sub a b] is the component-wise difference of [a] and [b]. *)
17
+
18
+
val scale : float -> t -> t
19
+
(** [scale s v] multiplies each component of [v] by [s]. *)
20
+
21
+
val dot : t -> t -> float
22
+
(** [dot a b] is the dot product of [a] and [b]. *)
23
+
24
+
val cross : t -> t -> t
25
+
(** [cross a b] is the cross product of [a] and [b]. *)
26
+
27
+
val length : t -> float
28
+
(** [length v] is the Euclidean length of [v]. *)
29
+
30
+
val normalize : t -> t
31
+
(** [normalize v] is [v] scaled to unit length, or [zero] if degenerate. *)
32
+
33
+
val negate : t -> t
34
+
(** [negate v] is [v] with all components negated. *)
35
+
end
36
+
37
+
module Mat4 : sig
38
+
type t = float array
39
+
(** Column-major 4x4 matrix stored as a flat 16-element array. *)
40
+
41
+
val identity : unit -> t
42
+
(** [identity ()] is the 4x4 identity matrix. *)
43
+
44
+
val multiply : t -> t -> t
45
+
(** [multiply a b] is the matrix product [a * b]. *)
46
+
47
+
val perspective : fovy:float -> aspect:float -> near:float -> far:float -> t
48
+
(** [perspective ~fovy ~aspect ~near ~far] is a perspective projection matrix. *)
49
+
50
+
val look_at : eye:Vec3.t -> center:Vec3.t -> up:Vec3.t -> t
51
+
(** [look_at ~eye ~center ~up] is a view matrix looking from [eye] toward [center]. *)
52
+
53
+
val rotate_x : float -> t
54
+
(** [rotate_x angle] is a rotation matrix around the X axis. *)
55
+
56
+
val rotate_y : float -> t
57
+
(** [rotate_y angle] is a rotation matrix around the Y axis. *)
58
+
59
+
val to_float_array : t -> float array
60
+
(** [to_float_array m] is a copy of [m] as a plain float array. *)
61
+
end
+277
lib/sphere.ml
+277
lib/sphere.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Point cloud generation for the dot-cloud globe.
7
+
8
+
Uses golden spiral distribution for even spacing, with brightness
9
+
based on polygon-traced continent outlines. Points near coastlines
10
+
glow brightest, creating a recognizable Earth silhouette. *)
11
+
12
+
type point = { pos : Math.Vec3.t; brightness : float }
13
+
14
+
(* --- Ray-casting point-in-polygon test --- *)
15
+
16
+
let point_in_polygon lat lon (vertices : (float * float) array) =
17
+
let n = Array.length vertices in
18
+
if n < 3 then false
19
+
else
20
+
let inside = ref false in
21
+
let j = ref (n - 1) in
22
+
for i = 0 to n - 1 do
23
+
let lat_i, lon_i = vertices.(i) in
24
+
let lat_j, lon_j = vertices.(!j) in
25
+
if (lat_i > lat) <> (lat_j > lat) then begin
26
+
let x =
27
+
lon_i
28
+
+. ((lat -. lat_i) *. (lon_j -. lon_i) /. (lat_j -. lat_i))
29
+
in
30
+
if lon < x then inside := not !inside
31
+
end;
32
+
j := i
33
+
done;
34
+
!inside
35
+
36
+
(* --- Squared distance from point to line segment --- *)
37
+
38
+
let point_to_seg_dist_sq px py ax ay bx by =
39
+
let dx = bx -. ax and dy = by -. ay in
40
+
let len_sq = (dx *. dx) +. (dy *. dy) in
41
+
if len_sq < 1e-10 then
42
+
let ex = px -. ax and ey = py -. ay in
43
+
(ex *. ex) +. (ey *. ey)
44
+
else
45
+
let t = ((px -. ax) *. dx +. ((py -. ay) *. dy)) /. len_sq in
46
+
let t = Float.max 0. (Float.min 1. t) in
47
+
let cx = ax +. (t *. dx) and cy = ay +. (t *. dy) in
48
+
let ex = px -. cx and ey = py -. cy in
49
+
(ex *. ex) +. (ey *. ey)
50
+
51
+
(* ------------------------------------------------------------------ *)
52
+
(* Continent polygons — (latitude, longitude) vertex arrays *)
53
+
(* Traced to ~5° accuracy; enough for 30k-point cloud recognition. *)
54
+
(* ------------------------------------------------------------------ *)
55
+
56
+
let africa =
57
+
[|
58
+
(35., -5.); (37., 10.); (32., 13.); (31., 25.); (30., 33.);
59
+
(22., 37.); (12., 44.); (2., 51.); (-2., 42.); (-7., 40.);
60
+
(-11., 40.); (-16., 41.); (-25., 35.); (-27., 33.); (-35., 26.);
61
+
(-34., 18.); (-29., 17.); (-22., 14.); (-17., 12.); (-6., 12.);
62
+
(4., 10.); (6., 3.); (5., -3.); (5., -8.); (8., -14.);
63
+
(12., -17.); (15., -17.); (21., -17.); (28., -13.); (33., -8.);
64
+
|]
65
+
66
+
let eurasia =
67
+
[|
68
+
(* Iberia → NW Europe *)
69
+
(36., -10.); (39., -9.); (44., -9.); (44., -2.); (48., -5.);
70
+
(51., 2.); (54., 8.); (57., 10.);
71
+
(* Scandinavia *)
72
+
(58., 6.); (62., 5.); (66., 14.); (71., 27.);
73
+
(* Arctic Russia *)
74
+
(69., 34.); (66., 44.); (69., 58.); (73., 80.); (76., 97.);
75
+
(73., 115.); (72., 135.); (70., 150.); (66., 170.);
76
+
(* Russian Far East *)
77
+
(60., 165.); (56., 162.); (53., 159.); (50., 140.);
78
+
(* NE Asia *)
79
+
(45., 142.); (43., 135.); (39., 125.); (35., 126.); (31., 122.);
80
+
(* SE China *)
81
+
(25., 119.); (22., 113.); (22., 108.);
82
+
(* SE Asia mainland *)
83
+
(16., 108.); (10., 107.); (8., 105.); (1., 104.);
84
+
(* Malay Peninsula → Myanmar *)
85
+
(7., 100.); (14., 99.); (16., 97.); (21., 92.);
86
+
(* India *)
87
+
(22., 88.); (18., 84.); (13., 80.); (8., 77.); (10., 76.);
88
+
(15., 74.); (21., 73.); (24., 68.);
89
+
(* Pakistan → Iran *)
90
+
(25., 62.); (26., 57.);
91
+
(* Persian Gulf → Iraq *)
92
+
(30., 48.); (33., 44.); (37., 36.);
93
+
(* Turkey → Mediterranean *)
94
+
(37., 30.); (36., 28.); (38., 24.); (40., 20.); (42., 19.);
95
+
(* Adriatic → Italy *)
96
+
(46., 14.); (44., 13.); (41., 17.); (38., 16.); (37., 15.);
97
+
(* W Mediterranean *)
98
+
(39., 9.); (43., 5.); (40., 0.); (37., -2.); (36., -6.);
99
+
|]
100
+
101
+
let arabia =
102
+
[|
103
+
(30., 48.); (29., 48.); (26., 50.); (24., 54.); (22., 59.);
104
+
(17., 55.); (14., 49.); (13., 44.); (16., 43.); (20., 40.);
105
+
(24., 38.); (28., 35.); (30., 35.); (33., 36.); (33., 44.);
106
+
|]
107
+
108
+
let north_america =
109
+
[|
110
+
(* Alaska → Arctic *)
111
+
(65., -168.); (71., -157.); (72., -128.); (74., -95.);
112
+
(73., -80.); (69., -68.);
113
+
(* East coast *)
114
+
(60., -64.); (53., -56.); (47., -60.); (44., -67.);
115
+
(40., -74.); (35., -76.); (30., -81.); (25., -80.);
116
+
(* Gulf → Mexico *)
117
+
(30., -86.); (29., -95.); (26., -97.); (20., -97.);
118
+
(* Central America *)
119
+
(17., -92.); (15., -87.); (10., -84.); (8., -78.);
120
+
(* West coast *)
121
+
(16., -95.); (19., -105.); (23., -110.); (30., -115.);
122
+
(32., -117.); (38., -123.); (46., -124.); (49., -125.);
123
+
(54., -131.); (58., -137.); (60., -147.); (63., -165.);
124
+
|]
125
+
126
+
let south_america =
127
+
[|
128
+
(12., -72.); (10., -67.); (7., -60.); (5., -52.);
129
+
(0., -50.); (-5., -35.); (-12., -37.); (-23., -42.);
130
+
(-33., -52.); (-35., -57.); (-42., -64.); (-52., -68.);
131
+
(-55., -69.); (-55., -66.); (-50., -73.); (-45., -74.);
132
+
(-34., -72.); (-23., -70.); (-16., -75.); (-5., -81.);
133
+
(0., -80.); (7., -78.); (11., -75.);
134
+
|]
135
+
136
+
let australia =
137
+
[|
138
+
(-12., 131.); (-11., 136.); (-14., 142.); (-19., 146.);
139
+
(-24., 153.); (-28., 153.); (-34., 151.); (-38., 145.);
140
+
(-36., 137.); (-34., 136.); (-32., 133.); (-32., 115.);
141
+
(-22., 114.); (-14., 127.);
142
+
|]
143
+
144
+
let greenland =
145
+
[|
146
+
(60., -43.); (63., -40.); (66., -36.); (72., -22.); (78., -18.);
147
+
(84., -30.); (83., -58.); (78., -72.); (76., -68.);
148
+
(70., -55.); (64., -50.);
149
+
|]
150
+
151
+
let uk =
152
+
[|
153
+
(50., -5.); (51., 1.); (53., 0.); (55., -2.); (58., -3.);
154
+
(59., -5.); (57., -7.); (55., -6.); (54., -3.); (52., -5.);
155
+
|]
156
+
157
+
let ireland =
158
+
[|
159
+
(52., -6.); (53., -6.); (55., -6.); (55., -8.);
160
+
(54., -10.); (52., -10.); (51., -9.);
161
+
|]
162
+
163
+
let iceland =
164
+
[| (64., -22.); (64., -14.); (66., -14.); (66., -24.) |]
165
+
166
+
let japan =
167
+
[|
168
+
(31., 131.); (33., 130.); (35., 133.); (36., 137.);
169
+
(38., 139.); (40., 140.); (42., 141.); (44., 145.);
170
+
(45., 142.); (43., 141.); (38., 141.); (35., 140.);
171
+
(34., 135.); (33., 131.);
172
+
|]
173
+
174
+
let madagascar =
175
+
[|
176
+
(-12., 49.); (-16., 50.); (-22., 48.); (-26., 47.);
177
+
(-24., 44.); (-16., 44.); (-13., 48.);
178
+
|]
179
+
180
+
let sri_lanka =
181
+
[| (10., 80.); (8., 82.); (6., 81.); (7., 80.); (9., 80.) |]
182
+
183
+
let sumatra =
184
+
[|
185
+
(5., 95.); (2., 99.); (-2., 104.); (-5., 105.);
186
+
(-6., 104.); (-3., 100.); (1., 97.);
187
+
|]
188
+
189
+
let borneo =
190
+
[|
191
+
(7., 117.); (5., 119.); (2., 118.); (-1., 117.);
192
+
(-4., 115.); (-3., 111.); (0., 109.); (3., 110.);
193
+
|]
194
+
195
+
let java =
196
+
[|
197
+
(-6., 106.); (-7., 110.); (-8., 114.); (-8., 115.);
198
+
(-8., 110.); (-7., 106.);
199
+
|]
200
+
201
+
let papua =
202
+
[|
203
+
(-1., 133.); (-2., 138.); (-4., 141.); (-8., 141.);
204
+
(-9., 138.); (-8., 134.); (-5., 133.);
205
+
|]
206
+
207
+
let philippines =
208
+
[|
209
+
(18., 121.); (15., 122.); (12., 124.); (8., 126.);
210
+
(7., 124.); (10., 120.); (14., 120.);
211
+
|]
212
+
213
+
let new_zealand_n =
214
+
[|
215
+
(-35., 173.); (-37., 176.); (-39., 178.); (-42., 175.);
216
+
(-39., 174.); (-37., 174.);
217
+
|]
218
+
219
+
let new_zealand_s =
220
+
[|
221
+
(-42., 172.); (-44., 171.); (-46., 168.); (-46., 166.);
222
+
(-44., 168.); (-42., 170.);
223
+
|]
224
+
225
+
let all_polygons =
226
+
[|
227
+
africa; eurasia; arabia; north_america; south_america; australia;
228
+
greenland; uk; ireland; iceland; japan; madagascar; sri_lanka;
229
+
sumatra; borneo; java; papua; philippines;
230
+
new_zealand_n; new_zealand_s;
231
+
|]
232
+
233
+
(* --- Land detection and coast proximity --- *)
234
+
235
+
let is_land lat lon =
236
+
lat < -65. (* Antarctica *)
237
+
|| Array.exists (fun poly -> point_in_polygon lat lon poly) all_polygons
238
+
239
+
let min_coast_dist_sq lat lon =
240
+
let best = ref infinity in
241
+
Array.iter
242
+
(fun polygon ->
243
+
let n = Array.length polygon in
244
+
for i = 0 to n - 1 do
245
+
let lat_i, lon_i = polygon.(i) in
246
+
let lat_j, lon_j = polygon.((i + 1) mod n) in
247
+
let d = point_to_seg_dist_sq lat lon lat_i lon_i lat_j lon_j in
248
+
if d < !best then best := d
249
+
done)
250
+
all_polygons;
251
+
!best
252
+
253
+
(* --- Point cloud generation --- *)
254
+
255
+
let generate_cloud ~num_points =
256
+
let pi = Float.pi in
257
+
let golden_ratio = (1. +. sqrt 5.) /. 2. in
258
+
Array.init num_points (fun i ->
259
+
let fi = Float.of_int i in
260
+
let n = Float.of_int num_points in
261
+
let theta = acos (1. -. (2. *. (fi +. 0.5) /. n)) in
262
+
let phi = 2. *. pi *. fi /. golden_ratio in
263
+
let x = sin theta *. cos phi in
264
+
let y = cos theta in
265
+
let z = sin theta *. sin phi in
266
+
let lat = 90. -. (theta *. 180. /. pi) in
267
+
let lon_raw = phi *. 180. /. pi in
268
+
let lon = Float.rem lon_raw 360. in
269
+
let lon = if lon > 180. then lon -. 360. else lon in
270
+
let on_land = is_land lat lon in
271
+
let coast_d = sqrt (min_coast_dist_sq lat lon) in
272
+
let coast_glow = Float.max 0. (1. -. (coast_d /. 8.)) in
273
+
let brightness =
274
+
if on_land then 0.55 +. (0.45 *. coast_glow)
275
+
else 0.10 +. (0.25 *. coast_glow)
276
+
in
277
+
{ pos = Math.Vec3.create x y z; brightness })
+14
lib/sphere.mli
+14
lib/sphere.mli
···
1
+
(** Point cloud generation for the dot-cloud globe.
2
+
3
+
Generates evenly-spaced points on a unit sphere with brightness values
4
+
based on polygon-traced continent outlines and coast proximity. *)
5
+
6
+
type point = { pos : Math.Vec3.t; brightness : float }
7
+
8
+
val generate_cloud : num_points:int -> point array
9
+
(** [generate_cloud ~num_points] returns an array of points on the unit
10
+
sphere distributed via golden spiral, each with a brightness value:
11
+
- Coastline points: ~1.0 (brightest)
12
+
- Interior land: ~0.55–0.9
13
+
- Near-coast ocean: ~0.15–0.35
14
+
- Deep ocean: ~0.10. *)
+3
test/test.ml
+3
test/test.ml
+43
test/test_gl_coord.ml
+43
test/test_gl_coord.ml
···
1
+
open Globe
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_equator_pm () =
9
+
let r = Coordinate.earth_radius in
10
+
let gl = Gl_coord.of_astro r 0. 0. in
11
+
check_float "x" 1.0 gl.x;
12
+
check_float "y" 0. gl.y;
13
+
check_float "z" 0. gl.z
14
+
15
+
let test_north_pole () =
16
+
let r = Coordinate.earth_radius in
17
+
let gl = Gl_coord.of_astro 0. 0. r in
18
+
check_float "x" 0. gl.x;
19
+
check_float "y" 1.0 gl.y;
20
+
check_float "z" 0. gl.z
21
+
22
+
let test_lon_90 () =
23
+
let r = Coordinate.earth_radius in
24
+
let gl = Gl_coord.of_astro 0. r 0. in
25
+
check_float "x" 0. gl.x;
26
+
check_float "y" 0. gl.y;
27
+
check_float "z" 1.0 gl.z
28
+
29
+
let test_of_coordinate () =
30
+
let v = Coordinate.vec3 6378.137 0. 6378.137 in
31
+
let gl = Gl_coord.of_coordinate v in
32
+
check_float "x" 1.0 gl.x;
33
+
check_float "y" 1.0 gl.y;
34
+
check_float "z" 0. gl.z
35
+
36
+
let suite =
37
+
( "gl_coord",
38
+
[
39
+
Alcotest.test_case "equator PM" `Quick test_equator_pm;
40
+
Alcotest.test_case "north pole" `Quick test_north_pole;
41
+
Alcotest.test_case "lon 90" `Quick test_lon_90;
42
+
Alcotest.test_case "of_coordinate" `Quick test_of_coordinate;
43
+
] )
+2
test/test_gl_coord.mli
+2
test/test_gl_coord.mli
+85
test/test_math.ml
+85
test/test_math.ml
···
1
+
open Globe
2
+
3
+
let eps = 1e-6
4
+
let check_float msg expected actual = Alcotest.(check (float eps)) msg expected actual
5
+
6
+
let test_vec3_add () =
7
+
let a = Math.Vec3.create 1. 2. 3. in
8
+
let b = Math.Vec3.create 4. 5. 6. in
9
+
let r = Math.Vec3.add a b in
10
+
check_float "x" 5. r.x;
11
+
check_float "y" 7. r.y;
12
+
check_float "z" 9. r.z
13
+
14
+
let test_vec3_sub () =
15
+
let a = Math.Vec3.create 4. 5. 6. in
16
+
let b = Math.Vec3.create 1. 2. 3. in
17
+
let r = Math.Vec3.sub a b in
18
+
check_float "x" 3. r.x;
19
+
check_float "y" 3. r.y;
20
+
check_float "z" 3. r.z
21
+
22
+
let test_vec3_cross () =
23
+
let x = Math.Vec3.create 1. 0. 0. in
24
+
let y = Math.Vec3.create 0. 1. 0. in
25
+
let z = Math.Vec3.cross x y in
26
+
check_float "x" 0. z.x;
27
+
check_float "y" 0. z.y;
28
+
check_float "z" 1. z.z
29
+
30
+
let test_vec3_normalize () =
31
+
let v = Math.Vec3.create 3. 4. 0. in
32
+
let n = Math.Vec3.normalize v in
33
+
check_float "x" 0.6 n.x;
34
+
check_float "y" 0.8 n.y;
35
+
check_float "z" 0. n.z;
36
+
check_float "length" 1.0 (Math.Vec3.length n)
37
+
38
+
let test_vec3_dot () =
39
+
let a = Math.Vec3.create 1. 2. 3. in
40
+
let b = Math.Vec3.create 4. 5. 6. in
41
+
check_float "dot" 32. (Math.Vec3.dot a b)
42
+
43
+
let test_mat4_identity () =
44
+
let m = Math.Mat4.identity () in
45
+
check_float "m[0]" 1. m.(0);
46
+
check_float "m[5]" 1. m.(5);
47
+
check_float "m[10]" 1. m.(10);
48
+
check_float "m[15]" 1. m.(15);
49
+
check_float "m[1]" 0. m.(1);
50
+
check_float "m[4]" 0. m.(4)
51
+
52
+
let test_mat4_mul_identity () =
53
+
let a =
54
+
[|
55
+
1.; 2.; 3.; 4.; 5.; 6.; 7.; 8.;
56
+
9.; 10.; 11.; 12.; 13.; 14.; 15.; 16.;
57
+
|]
58
+
in
59
+
let id = Math.Mat4.identity () in
60
+
let r = Math.Mat4.multiply a id in
61
+
Array.iteri (fun i v -> check_float (Fmt.str "m[%d]" i) a.(i) v) r
62
+
63
+
let test_mat4_perspective () =
64
+
let m =
65
+
Math.Mat4.perspective ~fovy:(Float.pi /. 4.) ~aspect:1.5 ~near:0.1
66
+
~far:100.
67
+
in
68
+
let f = 1. /. tan (Float.pi /. 8.) in
69
+
check_float "m[0]" (f /. 1.5) m.(0);
70
+
check_float "m[5]" f m.(5);
71
+
check_float "m[11]" (-1.) m.(11);
72
+
check_float "m[15]" 0. m.(15)
73
+
74
+
let suite =
75
+
( "math",
76
+
[
77
+
Alcotest.test_case "vec3 add" `Quick test_vec3_add;
78
+
Alcotest.test_case "vec3 sub" `Quick test_vec3_sub;
79
+
Alcotest.test_case "vec3 cross" `Quick test_vec3_cross;
80
+
Alcotest.test_case "vec3 normalize" `Quick test_vec3_normalize;
81
+
Alcotest.test_case "vec3 dot" `Quick test_vec3_dot;
82
+
Alcotest.test_case "mat4 identity" `Quick test_mat4_identity;
83
+
Alcotest.test_case "mat4 mul identity" `Quick test_mat4_mul_identity;
84
+
Alcotest.test_case "mat4 perspective" `Quick test_mat4_perspective;
85
+
] )
+2
test/test_math.mli
+2
test/test_math.mli
+32
test/test_sphere.ml
+32
test/test_sphere.ml
···
1
+
open Globe
2
+
3
+
let eps = 1e-6
4
+
let check_float msg expected actual = Alcotest.(check (float eps)) msg expected actual
5
+
6
+
let test_point_count () =
7
+
let cloud = Sphere.generate_cloud ~num_points:100 in
8
+
Alcotest.(check int) "count" 100 (Array.length cloud)
9
+
10
+
let test_on_unit_sphere () =
11
+
let cloud = Sphere.generate_cloud ~num_points:100 in
12
+
Array.iter
13
+
(fun (p : Sphere.point) ->
14
+
let len = Math.Vec3.length p.pos in
15
+
check_float "unit sphere" 1.0 len)
16
+
cloud
17
+
18
+
let test_brightness_range () =
19
+
let cloud = Sphere.generate_cloud ~num_points:1000 in
20
+
Array.iter
21
+
(fun (p : Sphere.point) ->
22
+
Alcotest.(check bool) "brightness >= 0" true (p.brightness >= 0.);
23
+
Alcotest.(check bool) "brightness <= 1" true (p.brightness <= 1.))
24
+
cloud
25
+
26
+
let suite =
27
+
( "sphere",
28
+
[
29
+
Alcotest.test_case "point count" `Quick test_point_count;
30
+
Alcotest.test_case "on unit sphere" `Quick test_on_unit_sphere;
31
+
Alcotest.test_case "brightness range" `Quick test_brightness_range;
32
+
] )
+2
test/test_sphere.mli
+2
test/test_sphere.mli
+99
webgl/camera.ml
+99
webgl/camera.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Orbit camera with drag rotation and scroll zoom. *)
7
+
8
+
open Brr
9
+
10
+
type t = {
11
+
mutable theta : float;
12
+
mutable phi : float;
13
+
mutable distance : float;
14
+
mutable dragging : bool;
15
+
mutable last_x : float;
16
+
mutable last_y : float;
17
+
mutable auto_rotate : bool;
18
+
}
19
+
20
+
let v () =
21
+
{
22
+
theta = 0.;
23
+
phi = 0.3;
24
+
distance = 3.5;
25
+
dragging = false;
26
+
last_x = 0.;
27
+
last_y = 0.;
28
+
auto_rotate = true;
29
+
}
30
+
31
+
let view_matrix cam =
32
+
let open Globe.Math in
33
+
let x = cam.distance *. cos cam.phi *. sin cam.theta in
34
+
let y = cam.distance *. sin cam.phi in
35
+
let z = cam.distance *. cos cam.phi *. cos cam.theta in
36
+
let eye = Vec3.create x y z in
37
+
let center = Vec3.zero in
38
+
let up = Vec3.create 0. 1. 0. in
39
+
Mat4.look_at ~eye ~center ~up
40
+
41
+
let look_at_position cam (pos : Globe.Math.Vec3.t) =
42
+
let r = Globe.Math.Vec3.length pos in
43
+
if r > 1e-6 then begin
44
+
cam.phi <- asin (pos.y /. r);
45
+
cam.theta <- atan2 pos.x pos.z;
46
+
cam.auto_rotate <- false
47
+
end
48
+
49
+
let update cam _dt =
50
+
if cam.auto_rotate && not cam.dragging then
51
+
cam.theta <- cam.theta +. 0.002
52
+
53
+
let attach_events cam el =
54
+
let _l1 =
55
+
Ev.listen Ev.pointerdown
56
+
(fun ev ->
57
+
let pev = Ev.as_type ev in
58
+
let mev = Ev.Pointer.as_mouse pev in
59
+
cam.dragging <- true;
60
+
cam.auto_rotate <- false;
61
+
cam.last_x <- Ev.Mouse.client_x mev;
62
+
cam.last_y <- Ev.Mouse.client_y mev)
63
+
(El.as_target el)
64
+
in
65
+
let _l2 =
66
+
Ev.listen Ev.pointermove
67
+
(fun ev ->
68
+
if cam.dragging then begin
69
+
let pev = Ev.as_type ev in
70
+
let mev = Ev.Pointer.as_mouse pev in
71
+
let x = Ev.Mouse.client_x mev in
72
+
let y = Ev.Mouse.client_y mev in
73
+
let dx = x -. cam.last_x in
74
+
let dy = y -. cam.last_y in
75
+
cam.theta <- cam.theta -. (dx *. 0.005);
76
+
cam.phi <- cam.phi +. (dy *. 0.005);
77
+
let max_phi = Float.pi /. 2. -. 0.01 in
78
+
cam.phi <- Float.max (-.max_phi) (Float.min max_phi cam.phi);
79
+
cam.last_x <- x;
80
+
cam.last_y <- y
81
+
end)
82
+
(El.as_target el)
83
+
in
84
+
let _l3 =
85
+
Ev.listen Ev.pointerup
86
+
(fun _ev -> cam.dragging <- false)
87
+
(El.as_target el)
88
+
in
89
+
let _l4 =
90
+
Ev.listen Ev.wheel
91
+
(fun ev ->
92
+
let wev : Ev.Wheel.t = Ev.as_type ev in
93
+
Ev.prevent_default ev;
94
+
let dy = Ev.Wheel.delta_y wev in
95
+
cam.distance <- cam.distance +. (dy *. 0.002);
96
+
cam.distance <- Float.max 1.5 (Float.min 10. cam.distance))
97
+
(El.as_target el)
98
+
in
99
+
()
+27
webgl/camera.mli
+27
webgl/camera.mli
···
1
+
(** Orbit camera with drag rotation and scroll zoom. *)
2
+
3
+
type t = {
4
+
mutable theta : float;
5
+
mutable phi : float;
6
+
mutable distance : float;
7
+
mutable dragging : bool;
8
+
mutable last_x : float;
9
+
mutable last_y : float;
10
+
mutable auto_rotate : bool;
11
+
}
12
+
(** Camera state. *)
13
+
14
+
val v : unit -> t
15
+
(** [v ()] creates a camera at default position. *)
16
+
17
+
val view_matrix : t -> Globe.Math.Mat4.t
18
+
(** [view_matrix cam] computes the view matrix for the current camera state. *)
19
+
20
+
val look_at_position : t -> Globe.Math.Vec3.t -> unit
21
+
(** [look_at_position cam pos] rotates the camera to face [pos]. *)
22
+
23
+
val update : t -> float -> unit
24
+
(** [update cam dt] advances auto-rotation by [dt] seconds. *)
25
+
26
+
val attach_events : t -> Brr.El.t -> unit
27
+
(** [attach_events cam el] attaches pointer and wheel event listeners to [el]. *)
+4
webgl/dune
+4
webgl/dune
+66
webgl/earth.ml
+66
webgl/earth.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Dot cloud Earth rendering using GL_POINTS. *)
7
+
8
+
open Brr
9
+
open Brr_canvas
10
+
11
+
type t = {
12
+
prog : Gl.program;
13
+
vao : Gl.vertex_array_object;
14
+
num_points : int;
15
+
u_projection : Gl.uniform_location;
16
+
u_view : Gl.uniform_location;
17
+
u_point_size : Gl.uniform_location;
18
+
}
19
+
20
+
let v ?(num_points = 30000) gl =
21
+
let points = Globe.Sphere.generate_cloud ~num_points in
22
+
let n = Array.length points in
23
+
let data = Array.make (n * 4) 0. in
24
+
Array.iteri
25
+
(fun i (p : Globe.Sphere.point) ->
26
+
let off = i * 4 in
27
+
data.(off) <- p.pos.x;
28
+
data.(off + 1) <- p.pos.y;
29
+
data.(off + 2) <- p.pos.z;
30
+
data.(off + 3) <- p.brightness)
31
+
points;
32
+
let buf_data = Tarray.of_float_array Tarray.Float32 data in
33
+
let prog =
34
+
Shader.program gl ~vert:Shader.earth_vertex ~frag:Shader.earth_fragment
35
+
in
36
+
let vao = Gl.create_vertex_array gl in
37
+
Gl.bind_vertex_array gl (Some vao);
38
+
let vbo = Gl.create_buffer gl in
39
+
Gl.bind_buffer gl Gl.array_buffer (Some vbo);
40
+
Gl.buffer_data gl Gl.array_buffer buf_data Gl.static_draw;
41
+
Gl.enable_vertex_attrib_array gl 0;
42
+
Gl.vertex_attrib_pointer gl 0 3 Gl.float false 16 0;
43
+
Gl.enable_vertex_attrib_array gl 1;
44
+
Gl.vertex_attrib_pointer gl 1 1 Gl.float false 16 12;
45
+
Gl.bind_vertex_array gl None;
46
+
{
47
+
prog;
48
+
vao;
49
+
num_points = n;
50
+
u_projection =
51
+
Gl.get_uniform_location gl prog (Jstr.of_string "u_projection");
52
+
u_view = Gl.get_uniform_location gl prog (Jstr.of_string "u_view");
53
+
u_point_size =
54
+
Gl.get_uniform_location gl prog (Jstr.of_string "u_point_size");
55
+
}
56
+
57
+
let draw gl t ~projection ~view =
58
+
Gl.use_program gl t.prog;
59
+
let proj_arr = Tarray.of_float_array Tarray.Float32 projection in
60
+
let view_arr = Tarray.of_float_array Tarray.Float32 view in
61
+
Gl.uniform_matrix4fv gl t.u_projection false proj_arr;
62
+
Gl.uniform_matrix4fv gl t.u_view false view_arr;
63
+
Gl.uniform1f gl t.u_point_size 3.5;
64
+
Gl.bind_vertex_array gl (Some t.vao);
65
+
Gl.draw_arrays gl Gl.points 0 t.num_points;
66
+
Gl.bind_vertex_array gl None
+12
webgl/earth.mli
+12
webgl/earth.mli
···
1
+
(** Dot cloud Earth rendering using GL_POINTS. *)
2
+
3
+
type t
4
+
(** Opaque Earth renderer state. *)
5
+
6
+
val v : ?num_points:int -> Brr_canvas.Gl.t -> t
7
+
(** [v ?num_points gl] creates an Earth renderer with [num_points] dots
8
+
(default 30000). *)
9
+
10
+
val draw :
11
+
Brr_canvas.Gl.t -> t -> projection:float array -> view:float array -> unit
12
+
(** [draw gl t ~projection ~view] renders the Earth dot cloud. *)
+99
webgl/shader.ml
+99
webgl/shader.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** GLSL shader compilation utilities and globe shader sources. *)
7
+
8
+
open Brr_canvas
9
+
10
+
let compile gl typ src =
11
+
let shader = Gl.create_shader gl typ in
12
+
Gl.shader_source gl shader (Jstr.of_string src);
13
+
Gl.compile_shader gl shader;
14
+
shader
15
+
16
+
let program gl ~vert ~frag =
17
+
let vs = compile gl Gl.vertex_shader vert in
18
+
let fs = compile gl Gl.fragment_shader frag in
19
+
let prog = Gl.create_program gl in
20
+
Gl.attach_shader gl prog vs;
21
+
Gl.attach_shader gl prog fs;
22
+
Gl.link_program gl prog;
23
+
Gl.delete_shader gl vs;
24
+
Gl.delete_shader gl fs;
25
+
prog
26
+
27
+
(* --- Globe dot cloud shaders --- *)
28
+
29
+
let earth_vertex =
30
+
{|#version 300 es
31
+
precision highp float;
32
+
33
+
layout(location = 0) in vec3 a_position;
34
+
layout(location = 1) in float a_brightness;
35
+
36
+
uniform mat4 u_projection;
37
+
uniform mat4 u_view;
38
+
uniform float u_point_size;
39
+
40
+
out float v_brightness;
41
+
42
+
void main() {
43
+
gl_Position = u_projection * u_view * vec4(a_position, 1.0);
44
+
gl_PointSize = u_point_size * (0.3 + a_brightness * 0.7);
45
+
v_brightness = a_brightness;
46
+
}
47
+
|}
48
+
49
+
let earth_fragment =
50
+
{|#version 300 es
51
+
precision highp float;
52
+
53
+
in float v_brightness;
54
+
out vec4 fragColor;
55
+
56
+
void main() {
57
+
float d = distance(gl_PointCoord, vec2(0.5));
58
+
if (d > 0.5) discard;
59
+
float alpha = smoothstep(0.5, 0.1, d);
60
+
// Dark ocean blue → bright cyan coastline
61
+
vec3 color = mix(vec3(0.03, 0.10, 0.25), vec3(0.35, 0.90, 1.0), v_brightness);
62
+
fragColor = vec4(color, alpha * (0.3 + v_brightness * 0.7));
63
+
}
64
+
|}
65
+
66
+
(* --- Star field shaders --- *)
67
+
68
+
let star_vertex =
69
+
{|#version 300 es
70
+
precision highp float;
71
+
72
+
layout(location = 0) in vec3 a_position;
73
+
layout(location = 1) in float a_brightness;
74
+
75
+
uniform mat4 u_projection;
76
+
uniform mat4 u_view;
77
+
78
+
out float v_brightness;
79
+
80
+
void main() {
81
+
gl_Position = u_projection * u_view * vec4(a_position, 1.0);
82
+
gl_PointSize = 1.0 + a_brightness;
83
+
v_brightness = a_brightness;
84
+
}
85
+
|}
86
+
87
+
let star_fragment =
88
+
{|#version 300 es
89
+
precision highp float;
90
+
91
+
in float v_brightness;
92
+
out vec4 fragColor;
93
+
94
+
void main() {
95
+
float d = distance(gl_PointCoord, vec2(0.5));
96
+
if (d > 0.5) discard;
97
+
fragColor = vec4(vec3(1.0), v_brightness * smoothstep(0.5, 0.0, d));
98
+
}
99
+
|}
+19
webgl/shader.mli
+19
webgl/shader.mli
···
1
+
(** GLSL shader compilation utilities and globe shader sources. *)
2
+
3
+
val compile : Brr_canvas.Gl.t -> Brr_canvas.Gl.enum -> string -> Brr_canvas.Gl.shader
4
+
(** [compile gl typ src] compiles a GLSL shader from source. *)
5
+
6
+
val program : Brr_canvas.Gl.t -> vert:string -> frag:string -> Brr_canvas.Gl.program
7
+
(** [program gl ~vert ~frag] links a shader program from source strings. *)
8
+
9
+
val earth_vertex : string
10
+
(** [earth_vertex] is the globe dot cloud vertex shader source. *)
11
+
12
+
val earth_fragment : string
13
+
(** [earth_fragment] is the globe dot cloud fragment shader source. *)
14
+
15
+
val star_vertex : string
16
+
(** [star_vertex] is the star field vertex shader source. *)
17
+
18
+
val star_fragment : string
19
+
(** [star_fragment] is the star field fragment shader source. *)
+66
webgl/stars.ml
+66
webgl/stars.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Star field background: random small white points on a far sphere. *)
7
+
8
+
open Brr
9
+
open Brr_canvas
10
+
11
+
type t = {
12
+
prog : Gl.program;
13
+
vao : Gl.vertex_array_object;
14
+
count : int;
15
+
u_projection : Gl.uniform_location;
16
+
u_view : Gl.uniform_location;
17
+
}
18
+
19
+
let v ?(count = 2000) ?(distance = 50.0) gl =
20
+
let data = Array.make (count * 4) 0. in
21
+
let seed = ref 12345 in
22
+
let rand () =
23
+
seed := !seed * 1103515245 + 12345;
24
+
Float.of_int (abs (!seed / 65536 mod 32768)) /. 32768.
25
+
in
26
+
for i = 0 to count - 1 do
27
+
let theta = acos (1. -. (2. *. rand ())) in
28
+
let phi = 2. *. Float.pi *. rand () in
29
+
let off = i * 4 in
30
+
data.(off) <- distance *. sin theta *. cos phi;
31
+
data.(off + 1) <- distance *. cos theta;
32
+
data.(off + 2) <- distance *. sin theta *. sin phi;
33
+
data.(off + 3) <- 0.3 +. (0.7 *. rand ())
34
+
done;
35
+
let buf_data = Tarray.of_float_array Tarray.Float32 data in
36
+
let prog =
37
+
Shader.program gl ~vert:Shader.star_vertex ~frag:Shader.star_fragment
38
+
in
39
+
let vao = Gl.create_vertex_array gl in
40
+
Gl.bind_vertex_array gl (Some vao);
41
+
let vbo = Gl.create_buffer gl in
42
+
Gl.bind_buffer gl Gl.array_buffer (Some vbo);
43
+
Gl.buffer_data gl Gl.array_buffer buf_data Gl.static_draw;
44
+
Gl.enable_vertex_attrib_array gl 0;
45
+
Gl.vertex_attrib_pointer gl 0 3 Gl.float false 16 0;
46
+
Gl.enable_vertex_attrib_array gl 1;
47
+
Gl.vertex_attrib_pointer gl 1 1 Gl.float false 16 12;
48
+
Gl.bind_vertex_array gl None;
49
+
{
50
+
prog;
51
+
vao;
52
+
count;
53
+
u_projection =
54
+
Gl.get_uniform_location gl prog (Jstr.of_string "u_projection");
55
+
u_view = Gl.get_uniform_location gl prog (Jstr.of_string "u_view");
56
+
}
57
+
58
+
let draw gl t ~projection ~view =
59
+
Gl.use_program gl t.prog;
60
+
let proj_arr = Tarray.of_float_array Tarray.Float32 projection in
61
+
let view_arr = Tarray.of_float_array Tarray.Float32 view in
62
+
Gl.uniform_matrix4fv gl t.u_projection false proj_arr;
63
+
Gl.uniform_matrix4fv gl t.u_view false view_arr;
64
+
Gl.bind_vertex_array gl (Some t.vao);
65
+
Gl.draw_arrays gl Gl.points 0 t.count;
66
+
Gl.bind_vertex_array gl None
+12
webgl/stars.mli
+12
webgl/stars.mli
···
1
+
(** Star field background: random small white points on a far sphere. *)
2
+
3
+
type t
4
+
(** Opaque star field renderer state. *)
5
+
6
+
val v : ?count:int -> ?distance:float -> Brr_canvas.Gl.t -> t
7
+
(** [v ?count ?distance gl] creates a star field with [count] stars
8
+
(default 2000) at [distance] (default 50.0). *)
9
+
10
+
val draw :
11
+
Brr_canvas.Gl.t -> t -> projection:float array -> view:float array -> unit
12
+
(** [draw gl t ~projection ~view] renders the star field. *)