From 507278f613949886a94de40d9a1acedc4f41f658 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fre=CC=81de=CC=81ric=20Bour?= Date: Sun, 29 Oct 2023 17:51:52 +0900 Subject: [PATCH] brr-lwd: add test for set of classes Inspired by the discussions at https://discuss.ocaml.org/t/a-board-of-binary-switches-with-brr-lwd/13321 --- examples/cssclasstest-brr/Makefile | 8 ++++ examples/cssclasstest-brr/dune | 21 ++++++++++ examples/cssclasstest-brr/index.html | 27 +++++++++++++ examples/cssclasstest-brr/main.ml | 57 ++++++++++++++++++++++++++++ 4 files changed, 113 insertions(+) create mode 100644 examples/cssclasstest-brr/Makefile create mode 100644 examples/cssclasstest-brr/dune create mode 100644 examples/cssclasstest-brr/index.html create mode 100644 examples/cssclasstest-brr/main.ml diff --git a/examples/cssclasstest-brr/Makefile b/examples/cssclasstest-brr/Makefile new file mode 100644 index 0000000..ec5737a --- /dev/null +++ b/examples/cssclasstest-brr/Makefile @@ -0,0 +1,8 @@ +ROOT=$(realpath $(PWD)/../..) + +all: + dune build index.html main.js + @echo "open $(ROOT)/_build/default/examples/focustest-brr/index.html" + +clean: + dune clean diff --git a/examples/cssclasstest-brr/dune b/examples/cssclasstest-brr/dune new file mode 100644 index 0000000..03131bb --- /dev/null +++ b/examples/cssclasstest-brr/dune @@ -0,0 +1,21 @@ +(executables + (names main) + (libraries js_of_ocaml brr lwd brr-lwd) + (modes byte)) + +(rule + (targets main.js) + (action + (run + %{bin:js_of_ocaml} + --noruntime + %{lib:js_of_ocaml-compiler:runtime.js} + --source-map + %{dep:main.bc} + -o + %{targets} + --pretty))) + +(alias + (name default) + (deps main.js index.html)) diff --git a/examples/cssclasstest-brr/index.html b/examples/cssclasstest-brr/index.html new file mode 100644 index 0000000..41b943c --- /dev/null +++ b/examples/cssclasstest-brr/index.html @@ -0,0 +1,27 @@ + + + + + Minesweeper + + + + + +
+ + diff --git a/examples/cssclasstest-brr/main.ml b/examples/cssclasstest-brr/main.ml new file mode 100644 index 0000000..0175ef6 --- /dev/null +++ b/examples/cssclasstest-brr/main.ml @@ -0,0 +1,57 @@ +open Brr +open Brr_lwd + +type square = On | Off + +let flip = function On -> Off | Off -> On + +let class_of_state = + function + | On -> Jstr.v "square-on" + | Off -> Jstr.v "square-off" + +let lwd_table_row_map ~f row = + Lwd_table.get row |> Option.iter (fun v -> Lwd.set v (f (Lwd.peek v))) + +let ui = + let squares = Lwd_table.make () in + let add_square () = + let row = Lwd_table.append squares in + Lwd_table.set row (Lwd.var Off) + in + for _ = 1 to 20 * 25 do + add_square () + done; + let board = + Lwd_table.map_reduce + (fun row state -> + Lwd_seq.element @@ + Elwd.div + ~at:[ + `P (At.class' (Jstr.v "square")); + `R ((Lwd.map ~f:(fun x -> At.class' (class_of_state x)) (Lwd.get state))); + ] + ~ev:[ + `P (Elwd.handler Ev.click + (fun _ -> lwd_table_row_map row ~f:(fun state -> flip state))) + ] + [] + ) + Lwd_seq.monoid + squares + in + Elwd.div ~at:[ `P (At.class' (Jstr.v "game-board")) ] [ + `S (Lwd_seq.lift board) + ] + +let () = + let ui = Lwd.observe ui in + let on_invalidate _ = + ignore @@ G.request_animation_frame @@ fun _ -> + ignore @@ Lwd.quick_sample ui + in + let on_load _ = + El.append_children (Document.body G.document) [ Lwd.quick_sample ui ]; + Lwd.set_on_invalidate ui on_invalidate + in + ignore @@ Ev.listen Ev.dom_content_loaded on_load (Window.as_target G.window)