Merge pull request #235 from ocsigen/mouse-events

Adapt to Dom_html changes

Author: vouillon

.github/workflows/build.yml

@@ -3,6 +3,8 @@ name: Build
 on:
   pull_request:
   push:
+    branches:
+      - master
   schedule:
     # Prime the caches every Monday
     - cron: 0 1 * * MON
@@ -42,6 +44,8 @@ jobs:
         if: runner.os == 'macOS'
         run: brew update && brew reinstall openssl@3
 
+      - run: opam pin add -n eliom https://github.com/ocsigen/eliom.git
+
       - run: opam install . --deps-only
 
       - run: opam exec -- make

opam

@@ -14,7 +14,7 @@ install: [ make "install" ]
 available: arch != "x86_32" & arch != "arm32"
 depends: [
   "ocaml" {>= "4.08.0"}
-  "js_of_ocaml" {>= "5.5.0"}
+  "js_of_ocaml" {>= "6.0.0"}
   "eliom" {>= "11.0.0"}
   "calendar" {>= "2.0.0"}
 ]

src/widgets/ot_carousel.eliom

@@ -76,8 +76,9 @@ let average_time = 0.1
 
 type status =
   | Stopped
-  | Start of (int * int * float) (* Just started, x, y positions, timestamp *)
-  | Ongoing of (int * int * int * float * int * float)
+  | Start of (float * float * float)
+    (* Just started, x, y positions, timestamp *)
+  | Ongoing of (float * float * int * float * float * float)
 
 (* Ongoing swipe, (x start position,
                        y start position,
@@ -189,7 +190,7 @@ let%shared make ?(a = []) ?(vertical = false) ?(position = 0)
        let maxi () = ~%maxi - React.S.value ~%nb_visible_elements + 1 in
        let pos_signal = ~%pos_signal in
        let pos_set = ~%pos_set in
-       let action = ref (`Move (0, 0)) in
+       let action = ref (`Move (0., 0)) in
        let animation_frame_requested = ref false in
        (**********************
        setting class active on visible pages (only)
@@ -349,17 +350,21 @@ let%shared make ?(a = []) ?(vertical = false) ?(position = 0)
                            React.S.value ~%pos_signal * width_element
                          in
                          let m = (-width_element * maxi ()) + global_delta in
-                         min global_delta (max delta m)
+                         min (float global_delta) (max delta (float m))
                      in
                      let pos = Eliom_shared.React.S.value pos_signal in
-                     ~%swipe_pos_set (-.float delta /. float width_element);
-                     let s = ~%make_transform ~vertical ~delta pos in
+                     ~%swipe_pos_set (-.delta /. float width_element);
+                     let s =
+                       ~%make_transform ~vertical
+                         ~delta:(int_of_float (delta +. 0.5))
+                         pos
+                     in
                      (Js.Unsafe.coerce d2'##.style)##.transform := s;
                      (Js.Unsafe.coerce d2'##.style)##.webkitTransform := s
                  | `Goback position | `Change position ->
                      Manip.Class.add ~%d2 ot_swiping;
                      set_top_margin ();
-                     action := `Move (0, 0);
+                     action := `Move (0., 0);
                      set_position ~transitionend:unset_top_margin position);
                  Lwt.return_unit)
                else Lwt.return_unit)
@@ -373,7 +378,7 @@ let%shared make ?(a = []) ?(vertical = false) ?(position = 0)
            if delta_t = 0.
            then prev_speed
            else
-             let cur_speed = (float delta -. float prev_delta) /. delta_t in
+             let cur_speed = (delta -. prev_delta) /. delta_t in
              if delta_t >= average_time
              then cur_speed
              else
@@ -386,14 +391,17 @@ let%shared make ?(a = []) ?(vertical = false) ?(position = 0)
        let onpan ev _ =
          (match !status with
          | Start (startx, starty, prev_timestamp) ->
-             let move = if vertical then clY ev - starty else clX ev - startx in
+             let move =
+               if vertical then clY ev -. starty else clX ev -. startx
+             in
              status :=
-               if abs (if vertical then clX ev - startx else clY ev - starty)
-                  >= abs move
+               if abs_float
+                    (if vertical then clX ev -. startx else clY ev -. starty)
+                  >= abs_float move
                then
                  Stopped
                  (* swiping in wrong direction (vertical/horizontal) *)
-               else if abs move > Ot_swipe.threshold
+               else if abs_float move > Ot_swipe.threshold
                then (
                  (* We decide to take the event *)
                  (* We send a touchcancel to the parent
@@ -404,9 +412,7 @@ let%shared make ?(a = []) ?(vertical = false) ?(position = 0)
                  remove_transition d2';
                  let timestamp = now () in
                  let delta_t = timestamp -. prev_timestamp in
-                 let speed =
-                   if delta_t = 0. then 0. else float move /. delta_t
-                 in
+                 let speed = if delta_t = 0. then 0. else move /. delta_t in
                  Ongoing
                    (startx, starty, width_element (), speed, move, timestamp))
                else !status
@@ -424,7 +430,7 @@ let%shared make ?(a = []) ?(vertical = false) ?(position = 0)
              (* in case there is a carousel
                                          in a carousel, e.g. *)
              let delta =
-               if vertical then clY ev - starty else clX ev - startx
+               if vertical then clY ev -. starty else clX ev -. startx
              in
              let timestamp, speed =
                compute_speed prev_speed prev_delta prev_timestamp delta
@@ -445,16 +451,18 @@ let%shared make ?(a = []) ?(vertical = false) ?(position = 0)
          status := Stopped;
          let width, delta =
            if vertical
-           then d2'##.offsetHeight, clY ev - starty
-           else d2'##.offsetWidth, clX ev - startx
+           then d2'##.offsetHeight, clY ev -. starty
+           else d2'##.offsetWidth, clX ev -. startx
          in
          let timestamp, speed =
            compute_speed prev_speed prev_delta prev_timestamp delta
          in
          let pos = Eliom_shared.React.S.value pos_signal in
          let delta =
-           delta
-           + (int_of_float (speed *. ~%transition_duration *. ~%inertia) / 2)
+           int_of_float
+             (delta
+             +. (speed *. ~%transition_duration *. ~%inertia /. 2.)
+             +. 0.5)
          in
          let rem = delta mod width in
          let nbpages =
@@ -475,7 +483,7 @@ let%shared make ?(a = []) ?(vertical = false) ?(position = 0)
        let touchend ev _ =
          match !status with
          | Start (startx, starty, timestamp) ->
-             do_end ev startx starty 0. 0 timestamp
+             do_end ev startx starty 0. 0. timestamp
          | Ongoing (startx, starty, _width, speed, delta, timestamp) ->
              do_end ev startx starty speed delta timestamp
          | _ -> Lwt.return_unit
@@ -549,7 +557,7 @@ let%shared default_fail_fun e =
     let e = Printexc.to_string e in
     ignore
       [%client
-        (Firebug.console##error
+        (Console.console##error
            (Js.string ("Ot_carousel content failed with " ^ ~%e))
          : unit)];
     em ~a:[a_class ["ot-icon-error"]] []

src/widgets/ot_drawer.eliom

@@ -30,14 +30,14 @@ type%client status = Stopped | Start | Aborted | In_progress
 let%client clX ev =
   Js.Optdef.case
     ev ##. changedTouches ## (item 0)
-    (fun () -> 0)
-    (fun a -> a##.clientX)
+    (fun () -> 0.)
+    (fun a -> Js.to_float a##.clientX)
 
 let%client clY ev =
   Js.Optdef.case
     ev ##. changedTouches ## (item 0)
-    (fun () -> 0)
-    (fun a -> a##.clientY)
+    (fun () -> 0.)
+    (fun a -> Js.to_float a##.clientY)
 
 let%client bind_click_outside bckgrnd elt close =
   Lwt.async (fun () ->
@@ -79,7 +79,7 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
     ?(onopen : (unit -> unit) Eliom_client_value.t option)
     ?(wrap_close = fun f -> f) ?(wrap_open = fun f -> f) content
   =
-  let scroll_pos = ref 0 in
+  let scroll_pos = ref 0. in
   let a = (a :> Html_types.div_attrib attrib list) in
   let toggle_button =
     D.Form.button_no_value ~button_type:`Button
@@ -112,7 +112,7 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
     [%client
       (fun () ->
          Dom_html.document##.body##.style##.top := Js.string "";
-         Dom_html.window##scroll 0 !(~%scroll_pos)
+         Dom_html.window##scrollTo (Js.float 0.) (Js.float !(~%scroll_pos))
        : unit -> unit)]
   in
   let stop_open_event =
@@ -141,11 +141,11 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
   let open_ =
     [%client
       (fun () ->
-         ~%scroll_pos := (Js.Unsafe.coerce Dom_html.window)##.pageYOffset;
+         ~%scroll_pos := Js.to_float Dom_html.window##.scrollY;
          add_class ~%bckgrnd "open";
          Eliom_lib.Option.iter (fun f -> f ()) ~%onopen;
          Dom_html.document##.body##.style##.top
-         := Js.string (Printf.sprintf "%dpx" (- !(~%scroll_pos)));
+         := Js.string (Printf.sprintf "%.2fpx" (-. !(~%scroll_pos)));
          add_class ~%bckgrnd "opening";
          Lwt.cancel !(~%touch_thread);
          Lwt.async (fun () ->
@@ -195,7 +195,7 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
          let bckgrnd' = To_dom.of_element ~%bckgrnd in
          let cl = ~%close in
          let animation_frame_requested = ref false in
-         let action = ref (`Move 0) in
+         let action = ref (`Move 0.) in
          let perform_animation a =
            if !action = `Close && a = `Open
            then
@@ -216,7 +216,7 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
                        | `Right -> "translateX(calc(-100% + "
                        | `Bottom -> "translateY(calc(-100% + "
                        | `Left -> "translateX(calc(100% + ")
-                     |> (fun t -> Printf.sprintf "%s%dpx" t delta)
+                     |> (fun t -> Printf.sprintf "%s%.2fdpx" t delta)
                      |> Js.string
                    in
                    (Js.Unsafe.coerce dr##.style)##.transform := s;
@@ -247,24 +247,24 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
              else Lwt.return_unit)
          in
          (* let hammer = Hammer.make_hammer bckgrnd in *)
-         let startx = ref 0 (* position when touch starts *) in
-         let starty = ref 0 (* position when touch starts *) in
+         let startx = ref 0. (* position when touch starts *) in
+         let starty = ref 0. (* position when touch starts *) in
          let status = ref Stopped in
          let onpan ev _ =
-           let left = clX ev - !startx in
-           let top = clY ev - !starty in
+           let left = clX ev -. !startx in
+           let top = clY ev -. !starty in
            if !status = Start
            then
              status :=
                if (~%position = `Top || ~%position = `Bottom)
-                  && abs left > abs top
+                  && abs_float left > abs_float top
                   || (~%position = `Left || ~%position = `Right)
-                     && abs top > abs left
+                     && abs_float top > abs_float left
                then Aborted (* Orthogonal scrolling *)
                else if (~%position = `Top || ~%position = `Bottom)
-                       && abs top <= Ot_swipe.threshold
+                       && abs_float top <= Ot_swipe.threshold
                        || (~%position = `Left || ~%position = `Right)
-                          && abs left <= Ot_swipe.threshold
+                          && abs_float left <= Ot_swipe.threshold
                then !status
                else (
                  (* We decide to take the event *)
@@ -276,20 +276,20 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
            then (
              Dom.preventDefault ev;
              Dom_html.stopPropagation ev;
-             let move = ref 0 in
-             if ~%position = `Top && top <= 0
+             let move = ref 0. in
+             if ~%position = `Top && top <= 0.
                 &&
                 (move := top;
                  true)
-                || ~%position = `Right && left >= 0
+                || ~%position = `Right && left >= 0.
                    &&
                    (move := left;
                     true)
-                || ~%position = `Bottom && top >= 0
+                || ~%position = `Bottom && top >= 0.
                    &&
                    (move := top;
                     true)
-                || ~%position = `Left && left <= 0
+                || ~%position = `Left && left <= 0.
                    &&
                    (move := left;
                     true)
@@ -304,8 +304,8 @@ let%shared drawer ?(a = []) ?(position = `Left) ?(opened = false)
              (Js.Unsafe.coerce dr##.style)##.transition
              := Js.string "-webkit-transform .35s, transform .35s";
              let width = dr##.offsetWidth in
-             let deltaX = float_of_int (clX ev - !startx) in
-             let deltaY = float_of_int (clY ev - !starty) in
+             let deltaX = clX ev -. !startx in
+             let deltaY = clY ev -. !starty in
              if (~%position = `Top && deltaY < -0.3 *. float width)
                 || (~%position = `Right && deltaX > 0.3 *. float width)
                 || (~%position = `Bottom && deltaY > 0.3 *. float width)

src/widgets/ot_nodeready.eliom

@@ -40,7 +40,7 @@ let log ~n:node s =
   if not debug
   then ()
   else (
-    (* Firebug.console##log(node); *)
+    (* Console.console##log(node); *)
     ignore node;
     print_endline
     @@ Printf.sprintf "Ot_nodeready: %s; watching %n elements" s

src/widgets/ot_nodeready.eliomi

@@ -27,7 +27,7 @@ val nodeready : #Dom.node Js.t -> unit Lwt.t
 
     {3 Example}
 
-    [let _ = nodeready node in Firebug.console##debug node]
+    [let _ = nodeready node in Console.console##debug node]
 
     {3 Known issues}
 

src/widgets/ot_noderesize.eliom

@@ -70,20 +70,20 @@ let%client detach {watched; sensor; shrink_listener_id; grow_listener_id; _} =
   match shrink_listener_id with Some x -> Dom.removeEventListener x | _ -> ()
 
 let%client reset {grow; grow_child; shrink; _} =
-  shrink##.scrollLeft := shrink##.scrollWidth;
-  shrink##.scrollTop := shrink##.scrollHeight;
+  shrink##.scrollLeft := Js.float (float shrink##.scrollWidth);
+  shrink##.scrollTop := Js.float (float shrink##.scrollHeight);
   grow_child##.style##.width
   := Js.string (string_of_int (grow##.offsetWidth + 1) ^ "px");
   grow_child##.style##.height
   := Js.string (string_of_int (grow##.offsetHeight + 1) ^ "px");
-  grow##.scrollLeft := grow##.scrollWidth;
-  grow##.scrollTop := grow##.scrollHeight
+  grow##.scrollLeft := Js.float (float grow##.scrollWidth);
+  grow##.scrollTop := Js.float (float grow##.scrollHeight)
 
 let%client reset_opt {grow; grow_child; shrink; _} =
-  shrink##.scrollLeft := 9999;
-  shrink##.scrollTop := 9999;
-  grow##.scrollLeft := 9999;
-  grow##.scrollTop := 9999
+  shrink##.scrollLeft := Js.float 9999.;
+  shrink##.scrollTop := Js.float 9999.;
+  grow##.scrollLeft := Js.float 9999.;
+  grow##.scrollTop := Js.float 9999.
 
 let%client noderesize_aux reset sensor f =
   let bind element =
@@ -95,15 +95,16 @@ let%client noderesize_aux reset sensor f =
          if not !throttle
          then (
            throttle := true;
-           Dom_html._requestAnimationFrame
-             ( Js.wrap_callback @@ fun _ ->
-               let w' = element##.offsetWidth in
-               let h' = element##.offsetHeight in
-               if w' <> !w || h' <> !h then f ();
-               w := w';
-               h := h';
-               reset sensor;
-               throttle := false ));
+           ignore
+             (Dom_html.window##requestAnimationFrame
+                ( Js.wrap_callback @@ fun _ ->
+                  let w' = element##.offsetWidth in
+                  let h' = element##.offsetHeight in
+                  if w' <> !w || h' <> !h then f ();
+                  w := w';
+                  h := h';
+                  reset sensor;
+                  throttle := false )));
          Js.bool true))
       (Js.bool false)
   in

src/widgets/ot_noderesize.eliomi

@@ -49,7 +49,7 @@ open Js_of_ocaml
         let div' = (To_dom.of_element div) in
         let%lwt () = Ot_nodeready.nodeready div' in
         Ot_noderesize.noderesize (ot_noderesize.attach div) (fun () ->
-          Firebug.console##log (Js.string "Resized") ) )]} *)
+          Console.console##log (Js.string "Resized") ) )]} *)
 
 type resize_sensor