Access everything without gesture on mobile

.github/workflows/changelog.yml

@@ -0,0 +1,14 @@
+name: Check Changelog
+on:
+  pull_request:
+    types: [assigned, opened, synchronize, reopened, labeled, unlabeled]
+    branches:
+      - master
+jobs:
+  Check-Changelog:
+    name: Check Changelog Action
+    runs-on: ubuntu-latest
+    steps:
+      - uses: tarides/changelog-check-action@v3
+        with:
+          changelog: CHANGELOG.md

src/compiler/lib/slipshow.ml

@@ -64,6 +64,11 @@ let embed_in_page content ~has_math ~math_link ~slip_css_link ~slipshow_js_link
           </div>
         </div>
       </div>
+      <div id="slip-touch-controls">
+        <div class="slip-previous">←</div>
+        <div class="slip-fullscreen">⇱</div>
+        <div class="slip-next">→</div>
+      </div>
       <div id="slipshow-counter">0</div>
     </div>
 

src/engine/controller.ml

@@ -5,10 +5,7 @@ let keyboard_setup (window : Universe.Window.window) =
     let current_coord = Universe.State.get_coord () in
     let () =
       match key with
-      | "t" ->
-          let body = Brr.Document.body Brr.G.document in
-          let c = Jstr.v "slipshow-toc-mode" in
-          Brr.El.set_class c (not @@ Brr.El.class' c body) body
+      | "t" -> Table_of_content.toggle_visibility ()
       | "w" -> Drawing.State.set_tool Pen
       | "h" -> Drawing.State.set_tool Highlighter
       | "x" -> Drawing.State.set_tool Pointer
@@ -68,23 +65,57 @@ let keyboard_setup (window : Universe.Window.window) =
   ()
 
 let touch_setup (window : Universe.Window.window) =
-  let target = Brr.G.document |> Brr.Document.body |> Brr.El.as_target in
-  let start = ref None in
-  let coord_of_event ev =
-    let mouse = Brr.Ev.as_type ev |> Brr.Ev.Pointer.as_mouse in
-    let x = Brr.Ev.Mouse.client_x mouse and y = Brr.Ev.Mouse.client_y mouse in
-    (x, y)
+  let () =
+    let next =
+      Brr.El.find_first_by_selector (Jstr.v "#slip-touch-controls .slip-next")
+      |> Option.get
+    in
+    let _unlisten =
+      Brr.Ev.listen Brr.Ev.click
+        (fun _ ->
+          let _ : unit Fut.t = Step.Next.go_next window 1 in
+          ())
+        (Brr.El.as_target next)
+    in
+    ()
   in
-  let check_condition ev f =
-    let type_ = Brr.Ev.Pointer.type' (Brr.Ev.as_type ev) |> Jstr.to_string in
-    if
-      String.equal "touch" type_
-      && Drawing.State.get_tool () = Drawing.Tool.Pointer
-    then f ()
-    else ()
+  let () =
+    let prev =
+      Brr.El.find_first_by_selector
+        (Jstr.v "#slip-touch-controls .slip-previous")
+      |> Option.get
+    in
+    let _unlisten =
+      Brr.Ev.listen Brr.Ev.click
+        (fun _ ->
+          let _ : unit Fut.t = Step.Next.go_prev window 1 in
+          ())
+        (Brr.El.as_target prev)
+    in
+    ()
   in
+  let () =
+    let fullscreen =
+      Brr.El.find_first_by_selector
+        (Jstr.v "#slip-touch-controls .slip-fullscreen")
+      |> Option.get
+    in
+    let _unlisten =
+      Brr.Ev.listen Brr.Ev.click
+        (fun _ ->
+          let body = Brr.Document.body Brr.G.document in
+          let _ = Brr.El.request_fullscreen body in
+          ())
+        (Brr.El.as_target fullscreen)
+    in
+    ()
+  in
+  let target = Brr.G.document |> Brr.Document.body |> Brr.El.as_target in
   let touchstart (ev : Brr.Ev.Pointer.t Brr.Ev.t) =
     let type_ = Brr.Ev.Pointer.type' (Brr.Ev.as_type ev) |> Jstr.to_string in
+    let body = Brr.Document.body Brr.G.document in
+    if String.equal "touch" type_ then
+      Brr.El.set_class (Jstr.v "mobile") true body;
     let stop_here () =
       Brr.Ev.prevent_default ev;
       Brr.Ev.stop_immediate_propagation ev;
@@ -93,26 +124,10 @@ let touch_setup (window : Universe.Window.window) =
     if
       String.equal "touch" type_
       && Drawing.State.get_tool () = Drawing.Tool.Pointer
-    then stop_here ();
-    check_condition ev @@ fun () -> start := Some (coord_of_event ev)
+    then stop_here ()
   in
   let opts = Brr.Ev.listen_opts ~passive:false () in
   let _listener = Brr.Ev.listen ~opts Brr.Ev.pointerdown touchstart target in
-  let take_decision start (end_x, end_y) =
-    match start with
-    | None -> `None
-    | Some (start_x, start_y) ->
-        let mov_x, mov_y = (end_x -. start_x, end_y -. start_y) in
-        let mov, abs, win =
-          let abs_x = Float.abs mov_x and abs_y = Float.abs mov_y in
-          let win_x = Brr.Window.inner_width Brr.G.window |> float_of_int in
-          let win_y = Brr.Window.inner_height Brr.G.window |> float_of_int in
-          if abs_x > abs_y then (mov_x, abs_x, win_x) else (mov_y, abs_y, win_y)
-        in
-        if abs /. win < 0.1 then `None
-        else if mov <= 0. then `Forward
-        else `Backward
-  in
   let touchend (ev : Brr.Ev.Pointer.t Brr.Ev.t) =
     let type_ = Brr.Ev.Pointer.type' (Brr.Ev.as_type ev) |> Jstr.to_string in
     let stop_here () =
@@ -123,20 +138,7 @@ let touch_setup (window : Universe.Window.window) =
     if
       String.equal "touch" type_
       && Drawing.State.get_tool () = Drawing.Tool.Pointer
-    then stop_here ();
-    check_condition ev @@ fun () ->
-    let end_ = coord_of_event ev in
-    let () =
-      match take_decision !start end_ with
-      | `None -> ()
-      | `Forward ->
-          let _ : unit Fut.t = Step.Next.go_next window 1 in
-          ()
-      | `Backward ->
-          let _ : unit Fut.t = Step.Next.go_prev window 1 in
-          ()
-    in
-    start := None
+    then stop_here ()
   in
   let _listener = Brr.Ev.listen ~opts Brr.Ev.pointerup touchend target in
 

src/engine/drawing/drawing.css

@@ -12,7 +12,8 @@
 .slip-writing-toolbar:hover,
 .slipshow-drawing-mode .slip-writing-toolbar {
   width: 32px;
-  height: 640px;
+  height: min(640px, 100vh);
+  overflow: scroll;
 }
 .slip-writing-toolbar {
   background-color: white;

src/engine/normalization/normalization.css

@@ -5,6 +5,7 @@ body {
   bottom: 0;
   right: 0;
   display: flex;
+  flex-direction: row-reverse;
 }
 
 #slipshow-main {

src/engine/normalization/normalization.ml

@@ -36,7 +36,12 @@ let replace_open_window window =
   let browser_h = foi @@ Brr.El.offset_h parent in
   let browser_w = foi @@ Brr.El.offset_w parent in
   let* window_w, _window_h =
+    let body = Brr.Document.body Brr.G.document in
     if width *. browser_h < height *. browser_w then
+      let () =
+        Brr.El.set_class (Jstr.v "horizontal") false body;
+        Brr.El.set_class (Jstr.v "vertical") true body
+      in
       let window_w = browser_h *. width /. height in
       let window_h = browser_h in
       let+ () =
@@ -47,6 +52,10 @@ let replace_open_window window =
       in
       (window_w, window_h)
     else
+      let () =
+        Brr.El.set_class (Jstr.v "horizontal") true body;
+        Brr.El.set_class (Jstr.v "vertical") false body
+      in
       let window_h = browser_w *. height /. width in
       let window_w = browser_w in
       let+ () =

src/engine/step/step.css

@@ -21,4 +21,8 @@
   right: 0;
   background-color: white;
   padding: 5px;
+  font-size: 2em;
+  border: 1px solid black;
+  border-radius: 5px;
+  cursor: pointer;
 }

src/engine/table_of_content/table_of_content.ml

@@ -67,6 +67,11 @@ let categorize window step el =
   let el = entry window step ~tag_name ~content in
   (el, step)
 
+let toggle_visibility () =
+  let body = Brr.Document.body Brr.G.document in
+  let c = Jstr.v "slipshow-toc-mode" in
+  Brr.El.set_class c (not @@ Brr.El.class' c body) body
+
 let generate window root =
   let els =
     Brr.El.fold_find_by_selector ~root
@@ -80,4 +85,11 @@ let generate window root =
   in
   let els = entry window (Some 0) ~tag_name:!!"div" ~content:!!"" :: els in
   let toc_el = Brr.El.div ~at:[ Brr.At.id !!"slipshow-toc" ] els in
-  Brr.El.append_children (Brr.Document.body Brr.G.document) [ toc_el ]
+  Brr.El.append_children (Brr.Document.body Brr.G.document) [ toc_el ];
+  let _unlisten =
+    Brr.Ev.listen Brr.Ev.click
+      (fun _ -> toggle_visibility ())
+      (Brr.El.find_first_by_selector (Jstr.v "#slipshow-counter")
+      |> Option.get |> Brr.El.as_target)
+  in
+  ()

src/engine/table_of_content/table_of_content.mli

@@ -1 +1,2 @@
 val generate : Universe.Window.window -> Brr.El.t -> unit
+val toggle_visibility : unit -> unit

src/engine/themes/default.css

@@ -16,7 +16,7 @@ h1:not(#slipshow-toc h1) {
   text-align: center;
 }
 
-body {
+body.slipshow-drawing-mode {
   touch-action: pinch-zoom;
 }
 
@@ -205,3 +205,57 @@ body {
 .corollary[title]:before {
   content: "Corollary (" attr(title) ") ";
 }
+
+#slip-touch-controls {
+  display: none;
+}
+
+.mobile #slip-touch-controls {
+  display: unset;
+}
+
+.mobile.slipshow-toc-mode.horizontal #slip-touch-controls,
+.mobile.slipshow-toc-mode.vertical #slip-touch-controls {
+  display: none;
+}
+
+.mobile.horizontal #slip-touch-controls {
+  position: fixed;
+  bottom: 0;
+  width: 100%;
+  display: flex;
+  height: 10vw;
+  justify-content: space-evenly;
+}
+
+.mobile.horizontal #slip-touch-controls > div {
+  width: 10vw;
+  background: rgba(0, 0, 0, 0.3);
+  cursor: pointer;
+  color: white;
+  font-size: 10vw;
+  text-align: center;
+  vertical-align: middle;
+  line-height: 10vw;
+}
+
+.mobile.vertical #slip-touch-controls {
+  position: fixed;
+  right: 0;
+  width: 10vh;
+  display: flex;
+  height: 80vh;
+  justify-content: space-evenly;
+  flex-direction: column;
+}
+
+.mobile.vertical #slip-touch-controls > div {
+  width: 10vh;
+  background: rgba(0, 0, 0, 0.3);
+  cursor: pointer;
+  color: white;
+  font-size: 10vh;
+  text-align: center;
+  vertical-align: middle;
+  line-height: 10vh;
+}