Skip to content

Commit d7117ff

Browse files
prekelprekel
authored
Lib: wheel event binding (#1273)
* Lib: add wheel event * Lib: rewrite addMousewheelEventListenerWithOptions * Lib: delta_mode enum instead of int * Lib: add onwheel to eventTarget * Tests: add example which uses wheel event * Misc: changes note #1272 * Lib: use mousewheelEvent instead of new wheelEvent * Lib: lwt_js for wheel * Misc: fix indentation
1 parent 5a7829a commit d7117ff

File tree

8 files changed

+123
-33
lines changed

8 files changed

+123
-33
lines changed

‎CHANGES.md

+1
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@
99
* Lib: add missing options for Intl.NumberFormat
1010
* Runtime: Implement weak semantic for weak and ephemeron
1111
* Runtime: Implement Gc.finalise_last
12+
* Lib: wheel event binding
1213

1314
## Bug fixes
1415
* Compiler: fix rewriter bug in share_constant (fix #1247)

‎examples/test_wheel/dune

+6
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
(executables
2+
(names test_wheel)
3+
(libraries js_of_ocaml)
4+
(modes js)
5+
(preprocess
6+
(pps js_of_ocaml-ppx)))

‎examples/test_wheel/index.html

+12
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
<!DOCTYPE html>
2+
<html style="height: 100%;">
3+
4+
<head>
5+
<title>test_wheel</title>
6+
<script defer type="text/javascript" src="test_wheel.bc.js"></script>
7+
</head>
8+
9+
<body>
10+
</body>
11+
12+
</html>

‎examples/test_wheel/test_wheel.ml

+36
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
open Js_of_ocaml
2+
3+
let optdef_to_string o =
4+
match Js.Optdef.to_option o with
5+
| Some v -> Int.to_string v
6+
| None -> "undefined"
7+
8+
let () =
9+
let html =
10+
Js.Opt.get
11+
(Dom_html.document##querySelector (Js.string "html"))
12+
(fun _ -> assert false)
13+
in
14+
html##.onwheel :=
15+
Dom.handler (fun (event : Dom_html.mousewheelEvent Js.t) ->
16+
Firebug.console##debug event;
17+
let deltaX = event##.deltaX in
18+
let deltaY = event##.deltaY in
19+
let deltaZ = event##.deltaZ in
20+
let deltaMode = event##.deltaMode in
21+
let wheelDelta = event##.wheelDelta in
22+
let wheelDeltaX = event##.wheelDeltaX in
23+
let wheelDeltaY = event##.wheelDeltaY in
24+
Printf.printf "deltaX: %f; " deltaX;
25+
Printf.printf "deltaY: %f; " deltaY;
26+
Printf.printf "deltaZ: %f; " deltaZ;
27+
Printf.printf
28+
"deltaMode: %s; "
29+
(match deltaMode with
30+
| Delta_pixel -> "Delta_pixel"
31+
| Delta_line -> "Delta_line"
32+
| Delta_page -> "Delta_page");
33+
Printf.printf "wheelDelta: %d; " wheelDelta;
34+
Printf.printf "wheelDeltaX: %s; " (optdef_to_string wheelDeltaX);
35+
Printf.printf "wheelDeltaY: %s\n" (optdef_to_string wheelDeltaY);
36+
Js._false)

‎lib/js_of_ocaml/dom_html.ml

+28-30
Original file line numberDiff line numberDiff line change
@@ -271,6 +271,11 @@ type mouse_button =
271271
| Middle_button
272272
| Right_button
273273

274+
type delta_mode =
275+
| Delta_pixel
276+
| Delta_line
277+
| Delta_page
278+
274279
class type event =
275280
object
276281
inherit [element] Dom.event
@@ -356,14 +361,22 @@ and keyboardEvent =
356361

357362
and mousewheelEvent =
358363
object
359-
(* All browsers but Firefox *)
364+
(* All modern browsers *)
360365
inherit mouseEvent
361366

362367
method wheelDelta : int readonly_prop
363368

364369
method wheelDeltaX : int optdef readonly_prop
365370

366371
method wheelDeltaY : int optdef readonly_prop
372+
373+
method deltaX : float readonly_prop
374+
375+
method deltaY : float readonly_prop
376+
377+
method deltaZ : float readonly_prop
378+
379+
method deltaMode : delta_mode readonly_prop
367380
end
368381

369382
and mouseScrollEvent =
@@ -495,6 +508,8 @@ and eventTarget =
495508

496509
method onscroll : ('self t, event t) event_listener writeonly_prop
497510

511+
method onwheel : ('self t, mousewheelEvent t) event_listener writeonly_prop
512+
498513
method ondragstart : ('self t, dragEvent t) event_listener writeonly_prop
499514

500515
method ondragend : ('self t, dragEvent t) event_listener writeonly_prop
@@ -793,6 +808,8 @@ module Event = struct
793808

794809
let mousewheel = Dom.Event.make "mousewheel"
795810

811+
let wheel = Dom.Event.make "wheel"
812+
796813
let _DOMMouseScroll = Dom.Event.make "DOMMouseScroll"
797814

798815
let touchstart = Dom.Event.make "touchstart"
@@ -2885,36 +2902,17 @@ let buttonPressed (ev : #mouseEvent Js.t) =
28852902
| _ -> No_button)
28862903
(fun x -> x)
28872904

2888-
let hasMousewheelEvents () =
2889-
let d = createDiv document in
2890-
d##setAttribute (Js.string "onmousewheel") (Js.string "return;");
2891-
Js.typeof (Js.Unsafe.get d (Js.string "onmousewheel")) == Js.string "function"
2892-
28932905
let addMousewheelEventListenerWithOptions e ?capture ?once ?passive h =
2894-
if hasMousewheelEvents ()
2895-
then
2896-
addEventListenerWithOptions
2897-
?capture
2898-
?once
2899-
?passive
2900-
e
2901-
Event.mousewheel
2902-
(handler (fun (e : mousewheelEvent t) ->
2903-
let dx = -Optdef.get e##.wheelDeltaX (fun () -> 0) / 40 in
2904-
let dy = -Optdef.get e##.wheelDeltaY (fun () -> e##.wheelDelta) / 40 in
2905-
h (e :> mouseEvent t) ~dx ~dy))
2906-
else
2907-
addEventListenerWithOptions
2908-
?capture
2909-
?once
2910-
?passive
2911-
e
2912-
Event._DOMMouseScroll
2913-
(handler (fun (e : mouseScrollEvent t) ->
2914-
let d = e##.detail in
2915-
if e##.axis == e##._HORIZONTAL_AXIS
2916-
then h (e :> mouseEvent t) ~dx:d ~dy:0
2917-
else h (e :> mouseEvent t) ~dx:0 ~dy:d))
2906+
addEventListenerWithOptions
2907+
?capture
2908+
?once
2909+
?passive
2910+
e
2911+
Event.wheel
2912+
(handler (fun (e : mousewheelEvent t) ->
2913+
let dx = -Optdef.get e##.wheelDeltaX (fun () -> 0) / 40 in
2914+
let dy = -Optdef.get e##.wheelDeltaY (fun () -> e##.wheelDelta) / 40 in
2915+
h (e :> mouseEvent t) ~dx ~dy))
29182916

29192917
let addMousewheelEventListener e h capt =
29202918
addMousewheelEventListenerWithOptions ~capture:capt e h

‎lib/js_of_ocaml/dom_html.mli

+20-3
Original file line numberDiff line numberDiff line change
@@ -275,6 +275,11 @@ type mouse_button =
275275
| Middle_button
276276
| Right_button
277277

278+
type delta_mode =
279+
| Delta_pixel
280+
| Delta_line
281+
| Delta_page
282+
278283
class type event =
279284
object
280285
inherit [element] Dom.event
@@ -365,14 +370,22 @@ and keyboardEvent =
365370

366371
and mousewheelEvent =
367372
object
368-
(* All browsers but Firefox *)
373+
(* All modern browsers *)
369374
inherit mouseEvent
370375

371376
method wheelDelta : int readonly_prop
372377

373378
method wheelDeltaX : int optdef readonly_prop
374379

375380
method wheelDeltaY : int optdef readonly_prop
381+
382+
method deltaX : float readonly_prop
383+
384+
method deltaY : float readonly_prop
385+
386+
method deltaZ : float readonly_prop
387+
388+
method deltaMode : delta_mode readonly_prop
376389
end
377390

378391
and mouseScrollEvent =
@@ -506,6 +519,8 @@ and eventTarget =
506519

507520
method onscroll : ('self t, event t) event_listener writeonly_prop
508521

522+
method onwheel : ('self t, mousewheelEvent t) event_listener writeonly_prop
523+
509524
method ondragstart : ('self t, dragEvent t) event_listener writeonly_prop
510525

511526
method ondragend : ('self t, dragEvent t) event_listener writeonly_prop
@@ -2353,6 +2368,8 @@ module Event : sig
23532368

23542369
val _DOMMouseScroll : mouseScrollEvent t typ
23552370

2371+
val wheel : mousewheelEvent t typ
2372+
23562373
val touchstart : touchEvent t typ
23572374

23582375
val touchmove : touchEvent t typ
@@ -2532,7 +2549,7 @@ val addMousewheelEventListenerWithOptions :
25322549
-> ?passive:bool t
25332550
-> (mouseEvent t -> dx:int -> dy:int -> bool t)
25342551
-> event_listener_id
2535-
(** Add a mousewheel event listener with option-object variant of the
2552+
(** Add a wheel event listener with option-object variant of the
25362553
[addEventListener] DOM method. The callback is provided the
25372554
event and the numbers of ticks the mouse wheel moved. Positive
25382555
means down / right. *)
@@ -2542,7 +2559,7 @@ val addMousewheelEventListener :
25422559
-> (mouseEvent t -> dx:int -> dy:int -> bool t)
25432560
-> bool t
25442561
-> event_listener_id
2545-
(** Add a mousewheel event listener with the useCapture boolean variant
2562+
(** Add a wheel event listener with the useCapture boolean variant
25462563
of the [addEventListener] DOM method. The callback is provided the
25472564
event and the numbers of ticks the mouse wheel moved. Positive
25482565
means down / right. *)

‎lib/lwt/lwt_js_events.ml

+6
Original file line numberDiff line numberDiff line change
@@ -342,6 +342,9 @@ let mousewheel ?use_capture ?passive target =
342342
make_event Dom_html.Event._DOMMouseScroll ?use_capture ?passive target
343343
*)
344344

345+
let wheel ?use_capture ?passive target =
346+
make_event Dom_html.Event.wheel ?use_capture ?passive target
347+
345348
let touchstart ?use_capture ?passive target =
346349
make_event Dom_html.Event.touchstart ?use_capture ?passive target
347350

@@ -456,6 +459,9 @@ let drops ?cancel_handler ?use_capture ?passive t =
456459
let mousewheels ?cancel_handler ?use_capture ?passive t =
457460
seq_loop mousewheel ?cancel_handler ?use_capture ?passive t
458461

462+
let wheels ?cancel_handler ?use_capture ?passive t =
463+
seq_loop wheel ?cancel_handler ?use_capture ?passive t
464+
459465
let touchstarts ?cancel_handler ?use_capture ?passive t =
460466
seq_loop touchstart ?cancel_handler ?use_capture ?passive t
461467

‎lib/lwt/lwt_js_events.mli

+14
Original file line numberDiff line numberDiff line change
@@ -362,6 +362,12 @@ val mousewheel :
362362
Positive means down or right.
363363
This interface is compatible with all (recent) browsers. *)
364364

365+
val wheel :
366+
?use_capture:bool
367+
-> ?passive:bool
368+
-> #Dom_html.eventTarget Js.t
369+
-> Dom_html.mousewheelEvent Js.t Lwt.t
370+
365371
val touchstart :
366372
?use_capture:bool
367373
-> ?passive:bool
@@ -773,6 +779,14 @@ val mousewheels :
773779
-> (Dom_html.mouseEvent Js.t * (int * int) -> unit Lwt.t -> unit Lwt.t)
774780
-> unit Lwt.t
775781

782+
val wheels :
783+
?cancel_handler:bool
784+
-> ?use_capture:bool
785+
-> ?passive:bool
786+
-> #Dom_html.eventTarget Js.t
787+
-> (Dom_html.mousewheelEvent Js.t -> unit Lwt.t -> unit Lwt.t)
788+
-> unit Lwt.t
789+
776790
val touchstarts :
777791
?cancel_handler:bool
778792
-> ?use_capture:bool

0 commit comments

Comments
 (0)