Skip to content

Commit 129bcb8

Browse files
vouillonhhugo
vouillon
authored and
hhugo
committed
Dom_html: update type of mouse events and touch events
Many properties are now specified to be numbers rather than integers. https://drafts.csswg.org/cssom-view/#extensions-to-the-mouseevent-interface https://w3c.github.io/touch-events/#dom-touch
1 parent 7c729ae commit 129bcb8

File tree

6 files changed

+81
-73
lines changed

6 files changed

+81
-73
lines changed

‎examples/graph_viewer/viewer_js.ml‎

Lines changed: 13 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -238,23 +238,23 @@ class adjustment
238238
end
239239

240240
let handle_drag element f =
241-
let mx = ref 0 in
242-
let my = ref 0 in
241+
let mx = ref 0. in
242+
let my = ref 0. in
243243
element##.onmousedown :=
244244
Html.handler (fun ev ->
245-
mx := ev##.clientX;
246-
my := ev##.clientY;
245+
mx := Js.to_float ev##.clientX;
246+
my := Js.to_float ev##.clientY;
247247
element##.style##.cursor := Js.string "move";
248248
let c1 =
249249
Html.addEventListener
250250
Html.document
251251
Html.Event.mousemove
252252
(Html.handler (fun ev ->
253-
let x = ev##.clientX and y = ev##.clientY in
253+
let x = Js.to_float ev##.clientX and y = Js.to_float ev##.clientY in
254254
let x' = !mx and y' = !my in
255255
mx := x;
256256
my := y;
257-
f (x - x') (y - y');
257+
f (x -. x') (y -. y');
258258
Js._true))
259259
Js._true
260260
in
@@ -431,12 +431,13 @@ Firebug.console##log(Js.string "sleep");
431431
sadj#set_value (float (height - pos') *. sadj#upper /. float height);
432432
rescale 0.5 0.5)
433433
in
434-
handle_drag thumb (fun _dx dy -> set_slider_position (min height (max 0 (!pos + dy))));
434+
handle_drag thumb (fun _dx dy ->
435+
set_slider_position (min height (max 0 (!pos + int_of_float dy))));
435436
slider##.onmousedown :=
436437
Html.handler (fun ev ->
437-
let ey = ev##.clientY in
438+
let ey = Js.to_float ev##.clientY in
438439
let _, sy = Dom_html.elementClientPosition slider in
439-
set_slider_position (max 0 (min height (ey - sy - (size / 2))));
440+
set_slider_position (max 0 (min height (int_of_float ey - sy - (size / 2))));
440441
Js._false);
441442
let adjust_slider () =
442443
let pos' = height - truncate ((sadj#value *. float height /. sadj#upper) +. 0.5) in
@@ -454,7 +455,7 @@ Firebug.console##log(Js.string "sleep");
454455
handle_drag canvas (fun dx dy ->
455456
let scale = get_scale () in
456457
let offset a d =
457-
a#set_value (min (a#value -. (float d /. scale)) (a#upper -. a#page_size))
458+
a#set_value (min (a#value -. (d /. scale)) (a#upper -. a#page_size))
458459
in
459460
offset hadj dx;
460461
offset vadj dy;
@@ -478,8 +479,8 @@ Firebug.console##log(Js.string "sleep");
478479
canvas
479480
(fun ev ~dx:_ ~dy ->
480481
let ex, ey = Dom_html.elementClientPosition canvas in
481-
let x = float (ev##.clientX - ex) in
482-
let y = float (ev##.clientY - ey) in
482+
let x = Js.to_float ev##.clientX -. float ex in
483+
let y = Js.to_float ev##.clientY -. float ey in
483484
if dy < 0
484485
then bump_scale x y 1.
485486
else if dy > 0

‎examples/hyperbolic/hypertree.ml‎

Lines changed: 20 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -296,10 +296,10 @@ let _debug_msg _s = ()
296296
*)
297297

298298
let handle_drag element move stop click =
299-
let fuzz = 4 in
299+
let fuzz = 4. in
300300
element##.onmousedown :=
301301
Html.handler (fun ev ->
302-
let x0 = ev##.clientX and y0 = ev##.clientY in
302+
let x0 = Js.to_float ev##.clientX and y0 = Js.to_float ev##.clientY in
303303
(*
304304
debug_msg (Format.sprintf "Mouse down %d %d" x0 y0);
305305
*)
@@ -309,11 +309,12 @@ debug_msg (Format.sprintf "Mouse down %d %d" x0 y0);
309309
Html.document
310310
Html.Event.mousemove
311311
(Html.handler (fun ev ->
312-
let x = ev##.clientX and y = ev##.clientY in
312+
let x = Js.to_float ev##.clientX and y = Js.to_float ev##.clientY in
313313
(*
314314
debug_msg (Format.sprintf "Mouse move %d %d %d %d" x0 y0 x y);
315315
*)
316-
if (not !started) && (abs (x - x0) > fuzz || abs (y - y0) > fuzz)
316+
if (not !started)
317+
&& (abs_float (x -. x0) > fuzz || abs_float (y -. y0) > fuzz)
317318
then (
318319
started := true;
319320
element##.style##.cursor := Js.string "move");
@@ -337,14 +338,14 @@ debug_msg (Format.sprintf "Mouse up %d %d %d %d" x0 y0 ev##clientX ev##clientY);
337338
if !started
338339
then (
339340
element##.style##.cursor := Js.string "";
340-
stop ev##.clientX ev##.clientY)
341-
else click ev##.clientX ev##.clientY;
341+
stop (Js.to_float ev##.clientX) (Js.to_float ev##.clientY))
342+
else click (Js.to_float ev##.clientX) (Js.to_float ev##.clientY);
342343
Js._true))
343344
Js._true);
344345
Js._true)
345346

346347
let handle_touch_events element move stop cancel click =
347-
let fuzz = 4 in
348+
let fuzz = 4. in
348349
ignore
349350
(Html.addEventListener
350351
element
@@ -354,7 +355,8 @@ let handle_touch_events element move stop cancel click =
354355
(ev##.changedTouches##item 0)
355356
(fun touch ->
356357
let id = touch##.identifier in
357-
let x0 = touch##.clientX and y0 = touch##.clientY in
358+
let x0 = Js.to_float touch##.clientX
359+
and y0 = Js.to_float touch##.clientY in
358360
(*
359361
debug_msg (Format.sprintf "Touch start %d %d" x0 y0);
360362
*)
@@ -370,12 +372,14 @@ debug_msg (Format.sprintf "Touch start %d %d" x0 y0);
370372
(fun touch ->
371373
if touch##.identifier = id
372374
then (
373-
let x = touch##.clientX and y = touch##.clientY in
375+
let x = Js.to_float touch##.clientX
376+
and y = Js.to_float touch##.clientY in
374377
(*
375378
debug_msg (Format.sprintf "Touch move %d %d %d %d" x0 y0 x y);
376379
*)
377380
if (not !started)
378-
&& (abs (x - x0) > fuzz || abs (y - y0) > fuzz)
381+
&& (abs_float (x -. x0) > fuzz
382+
|| abs_float (y -. y0) > fuzz)
379383
then (
380384
started := true;
381385
element##.style##.cursor := Js.string "move");
@@ -399,7 +403,8 @@ debug_msg (Format.sprintf "Touch start %d %d" x0 y0);
399403
(fun touch ->
400404
if touch##.identifier = id
401405
then (
402-
let x = touch##.clientX and y = touch##.clientY in
406+
let x = Js.to_float touch##.clientX
407+
and y = Js.to_float touch##.clientY in
403408
(*
404409
debug_msg (Format.sprintf "Touch end %d %d %d %d" x0 y0 x y);
405410
*)
@@ -577,7 +582,7 @@ let to_screen z = ((z.x +. 1.) *. r, (z.y +. 1.) *. r)
577582
*)
578583
let from_screen canvas x y =
579584
let rx, ry, dx, dy = screen_transform canvas in
580-
let z = { x = (float x -. dx) /. rx; y = (float y -. dy) /. ry } in
585+
let z = { x = (x -. dx) /. rx; y = (y -. dy) /. ry } in
581586
let n = norm z in
582587
if n <= 1. -. eps then z else sdiv z (n /. (1. -. eps))
583588

@@ -1620,10 +1625,8 @@ debug_msg (Format.sprintf "Resize %d %d" w h);
16201625
let p = ref (-1) in
16211626
for i = 0 to Array.length boxes.bw - 1 do
16221627
if Array.unsafe_get boxes.bw i > 0.
1623-
&& abs_float (float x -. Array.unsafe_get boxes.bx i)
1624-
< Array.unsafe_get boxes.bw i
1625-
&& abs_float (float y -. Array.unsafe_get boxes.by i)
1626-
< Array.unsafe_get boxes.bh i
1628+
&& abs_float (x -. Array.unsafe_get boxes.bx i) < Array.unsafe_get boxes.bw i
1629+
&& abs_float (y -. Array.unsafe_get boxes.by i) < Array.unsafe_get boxes.bh i
16271630
then p := i
16281631
done;
16291632
!p
@@ -1644,7 +1647,7 @@ debug_msg (Format.sprintf "Resize %d %d" w h);
16441647
in
16451648
canvas##.onmousemove :=
16461649
Html.handler (fun ev ->
1647-
update_cursor ev##.clientX ev##.clientY;
1650+
update_cursor (Js.to_float ev##.clientX) (Js.to_float ev##.clientY);
16481651
Js._false);
16491652
handle_drag
16501653
canvas

‎examples/planet/planet.ml‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -683,23 +683,23 @@ let start _ =
683683
p##.innerHTML :=
684684
Js.string "Credit: <a href='http://visibleearth.nasa.gov/'>Visual Earth</a>, Nasa";
685685
add doc##.body p;
686-
let mx = ref 0 in
687-
let my = ref 0 in
686+
let mx = ref 0. in
687+
let my = ref 0. in
688688
canvas##.onmousedown :=
689689
Dom_html.handler (fun ev ->
690-
mx := ev##.clientX;
691-
my := ev##.clientY;
690+
mx := Js.to_float ev##.clientX;
691+
my := Js.to_float ev##.clientY;
692692
let c1 =
693693
Html.addEventListener
694694
Html.document
695695
Html.Event.mousemove
696696
(Dom_html.handler (fun ev ->
697-
let x = ev##.clientX and y = ev##.clientY in
698-
let dx = x - !mx and dy = y - !my in
699-
if dy != 0
700-
then m := matrix_mul (yz_rotation (2. *. float dy /. float width)) !m;
701-
if dx != 0
702-
then m := matrix_mul (xz_rotation (2. *. float dx /. float width)) !m;
697+
let x = Js.to_float ev##.clientX and y = Js.to_float ev##.clientY in
698+
let dx = x -. !mx and dy = y -. !my in
699+
if dy != 0.
700+
then m := matrix_mul (yz_rotation (2. *. dy /. float width)) !m;
701+
if dx != 0.
702+
then m := matrix_mul (xz_rotation (2. *. dx /. float width)) !m;
703703
mx := x;
704704
my := y;
705705
Js._true))

‎lib/js_of_ocaml/dom_html.ml‎

Lines changed: 21 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -297,17 +297,17 @@ and mouseEvent = object
297297

298298
method relatedTarget : element t opt optdef readonly_prop
299299

300-
method clientX : int readonly_prop
300+
method clientX : number_t readonly_prop
301301

302-
method clientY : int readonly_prop
302+
method clientY : number_t readonly_prop
303303

304-
method screenX : int readonly_prop
304+
method screenX : number_t readonly_prop
305305

306-
method screenY : int readonly_prop
306+
method screenY : number_t readonly_prop
307307

308-
method offsetX : int readonly_prop
308+
method offsetX : number_t readonly_prop
309309

310-
method offsetY : int readonly_prop
310+
method offsetY : number_t readonly_prop
311311

312312
method ctrlKey : bool t readonly_prop
313313

@@ -325,9 +325,9 @@ and mouseEvent = object
325325

326326
method toElement : element t opt optdef readonly_prop
327327

328-
method pageX : int optdef readonly_prop
328+
method pageX : number_t optdef readonly_prop
329329

330-
method pageY : int optdef readonly_prop
330+
method pageY : number_t optdef readonly_prop
331331
end
332332

333333
and keyboardEvent = object
@@ -421,17 +421,17 @@ and touch = object
421421

422422
method target : element t optdef readonly_prop
423423

424-
method screenX : int readonly_prop
424+
method screenX : number_t readonly_prop
425425

426-
method screenY : int readonly_prop
426+
method screenY : number_t readonly_prop
427427

428-
method clientX : int readonly_prop
428+
method clientX : number_t readonly_prop
429429

430-
method clientY : int readonly_prop
430+
method clientY : number_t readonly_prop
431431

432-
method pageX : int readonly_prop
432+
method pageX : number_t readonly_prop
433433

434-
method pageY : int readonly_prop
434+
method pageY : number_t readonly_prop
435435
end
436436

437437
and submitEvent = object
@@ -2888,14 +2888,18 @@ let eventRelatedTarget (e : #mouseEvent t) =
28882888
let eventAbsolutePosition' (e : #mouseEvent t) =
28892889
let body = document##.body in
28902890
let html = document##.documentElement in
2891-
( e##.clientX + body##.scrollLeft + html##.scrollLeft
2892-
, e##.clientY + body##.scrollTop + html##.scrollTop )
2891+
( Js.to_float e##.clientX +. Float.of_int (body##.scrollLeft + html##.scrollLeft)
2892+
, Js.to_float e##.clientY +. Float.of_int (body##.scrollTop + html##.scrollTop) )
28932893

28942894
let eventAbsolutePosition (e : #mouseEvent t) =
28952895
Optdef.case
28962896
e##.pageX
28972897
(fun () -> eventAbsolutePosition' e)
2898-
(fun x -> Optdef.case e##.pageY (fun () -> eventAbsolutePosition' e) (fun y -> x, y))
2898+
(fun x ->
2899+
Optdef.case
2900+
e##.pageY
2901+
(fun () -> eventAbsolutePosition' e)
2902+
(fun y -> Js.to_float x, Js.to_float y))
28992903

29002904
let elementClientPosition (e : #element t) =
29012905
let r = e##getBoundingClientRect in

‎lib/js_of_ocaml/dom_html.mli‎

Lines changed: 15 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -299,18 +299,18 @@ and mouseEvent = object
299299
method relatedTarget : element t opt optdef readonly_prop
300300

301301
(* Relative to viewport *)
302-
method clientX : int readonly_prop
302+
method clientX : number_t readonly_prop
303303

304-
method clientY : int readonly_prop
304+
method clientY : number_t readonly_prop
305305

306306
(* Relative to the edge of the screen *)
307-
method screenX : int readonly_prop
307+
method screenX : number_t readonly_prop
308308

309-
method screenY : int readonly_prop
309+
method screenY : number_t readonly_prop
310310

311-
method offsetX : int readonly_prop
311+
method offsetX : number_t readonly_prop
312312

313-
method offsetY : int readonly_prop
313+
method offsetY : number_t readonly_prop
314314

315315
method ctrlKey : bool t readonly_prop
316316

@@ -329,9 +329,9 @@ and mouseEvent = object
329329

330330
method toElement : element t opt optdef readonly_prop
331331

332-
method pageX : int optdef readonly_prop
332+
method pageX : number_t optdef readonly_prop
333333

334-
method pageY : int optdef readonly_prop
334+
method pageY : number_t optdef readonly_prop
335335
end
336336

337337
and keyboardEvent = object
@@ -427,17 +427,17 @@ and touch = object
427427

428428
method target : element t optdef readonly_prop
429429

430-
method screenX : int readonly_prop
430+
method screenX : number_t readonly_prop
431431

432-
method screenY : int readonly_prop
432+
method screenY : number_t readonly_prop
433433

434-
method clientX : int readonly_prop
434+
method clientX : number_t readonly_prop
435435

436-
method clientY : int readonly_prop
436+
method clientY : number_t readonly_prop
437437

438-
method pageX : int readonly_prop
438+
method pageX : number_t readonly_prop
439439

440-
method pageY : int readonly_prop
440+
method pageY : number_t readonly_prop
441441
end
442442

443443
and submitEvent = object
@@ -2591,7 +2591,7 @@ val buttonPressed : #mouseEvent Js.t -> mouse_button
25912591

25922592
(** {2 Position helper functions} *)
25932593

2594-
val eventAbsolutePosition : #mouseEvent t -> int * int
2594+
val eventAbsolutePosition : #mouseEvent t -> float * float
25952595
(** Returns the absolute position of the mouse pointer. *)
25962596

25972597
val elementClientPosition : #element t -> int * int

‎lib/lwt/graphics/graphics_js.ml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -48,12 +48,12 @@ let open_canvas x =
4848
let compute_real_pos (elt : #Dom_html.element Js.t) ev =
4949
let r = elt##getBoundingClientRect in
5050
let x =
51-
(float_of_int ev##.clientX -. Js.to_float r##.left)
51+
(Js.to_float ev##.clientX -. Js.to_float r##.left)
5252
/. (Js.to_float r##.right -. Js.to_float r##.left)
5353
*. float_of_int elt##.width
5454
in
5555
let y =
56-
(float_of_int ev##.clientY -. Js.to_float r##.top)
56+
(Js.to_float ev##.clientY -. Js.to_float r##.top)
5757
/. (Js.to_float r##.bottom -. Js.to_float r##.top)
5858
*. float_of_int elt##.height
5959
in

0 commit comments

Comments
 (0)