diff --git a/.github/workflows/playwright.yml b/.github/workflows/playwright.yml index 6af805c8..d13cf791 100644 --- a/.github/workflows/playwright.yml +++ b/.github/workflows/playwright.yml @@ -34,7 +34,7 @@ jobs: # In Playwright's Docker image, so that the rendering is the same as when # the screenshots were generated - name: Run Playwright tests - run: ./playwright-docker.sh + run: opam exec -- ./playwright-docker.sh - uses: actions/upload-artifact@v4 if: ${{ !cancelled() }} diff --git a/CHANGELOG.md b/CHANGELOG.md index 30331856..2994b41c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,8 @@ - Precompiled binaries for macOS no longer rely on Homebrew libraries (#146) - Fixed some blurriness in Chrome related to zooming (#286) +- Fixed wrong coordinates when focusing on drawings in fast mode (#287) +- Improved drawing performance, especially in fast mode (#287) ## [v0.13.0] Juraslip Park (Satursday, the 5th of September, 2026) diff --git a/src/engine/runtime/drawing/drawing_controller/preview.ml b/src/engine/runtime/drawing/drawing_controller/preview.ml index 373b5ec5..a10112f9 100644 --- a/src/engine/runtime/drawing/drawing_controller/preview.ml +++ b/src/engine/runtime/drawing/drawing_controller/preview.ml @@ -3,49 +3,30 @@ open Drawing_state open Brr_lwd let ( !! ) = Jstr.v +let empty_d = Lwd.pure (Brr.At.v (Jstr.v "d") Jstr.empty) -let pfo_options width = - let size = width in - Perfect_freehand.Options.v ~thinning:0.5 ~smoothing:0.5 ~size ~streamline:0.5 - ~last:true () - -let make_d ~elapsed_time path path_to_svg = - (* TODO: DO NOT DELETE THIS COMMENT! *) - (* let$* end_at = end_at in *) - (* let$* should_continue = *) - (* (\* I was hoping that when a value does not change, the recomputation *) - (* stops. See https://github.com/let-def/lwd/issues/55 *\) *) - (* let$ elapsed_time = elapsed_time in *) - (* elapsed_time <= end_at *) - (* in *) - let with_path path = - (* Brr.Console.(log [ "offset_x"; offset.x ]); *) - let path = - List.map fst - (* (fun ((x, y), _) -> *) - (* ( x -. (offset.x -. 2000. -. (offset.width /. 2.)), *) - (* y -. (offset.y -. 2000. -. (offset.height /. 2.)) )) *) - path - in - let v = path_to_svg path in - Brr.At.v (Jstr.v "d") v - in - let$* path = Lwd.get path in +let d ~elapsed_time ~starts_at ~end_at ~final_d ~scale ~path kind = match elapsed_time with - | None -> Lwd.pure @@ with_path path - | Some elapsed_time -> - let$ elapsed_time = elapsed_time in - let path = List.filter (fun (_, t) -> t < elapsed_time) path in - with_path path + | None -> final_d + | Some elapsed_time' -> + (* Built once, so that the bind below only chooses between existing + nodes, instead of building a new graph at each change of time. *) + let partial = + Drawing_state.Path_editing.make_d kind ~elapsed_time ~scale path + in + let$* starts_at = starts_at + and$ end_at = end_at + and$ elapsed_time' = elapsed_time' in + if end_at < elapsed_time' then final_d + else if elapsed_time' <= starts_at then empty_d + else partial -let pen_attributes ~width ~elapsed_time ~scale ~path ~erased ~color ~id - ~selected ~preselected = +let pen_attributes ~starts_at ~end_at ~final_d ~width ~elapsed_time ~scale ~path + ~erased ~color ~id ~selected ~preselected = let at = let d = let$* width = Lwd.get width in - make_d ~elapsed_time path @@ fun path -> - let options = pfo_options width in - Drawing_state.Path_editing.pfo_svg_path options scale path + d ~elapsed_time ~starts_at ~end_at ~final_d ~scale ~path (`Pfh width) in let fill = let$ color = @@ -108,13 +89,10 @@ let pen_attributes ~width ~elapsed_time ~scale ~path ~erased ~color ~id in Elwd.v ~ns:`SVG ~at ~st (Jstr.v "path") [] -let highlight_attributes ~elapsed_time ~width ~path ~color ~selected - ~preselected ~erased ~scale ~id = +let highlight_attributes ~starts_at ~end_at ~final_d ~elapsed_time ~width ~path + ~color ~selected ~preselected ~erased ~scale ~id = let at = - let d = - make_d ~elapsed_time path @@ fun path -> - Drawing_state.Path_editing.svg_path scale path - in + let d = d ~elapsed_time ~starts_at ~end_at ~final_d ~scale ~path `Normal in let stroke = let$ width = let$ width = Lwd.get width in @@ -185,21 +163,22 @@ let create_elem_of_stroke ~elapsed_time width; stroker; path; - end_at = _; - starts_at = _; + end_at; + starts_at; selected; preselected; track = _; erased; + final_d; } = let$* scale = Lwd.get scale in match stroker with | Highlighter -> - highlight_attributes ~scale ~color ~id ~width ~path ~selected ~preselected - ~erased ~elapsed_time + highlight_attributes ~starts_at ~end_at ~final_d ~scale ~color ~id ~width + ~path ~selected ~preselected ~erased ~elapsed_time | Pen -> - pen_attributes ~scale ~color ~id ~width ~path ~selected ~preselected - ~erased ~elapsed_time + pen_attributes ~starts_at ~end_at ~final_d ~scale ~color ~id ~width ~path + ~selected ~preselected ~erased ~elapsed_time let draw ~elapsed_time strokes = Lwd_table.map_reduce diff --git a/src/engine/runtime/drawing/drawing_controller/tools.ml b/src/engine/runtime/drawing/drawing_controller/tools.ml index edd9dda9..1b2275c8 100644 --- a/src/engine/runtime/drawing/drawing_controller/tools.ml +++ b/src/engine/runtime/drawing/drawing_controller/tools.ml @@ -96,25 +96,10 @@ module Draw_stroke = struct [ (Translation.forward translation x y, now () -. started_time) ] in let el = - let path = Lwd.var path in let { Universe.Coordinates.scale; _ } = Universe.State.get_coord () in let scale = scale *. translation.scale in - let end_at = Lwd.map (Lwd.get path) ~f:end_at in - let starts_at = Lwd.map (Lwd.get path) ~f:starts_at in - { - id; - scale = Lwd.var scale; - path; - end_at; - starts_at; - color = Lwd.var color; - stroker; - width = Lwd.var width; - selected = Lwd.var false; - preselected = Lwd.var false; - track = Lwd.var 0; - erased = Lwd.var None; - } + Drawing_state.make_stro ~id ~scale ~path ~color ~width ~stroker ~track:0 + ~erased:None in Lwd_table.append' strokes el; (started_time, el, translation) diff --git a/src/engine/runtime/drawing/drawing_state/drawing_state.ml b/src/engine/runtime/drawing/drawing_state/drawing_state.ml index 6e461f43..4cbb7355 100644 --- a/src/engine/runtime/drawing/drawing_state/drawing_state.ml +++ b/src/engine/runtime/drawing/drawing_state/drawing_state.ml @@ -178,39 +178,46 @@ let play ?(speedup = 1.) ?(continue = fun () -> `Continue) ~finish state = Lwd.set state.time next_time; finish () in - let rec loop _ = + let if_continue f = match continue () with | `Stop -> () | `Skip_to_next_pause -> skip_to_next_pause () - | `Continue -> ( - let frame = now () in - let time_before = time_of !previous_frame in - let new_time = time_of frame in - previous_frame := frame; - let crossed_pause = - Lwd_table.fold - (fun acc pause -> - let at = Lwd.peek pause.p_at in - if time_before < at && at <= new_time then - match acc with - | Some earliest when earliest < at -> acc - | _ -> Some at - else acc) - None state.recording.pauses - in - match crossed_pause with - | Some at -> - Lwd.set state.time at; - finish () - | None -> - if new_time > max_time then ( - Lwd.set state.time max_time; - finish ()) - else ( - Lwd.set state.time new_time; - let _animation_frame_id = Brr.G.request_animation_frame loop in - ())) + | `Continue -> f () + in + let rec loop _ = + if_continue @@ fun () -> + let frame = now () in + let time_before = time_of !previous_frame in + let new_time = time_of frame in + previous_frame := frame; + let crossed_pause = + Lwd_table.fold + (fun acc pause -> + let at = Lwd.peek pause.p_at in + if time_before < at && at <= new_time then + match acc with + | Some earliest when earliest < at -> acc + | _ -> Some at + else acc) + None state.recording.pauses + in + match crossed_pause with + | Some at -> + Lwd.set state.time at; + finish () + | None -> + if new_time > max_time then ( + Lwd.set state.time max_time; + finish ()) + else ( + Lwd.set state.time new_time; + let _animation_frame_id = Brr.G.request_animation_frame loop in + ()) in + (* Do not wait for a frame when we are not going to animate anything (e.g. in + fast mode): this would make fast-forwarding wait for one frame per drawing + action. *) + if_continue @@ fun () -> let _animation_frame_id = Brr.G.request_animation_frame loop in () diff --git a/src/engine/runtime/drawing/drawing_state/json.ml b/src/engine/runtime/drawing/drawing_state/json.ml index 1051c281..0b911ef4 100644 --- a/src/engine/runtime/drawing/drawing_state/json.ml +++ b/src/engine/runtime/drawing/drawing_state/json.ml @@ -64,6 +64,7 @@ module V1 = struct preselected = _; track; erased; + final_d = _; } = `List [ @@ -91,28 +92,9 @@ module V1 = struct ] -> let ( let* ) x y = Result.bind x y in let* path = to_path path in - let path = Lwd.var path in - let starts_at l = List.hd (List.rev l) |> snd in - let end_at l = List.hd l |> snd in - let end_at = Lwd.map (Lwd.get path) ~f:end_at in - let starts_at = Lwd.map (Lwd.get path) ~f:starts_at in - let* stroker = to_stroker stroker in let* erased = to_erased erased in - Ok - { - id; - scale = Lwd.var scale; - path; - end_at; - starts_at; - color = Lwd.var color; - stroker; - width = Lwd.var width; - selected = Lwd.var false; - preselected = Lwd.var false; - track = Lwd.var track; - erased = Lwd.var erased; - } + let* stroker = to_stroker stroker in + Ok (make_stro ~id ~scale ~path ~color ~width ~stroker ~track ~erased) | _ -> Error () let of_strokes strokes = diff --git a/src/engine/runtime/drawing/drawing_state/path_editing.ml b/src/engine/runtime/drawing/drawing_state/path_editing.ml index 4451c113..427c5f60 100644 --- a/src/engine/runtime/drawing/drawing_state/path_editing.ml +++ b/src/engine/runtime/drawing/drawing_state/path_editing.ml @@ -113,3 +113,34 @@ let svg_path scale path = :: List.map (fun (x, y) -> Format.sprintf "L %f,%f" x y) rest in String.concat " " res |> Jstr.of_string + +let pfo_options width = + let size = width in + Perfect_freehand.Options.v ~thinning:0.5 ~smoothing:0.5 ~size ~streamline:0.5 + ~last:true () + +let make_d_with ~elapsed_time path path_to_svg = + let open Lwd_infix in + let with_path path = + let path = List.map fst path in + let v = path_to_svg path in + Brr.At.v (Jstr.v "d") v + in + let$* path = Lwd.get path in + match elapsed_time with + | None -> Lwd.pure @@ with_path path + | Some elapsed_time -> + let$ elapsed_time = elapsed_time in + let path = List.filter (fun (_, t) -> t < elapsed_time) path in + with_path path + +let make_d kind ~elapsed_time ~scale path = + let path_to_svg = + match kind with + | `Pfh width -> + fun path -> + let options = pfo_options width in + pfo_svg_path options scale path + | `Normal -> fun path -> svg_path scale path + in + make_d_with ~elapsed_time path path_to_svg diff --git a/src/engine/runtime/drawing/drawing_state/types.ml b/src/engine/runtime/drawing/drawing_state/types.ml index 2d96f4b6..46e9b61a 100644 --- a/src/engine/runtime/drawing/drawing_state/types.ml +++ b/src/engine/runtime/drawing/drawing_state/types.ml @@ -32,8 +32,46 @@ type stro = { preselected : bool Lwd.var; track : int Lwd.var; erased : erased option Lwd.var; + final_d : Brr.At.t Lwd.t; } +let make_stro ~id ~scale ~path ~color ~stroker ~width ~track ~erased = + let scale = Lwd.var scale + and path = Lwd.var path + and color = Lwd.var color + and width = Lwd.var width + and selected = Lwd.var false + and preselected = Lwd.var false + and track = Lwd.var track + and erased = Lwd.var erased in + let starts_at l = List.hd (List.rev l) |> snd in + let end_at l = List.hd l |> snd in + let end_at = Lwd.map (Lwd.get path) ~f:end_at in + let starts_at = Lwd.map (Lwd.get path) ~f:starts_at in + let final_d = + let open Lwd_infix in + let$* width = Lwd.get width and$ scale = Lwd.get scale in + let kind = + match stroker with Pen -> `Pfh width | Highlighter -> `Normal + in + Path_editing.make_d kind ~elapsed_time:None ~scale path + in + { + id; + scale; + path; + end_at; + starts_at; + color; + stroker; + width; + selected; + preselected; + track; + erased; + final_d; + } + type strokes = stro Lwd_table.t type pause = { diff --git a/test/README.md b/test/README.md index f085efb2..ef077745 100644 --- a/test/README.md +++ b/test/README.md @@ -16,14 +16,6 @@ dune test Browser tests take the form of screenshot tests, implemented using [playwright visual tests](https://playwright.dev/docs/test-snapshots). -Running the tests is done in two steps, from the `screenshot-based` folder. - -First, generate the HTML files of all tests with dune: - -```shell -dune build --profile release -``` - Each test folder has a `dune` file that compiles its `.slp` and `.md` entries to HTML files next to them, with the same base name. When adding an entry to a `run.json`, add the corresponding rule. @@ -31,7 +23,7 @@ to HTML files next to them, with the same base name. When adding an entry to a Then, run the tests in [Playwright's Docker image](https://playwright.dev/docs/docker). Browser rendering depends on the fonts and libraries of the host, so using the same image everywhere ensures that the screenshots are the same locally and in -the CI. This only requires Docker, not OCaml nor the Playwright browsers: +the CI. This requires Docker. ```shell ./playwright-docker.sh diff --git a/test/screenshot-based/drawing-focus-fast-mode/drawing.draw b/test/screenshot-based/drawing-focus-fast-mode/drawing.draw new file mode 100644 index 00000000..0b441afd --- /dev/null +++ b/test/screenshot-based/drawing-focus-fast-mode/drawing.draw @@ -0,0 +1,3 @@ +v1 +This file has been generated by slipshow! The line above gives the version of the syntax for the file, the line below is the actual content. Beware when modifying! +["anchored",[["id295983711",1.0000079987126542,[[559.6214926161293,481.58715592348074,4152.0],[559.6214926161293,481.58715592348074,4120.0],[558.8377543276972,481.58715592348074,4103.0],[558.0540160392652,481.58715592348074,4087.0],[554.9190628855365,483.1546325003448,4070.0],[549.4328948665122,487.0733239425055,4053.0],[538.4605588284627,493.34323024996235,4036.0],[535.325605674734,495.6944451152585,4020.0],[525.1370079251169,500.39687484585124,4002.0],[511.02971873333917,504.31556628801144,3987.0],[495.3549529646973,507.4505194417401,3970.0],[479.6801871960555,507.4505194417401,3952.0],[464.0054214274132,507.4505194417401,3937.0],[452.249347100932,507.4505194417401,3919.0],[445.19570250504313,505.0993045764435,3905.0],[439.70953448601836,500.39687484585124,3889.0],[439.70953448601836,496.47818340369054,3872.0],[439.70953448601836,493.34323024996235,3855.0],[439.70953448601836,487.8570622309376,3838.0],[441.2770110628824,486.28958565407345,3822.0],[443.6282259281786,485.50584736564144,3804.0],[444.4119642166106,485.50584736564144,3787.0],[445.9794407934752,485.50584736564144,3770.0],[456.1680385430923,485.50584736564144,3753.0],[463.2216831389811,486.28958565407345,3735.0],[475.7614957538948,489.42453880780164,3720.0],[484.38261692664776,492.5594919615303,3702.0],[491.43626152253665,499.6131365574192,3686.0],[494.5712146762653,505.88304286487556,3669.0],[493.7874763878328,514.5041640376289,3653.0],[491.43626152253665,522.3415469219499,3636.0],[481.24766377291957,534.0976212484316,3621.0],[474.1940191770307,538.0163126905918,3603.0],[466.35663629270977,540.3675275558884,3586.0],[456.9517768315243,540.3675275558884,3569.0],[448.3306556587713,538.8000509790238,3553.0],[438.9257961975863,532.530144671567,3536.0],[433.4396281785615,527.0439766525421,3519.0],[431.0884133132654,523.125285210382,3502.0],[428.7371984479688,513.7204257491969,3485.0],[428.7371984479688,508.23425773017215,3469.0],[428.7371984479688,504.31556628801144,3452.0],[428.7371984479688,498.8293982689871,3436.0],[431.0884133132654,494.91070682682647,3420.0],[434.2233664669936,490.9920153846662,3403.0],[438.9257961975863,487.0733239425055,3386.0],[442.0607493513145,487.0733239425055,3369.0],[445.9794407934752,487.0733239425055,3355.0],[462.43794485054906,495.6944451152585,3304.0],[462.43794485054906,497.2619216921226,3286.0],[462.43794485054906,500.39687484585124,3269.0],[462.43794485054906,501.18061313428325,3253.0],[459.30299169682087,505.88304286487556,3235.0],[457.7355151199568,507.4505194417401,3220.0],[455.3843002546602,509.80173430703627,3203.0],[453.8168236777961,511.36921088390034,3187.0],[452.249347100932,512.1529491723328,3169.0],[451.4656088124995,512.1529491723328,3152.0],[449.1143939472034,512.9366874607649,3136.0],[445.9794407934752,513.7204257491969,3120.0],[440.4932727744504,515.287902326061,3105.0],[438.1420579091543,515.287902326061,3086.0],[431.87215160169745,517.6391171913572,3069.0],[427.1697218711047,519.2065937682218,3055.0],[423.25103042894403,522.3415469219499,3038.0],[417.76486240991966,526.2602383641101,3021.0],[413.846170967759,529.3951915178388,3002.0],[409.92747952559876,534.0976212484316,2669.0],[407.5762646603022,532.530144671567,2653.0],[403.6575732181419,530.1789298062708,2635.0],[396.603928622253,524.692761787246,2620.0],[388.7665457379321,516.8553789029252,2603.0],[384.8478542957714,509.80173430703627,2587.0],[378.5779479883146,500.39687484585124,2571.0],[377.0104714114505,494.91070682682647,2554.0],[373.0917799692898,483.1546325003448,2536.0],[373.0917799692898,473.74977303915983,2519.0],[373.87551825772186,463.5611752895423,2503.0],[373.87551825772186,448.6701478093325,2487.0],[377.0104714114505,435.3465969059872,2472.0],[381.7129011420432,424.37426086793766,2454.0],[387.9828074494996,408.6994950992958,2436.0],[394.25271375695644,398.5108973496783,2418.0],[400.5226200644133,392.2409910422215,2402.0],[408.3600029487342,388.3222996000612,2385.0],[415.41364754462353,388.3222996000612,2370.0],[418.5486006983517,389.88977617692535,2357.0],[419.3323389867838,391.4572527537894,2352.0],[424.0347687173765,412.61818654145605,2302.0],[422.467292140512,426.7254757332338,2285.0],[416.98112412148765,450.237624386197,2268.0],[413.846170967759,463.5611752895423,2252.0],[406.7925263718701,476.884726192888,2235.0],[395.0364520453885,493.34323024996235,2219.0],[388.7665457379321,500.39687484585124,2202.0],[381.7129011420432,507.4505194417401,2186.0],[373.0917799692898,510.5854725954683,2169.0],[366.03813537340096,513.7204257491969,2153.0],[351.93084618162317,518.4228554797892,2136.0],[344.09346329730226,518.4228554797892,2118.0],[337.82355698984543,518.4228554797892,2102.0],[328.4186975286604,512.1529491723328,2085.0],[324.5000060864997,508.23425773017215,2069.0],[322.14879122120357,505.0993045764435,2051.0],[320.5813146443395,498.8293982689871,2035.0],[319.79757635590744,490.9920153846662,2019.0],[319.0138380674754,482.3708942119128,2001.0],[319.0138380674754,466.69612844327094,1986.0],[319.79757635590744,458.85874555895003,1968.0],[320.5813146443395,443.1839797903082,1953.0],[323.7162677980677,424.37426086793766,1935.0],[326.85122095179634,411.05070996459193,1918.0],[332.3373889708211,398.5108973496783,1902.0],[340.174771855142,387.53856131162917,1885.0],[348.01215473946297,381.26865500417233,1868.0],[355.8495376237839,378.1337018504437,1852.0],[361.33570564280865,378.1337018504437,1835.0],[366.82187366183297,381.26865500417233,1819.0],[373.87551825772186,388.3222996000612,1801.0],[377.7942096998826,393.808467619086,1785.0],[379.36168627674664,404.78080365713515,1768.0],[376.22673312301845,425.1579991563697,1752.0],[369.9568268155616,443.1839797903082,1735.0],[360.5519673543766,465.1286518664068,1721.0],[345.66093987416633,493.34323024996235,1704.0],[326.85122095179634,516.071640614493,1684.0],[315.87888491374673,525.4765000756781,1668.0],[304.90654887569764,530.9626680947028,1651.0],[293.9342128376481,533.3138829599994,1635.0],[286.09682995332713,530.9626680947028,1618.0],[277.47570878057417,526.2602383641101,1601.0],[270.42206418468527,516.8553789029252,1586.0],[265.71963445409256,512.9366874607649,1574.0],[261.8009430119323,508.23425773017215,1551.0],[257.0985132813396,499.6131365574192,1535.0],[252.39608355074685,492.5594919615303,1518.0],[250.04486868545072,485.50584736564144,1501.0],[250.04486868545072,476.10098790445596,1484.0],[252.39608355074685,469.8310815969991,1468.0],[255.5310367044755,464.3449135779748,1454.0],[261.8009430119323,459.64248384738204,1437.0],[270.42206418468527,455.7237924052214,1421.0],[277.47570878057417,455.7237924052214,1402.0],[287.66430653019125,461.9936987126782,1385.0],[290.7992596839199,467.479866731703,1370.0],[290.01552139548784,488.64080051936963,1353.0],[272.77327904998145,515.287902326061,1302.0],[266.5033727425246,519.2065937682218,1285.0],[259.4497281466357,520.7740703450858,1269.0],[250.82860697388276,521.5578086335179,1252.0],[239.85627093583318,521.5578086335179,1235.0],[229.66767318621612,518.4228554797892,1219.0],[224.18150516719135,515.287902326061,1204.0],[219.4790754365986,509.80173430703627,1187.0],[213.20916912914177,501.9643514227153,1169.0],[209.29047768698155,494.91070682682647,1154.0],[205.3717862448213,489.42453880780164,1135.0],[201.45309480266062,480.8034176350487,1118.0],[199.1018799373645,474.53351132759184,1102.0],[193.61571191833968,468.263605020135,1085.0],[187.34580561088285,464.3449135779748,1068.0],[182.64337588029014,464.3449135779748,1050.0],[176.3734695728333,465.1286518664068,1035.0],[172.45477813067305,467.479866731703,1018.0],[165.40113353478418,472.1822964622957,1002.0],[163.0499186694876,476.10098790445596,986.0],[160.69870380419144,481.58715592348074,969.0],[159.13122722732734,487.8570622309376,954.0],[155.9962740735987,498.8293982689871,934.0],[155.9962740735987,507.4505194417401,918.0],[159.9149655157594,515.287902326061,884.0],[159.9149655157594,514.5041640376289,868.0],[159.9149655157594,512.9366874607649,851.0],[159.9149655157594,510.5854725954683,835.0],[159.9149655157594,507.4505194417401,819.0],[159.9149655157594,501.9643514227153,801.0],[159.9149655157594,494.1269685383944,784.0],[159.9149655157594,484.7221090772089,767.0],[159.9149655157594,477.6684644813205,751.0],[160.69870380419144,471.39855817386365,735.0],[162.26618038105553,452.5888392514932,721.0],[163.0499186694876,441.6165032134436,701.0],[163.0499186694876,429.86042888696244,684.0],[163.0499186694876,411.834448253024,668.0],[163.0499186694876,402.42958879183897,651.0],[163.83365695792008,385.97108473476464,634.0],[165.40113353478418,377.3499635620117,618.0],[170.8873015538085,367.1613658123946,601.0],[176.3734695728333,361.6751977933698,585.0],[181.07589930342604,359.3239829280737,569.0],[187.34580561088285,358.5402446396416,553.0],[195.96692678363584,358.5402446396416,534.0],[204.5880479563888,360.89145950493776,518.0],[211.64169255227768,364.02641265866595,501.0],[220.2628137250311,372.64753383141937,484.0],[224.18150516719135,383.6198698694685,468.0],[224.18150516719135,389.1060378884933,451.0],[222.61402859032725,398.5108973496783,435.0],[221.04655201346316,407.9157568108638,420.0],[217.12786057130248,419.67183113734495,403.0],[214.77664570600632,425.9417374448018,384.0],[210.07421597541358,432.99538204069063,367.0],[203.80430966795674,441.6165032134436,350.0],[181.07589930342604,465.1286518664068,304.0],[170.8873015538085,470.61481988543164,284.0],[160.69870380419144,476.10098790445596,267.0],[154.4287974967346,479.2359410581846,252.0],[144.24019974711754,482.3708942119128,235.0],[142.672723170253,483.1546325003448,0.0]],"blue","pen",10.0,0,null]],4152.0,994353032,"drawing.draw",[]] \ No newline at end of file diff --git a/test/screenshot-based/drawing-focus-fast-mode/dune b/test/screenshot-based/drawing-focus-fast-mode/dune new file mode 100644 index 00000000..0447fcda --- /dev/null +++ b/test/screenshot-based/drawing-focus-fast-mode/dune @@ -0,0 +1,6 @@ +(rule + (target presentation.html) + (deps presentation.slp drawing.draw) + (mode promote) + (action + (run %{bin:slipshow} compile %{dep:presentation.slp} -o %{target}))) diff --git a/test/screenshot-based/drawing-focus-fast-mode/presentation.slp b/test/screenshot-based/drawing-focus-fast-mode/presentation.slp new file mode 100644 index 00000000..eaf80de1 --- /dev/null +++ b/test/screenshot-based/drawing-focus-fast-mode/presentation.slp @@ -0,0 +1,3 @@ +![](drawing.draw){draw} + +{focus=id295983711} diff --git a/test/screenshot-based/drawing-focus-fast-mode/run.json b/test/screenshot-based/drawing-focus-fast-mode/run.json new file mode 100644 index 00000000..dfaa1029 --- /dev/null +++ b/test/screenshot-based/drawing-focus-fast-mode/run.json @@ -0,0 +1,3 @@ +[ + { "entry": "presentation.slp", "steps": [0, 2] } +] diff --git a/test/screenshot-based/drawing-focus-fast-mode/screenshots/presentation-step-00-chromium-linux.png b/test/screenshot-based/drawing-focus-fast-mode/screenshots/presentation-step-00-chromium-linux.png new file mode 100644 index 00000000..90ea802d Binary files /dev/null and b/test/screenshot-based/drawing-focus-fast-mode/screenshots/presentation-step-00-chromium-linux.png differ diff --git a/test/screenshot-based/drawing-focus-fast-mode/screenshots/presentation-step-00-firefox-linux.png b/test/screenshot-based/drawing-focus-fast-mode/screenshots/presentation-step-00-firefox-linux.png new file mode 100644 index 00000000..fcadcd6a Binary files /dev/null and b/test/screenshot-based/drawing-focus-fast-mode/screenshots/presentation-step-00-firefox-linux.png differ diff --git a/test/screenshot-based/drawing-focus-fast-mode/screenshots/presentation-step-02-chromium-linux.png b/test/screenshot-based/drawing-focus-fast-mode/screenshots/presentation-step-02-chromium-linux.png new file mode 100644 index 00000000..67b3036c Binary files /dev/null and b/test/screenshot-based/drawing-focus-fast-mode/screenshots/presentation-step-02-chromium-linux.png differ diff --git a/test/screenshot-based/drawing-focus-fast-mode/screenshots/presentation-step-02-firefox-linux.png b/test/screenshot-based/drawing-focus-fast-mode/screenshots/presentation-step-02-firefox-linux.png new file mode 100644 index 00000000..4a2f0181 Binary files /dev/null and b/test/screenshot-based/drawing-focus-fast-mode/screenshots/presentation-step-02-firefox-linux.png differ diff --git a/test/screenshot-based/playwright-docker.sh b/test/screenshot-based/playwright-docker.sh index 2914d92b..1106019b 100755 --- a/test/screenshot-based/playwright-docker.sh +++ b/test/screenshot-based/playwright-docker.sh @@ -7,6 +7,8 @@ set -e cd "$(dirname "$0")" +dune build --profile release + # The image must have the same version of Playwright as the one installed by # `npm ci`, otherwise it does not contain the right browsers. VERSION=$(grep -A1 '"node_modules/@playwright/test"' package-lock.json | diff --git a/vendor/github.com/panglesd/lwd/lib/brr-lwd/elwd.ml b/vendor/github.com/panglesd/lwd/lib/brr-lwd/elwd.ml index 323f2b8c..4bc5dd8f 100644 --- a/vendor/github.com/panglesd/lwd/lib/brr-lwd/elwd.ml +++ b/vendor/github.com/panglesd/lwd/lib/brr-lwd/elwd.ml @@ -177,15 +177,20 @@ let pure_unit = Lwd.pure () let dummy_kv_at = (Jstr.empty, Jstr.empty) -let attach l set_kv unset_kv to_kv dummy = +let equal_jstr_kv (k, v) (k', v') = Jstr.equal k k' && Jstr.equal v v' + +let attach l set_kv unset_kv to_kv equal_kv dummy = let set_lwd () = let prev = ref dummy in fun x -> - if !prev != dummy then - unset_kv !prev; let kv = to_kv x in - set_kv kv; - prev := kv + if !prev != dummy && equal_kv !prev kv then () + else begin + if !prev != dummy then + unset_kv !prev; + set_kv kv; + prev := kv + end in Lwd_utils.map_reduce (function | `P _ -> assert false @@ -226,7 +231,7 @@ let attach_attribs el attribs = then El.set_class v false el else El.set_at k None el in - attach attribs set_at unset_at At.to_pair dummy_kv_at + attach attribs set_at unset_at At.to_pair equal_jstr_kv dummy_kv_at let attach_style el styles = let set_st (k,v) = @@ -235,7 +240,7 @@ let attach_style el styles = let unset_st (k,_) = El.remove_inline_style k el in - attach styles set_st unset_st Fun.id dummy_kv_at + attach styles set_st unset_st Fun.id equal_jstr_kv dummy_kv_at let attach_prop el props = let set_prop (k,v) = @@ -254,7 +259,9 @@ let attach_prop el props = [Jv.undefined] *) () in - attach props set_prop unset_prop Fun.id (Jstr.v "", Jv.undefined) + attach props set_prop unset_prop Fun.id + (fun (k, v) (k', v') -> Jstr.equal k k' && v == v') + (Jstr.v "", Jv.undefined) let listen el (Handler {opts; type'; func}) = Ev.listen ?opts type' func (El.as_target el) @@ -464,21 +471,23 @@ let wbr = void_cons Name.wbr type root = t Lwd.root +let queue_microtask = + let queue_microtask = Jv.get Jv.global "queueMicrotask" in + fun f -> + ignore (Jv.apply queue_microtask [| Jv.callback ~arity:1 (fun _ -> f ()) |]) + let insert first_insert anchor reactive = let root = Lwd.observe reactive in let last_element = ref (Lwd.quick_sample root) in first_insert anchor [!last_element]; let on_invalidate _ = - let _ : int = - G.request_animation_frame @@ fun _ -> - let new_element = Lwd.quick_sample root in - if !last_element = new_element then () - else ( - El.insert_siblings `Replace !last_element [ new_element ]; - last_element := new_element - ) - in - () + queue_microtask @@ fun () -> + let new_element = Lwd.quick_sample root in + if !last_element = new_element then () + else ( + El.insert_siblings `Replace !last_element [ new_element ]; + last_element := new_element + ) in Lwd.set_on_invalidate root on_invalidate; root @@ -504,11 +513,8 @@ let set_children el children = let root = Lwd.observe reactive in let _el = Lwd.quick_sample root in let on_invalidate _ = - let _ : int = - G.request_animation_frame @@ fun _ -> - let _el = Lwd.quick_sample root in - () - in + queue_microtask @@ fun () -> + let _el = Lwd.quick_sample root in () in Lwd.set_on_invalidate root on_invalidate;