From 6175fba521db181e14c62b7b0bbb72b22fd50d8e Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Fri, 14 Mar 2025 17:24:07 +0100 Subject: [PATCH 1/2] Access everything without gesture on mobile --- src/compiler/lib/slipshow.ml | 5 + src/engine/controller.ml | 98 ++++++++++--------- src/engine/drawing/drawing.css | 3 +- src/engine/normalization/normalization.css | 1 + src/engine/normalization/normalization.ml | 9 ++ src/engine/step/step.css | 4 + .../table_of_content/table_of_content.ml | 14 ++- .../table_of_content/table_of_content.mli | 1 + src/engine/themes/default.css | 56 ++++++++++- 9 files changed, 140 insertions(+), 51 deletions(-) diff --git a/src/compiler/lib/slipshow.ml b/src/compiler/lib/slipshow.ml index 7d0724b..5523f1c 100644 --- a/src/compiler/lib/slipshow.ml +++ b/src/compiler/lib/slipshow.ml @@ -64,6 +64,11 @@ let embed_in_page content ~has_math ~math_link ~slip_css_link ~slipshow_js_link +
+
←
+
⇱
+
→
+
0
diff --git a/src/engine/controller.ml b/src/engine/controller.ml index 8ad2902..e3bd5b3 100644 --- a/src/engine/controller.ml +++ b/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 diff --git a/src/engine/drawing/drawing.css b/src/engine/drawing/drawing.css index 04ebe15..0c0761f 100644 --- a/src/engine/drawing/drawing.css +++ b/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; diff --git a/src/engine/normalization/normalization.css b/src/engine/normalization/normalization.css index 3d921c4..86f2005 100644 --- a/src/engine/normalization/normalization.css +++ b/src/engine/normalization/normalization.css @@ -5,6 +5,7 @@ body { bottom: 0; right: 0; display: flex; + flex-direction: row-reverse; } #slipshow-main { diff --git a/src/engine/normalization/normalization.ml b/src/engine/normalization/normalization.ml index f2bb3a9..66b08e2 100644 --- a/src/engine/normalization/normalization.ml +++ b/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+ () = diff --git a/src/engine/step/step.css b/src/engine/step/step.css index 6cd2b49..c015ede 100644 --- a/src/engine/step/step.css +++ b/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; } diff --git a/src/engine/table_of_content/table_of_content.ml b/src/engine/table_of_content/table_of_content.ml index 028976c..504dafd 100644 --- a/src/engine/table_of_content/table_of_content.ml +++ b/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 + () diff --git a/src/engine/table_of_content/table_of_content.mli b/src/engine/table_of_content/table_of_content.mli index e874b89..6a41ae3 100644 --- a/src/engine/table_of_content/table_of_content.mli +++ b/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 diff --git a/src/engine/themes/default.css b/src/engine/themes/default.css index 4a3556b..442c37c 100644 --- a/src/engine/themes/default.css +++ b/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; +} From 6fcb9c1673e890826dc3ccadae8734e41bd25780 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Thu, 20 Mar 2025 09:17:24 +0100 Subject: [PATCH 2/2] Add changelog check --- .github/workflows/changelog.yml | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 .github/workflows/changelog.yml diff --git a/.github/workflows/changelog.yml b/.github/workflows/changelog.yml new file mode 100644 index 0000000..e36209e --- /dev/null +++ b/.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