More two state button work

voodoos · Feb 4, 2024 · a4a2f24 · a4a2f24
1 parent 4c0205c
commit a4a2f24
Show file tree

Hide file tree

Showing 5 changed files with 51 additions and 25 deletions.
diff --git a/bin/main.ml b/bin/main.ml
@@ -5,7 +5,10 @@ open! Lwd_infix
 
 let ui =
   let playlist = Lwd.var 0 in
-  let on_click _ _ = Lwd.set playlist (Lwd.peek playlist + 1) in
+  let on_click _ _ =
+    Lwd.set playlist (Lwd.peek playlist + 1);
+    Ui.Two_state_button.Toggle
+  in
   let { Ui.Two_state_button.elt = btn_mix; _ } =
     Ui.Two_state_button.make ~on_click
       [

diff --git a/bin/ui.ml b/bin/ui.ml
@@ -1,10 +1,17 @@
 open Brr_lwd_ui
 
-module Two_state_button = Button.Two_state (struct
-  let base_classes = Classes.make [ "pouet_base"; "another" ]
-  let on_classes = Classes.make [ "on" ]
-  let off_classes = Classes.make [ "off" ]
-end)
+module Two_state_button = struct
+  include Button.Two_state
+
+  let config =
+    {
+      base_classes = Classes.make [ "pouet_base"; "another" ];
+      on_classes = Classes.make [ "on" ];
+      off_classes = Classes.make [ "off" ];
+    }
+
+  let make = make ~config
+end
 
 module Button = Button.Make (struct
   let base_classes = Classes.make [ "pouet_base"; "another" ]

diff --git a/example/index.html b/example/index.html
@@ -1,10 +1,14 @@
 <!DOCTYPE html>
 <html>
+
 <head>
 	<title>OCAMIX</title>
+	<link rel="stylesheet" href="./main.css">
 </head>
+
 <body>
- 	<h1>Welcome to OCAMIX</h1>
-    <script src="main.bc.js"></script>
+	<h1>Welcome to OCAMIX</h1>
+	<script src="main.bc.js"></script>
 </body>
+
 </html>
diff --git a/example/main.css b/example/main.css
@@ -0,0 +1,3 @@
+.on {
+    background-color: red;
+}
diff --git a/lib/brr_lwd_ui/button.ml b/lib/brr_lwd_ui/button.ml
@@ -27,40 +27,49 @@ struct
     (button, listener)
 end
 
-module Two_state (Properties : sig
-  val base_classes : Classes.t
-  val on_classes : Classes.t
-  val off_classes : Classes.t
-end) =
-struct
+module Two_state = struct
+  type config = {
+    base_classes : Classes.t;
+    on_classes : Classes.t;
+    off_classes : Classes.t;
+  }
+
   type state = On | Off
-  type t = { elt : El.t Lwd.t; set : state -> unit }
+  type action = None | Toggle | Set of state
+  type t = { elt : El.t Lwd.t; force : action -> unit }
 
   let toggle = function Off -> On | On -> Off
 
-  let get_state_classes = function
-    | Off -> Properties.off_classes
-    | On -> Properties.on_classes
+  let get_state_classes config = function
+    | On -> config.on_classes
+    | Off -> config.off_classes
+
+  let force var = function
+    | Set state -> Lwd.set var state
+    | Toggle -> Lwd.set var (toggle @@ Lwd.peek var)
+    | None -> ()
 
-  let make ?d ?(classes = Classes.Add []) ?(state = Off) ~on_click content =
+  let make ~config ?d ?(classes = Classes.Add []) ?(state = Off) ~on_click
+      content =
     let open Lwd_infix in
     let v_state = Lwd.var state in
-    let set = Lwd.set v_state in
-    let base_classes = Classes.update Properties.base_classes classes in
+    let base_classes = Classes.update config.base_classes classes in
     let elt =
       let$* state = Lwd.get v_state in
       let at =
-        let classes = get_state_classes state in
+        let classes = get_state_classes config state in
         Classes.union base_classes classes
         |> Classes.to_list
         |> List.map ~f:(fun c -> Utils.pure @@ At.class' (Jstr.v c))
       in
       let handler =
         Elwd.handler Ev.click (fun ev ->
-            Lwd.set v_state @@ toggle state;
-            on_click state ev)
+            match on_click state ev with
+            | Toggle -> Lwd.set v_state @@ toggle state
+            | Set state -> Lwd.set v_state state
+            | None -> ())
       in
       Elwd.button ?d ~at ~ev:[ `P handler ] content
     in
-    { elt; set }
+    { elt; force = force v_state }
 end