-

front/chat.mod.ml

@@ -20,10 +20,12 @@ let display send =
   (* On définit le champ de texte pour envoyer un message, à chaque modification du champs de texte on appelle la fonction send *)
   let field =
     text_input ~id:"input"
-      (fun data ->
-        send data;
-        true)
       ""
   in
+  let handler () =
+    send (field.value ()) ;
+    field.set_value ""
+  in
+  field.on_action handler; 
   [ div ~id:"title" [ text ("Canal:" ^ canal) ]; container; field ]
 (* À la fin on programme la construction de la page web en placant tous les éléments. Cette fonction de construction est passée en argument à run *)

front/html.ml

@@ -12,6 +12,7 @@ type t = {
   scroll_to_bottom : unit -> unit;
   value : unit -> string;
   set_value : string -> unit;
+  on_action : (unit -> unit) -> unit
 }
 
 let append_node parent node = ignore @@ parent##appendChild node.data.node
@@ -21,7 +22,7 @@ let si v id = Option.iter (fun x -> v##.id := Js.string x) id
 let st v title = Option.iter (fun title -> v##.title := Js.string title) title
 let scroll_to_bottom elem = elem##.scrollTop := elem##.scrollHeight
 
-let make ?class_ ?id ?title ?(value = fun () -> "") ?(set_value = fun _ -> ()) x
+let make ?class_ ?id ?title ?(value = fun () -> "") ?(set_value = fun _ -> ()) ?(on_action = fun _ -> ()) x
     =
   let show_f x = x##.style##.display := Js.string "" in
   let hide_f x = x##.style##.display := Js.string "none" in
@@ -41,6 +42,7 @@ let make ?class_ ?id ?title ?(value = fun () -> "") ?(set_value = fun _ -> ()) x
     scroll_to_bottom = (fun () -> scroll_to_bottom x);
     value;
     set_value;
+    on_action
   }
 
 let make_cont ?class_ ?id ?title ?value ?set_value x items =
@@ -63,6 +65,7 @@ let br () =
     scroll_to_bottom = (fun () -> ());
     value = (fun () -> "");
     set_value = (fun _ -> ());
+    on_action = (fun _ -> ())
   }
 
 let text value =
@@ -82,6 +85,7 @@ let text value =
     scroll_to_bottom = (fun () -> ());
     value = (fun () -> "");
     set_value = (fun _ -> ());
+    on_action = (fun _ -> ())
   }
 
 let img ?class_ ?id ?alt src =
@@ -111,17 +115,19 @@ let kbd ?class_ ?id items =
   let kbd = Dom_html.document##createElement (Js.string "kbd") in
   make_cont ?class_ ?id kbd items
 
-let button ?class_ ?id on_click items =
+let button ?class_ ?id items =
   let button = Dom_html.(createButton document) in
   append_nodes button items;
   sc button class_;
   si button id;
-  let js_on_click _ =
-    on_click ();
-    Js._true
+  let on_action on_click =
+    let js_on_click _ =
+      on_click ();
+      Js._true
+    in
+    button##.onclick := Dom.handler js_on_click
   in
-  button##.onclick := Dom.handler js_on_click;
-  make ?class_ ?id button
+  make ?class_ ?id ~on_action button
 
 let td ?class_ ?id items =
   make_cont ?class_ ?id Dom_html.(createTd document) items
@@ -159,13 +165,15 @@ let span ?class_ ?id items =
 let error_check s =
   print_endline @@ "checked or unchecled expected (received " ^ s ^ ")"
 
-let make_checked_input ?class_ ?id on_change input checked =
+let make_checked_input ?class_ ?id input checked =
   input##.checked := Js.bool checked;
-  let on_click _ =
-    on_change (Js.to_bool input##.checked);
-    Js._true
+  let on_action on_change =
+    let on_click _ =
+      on_change ();
+      Js._true
+    in
+    input##.onclick := Dom.handler on_click
   in
-  input##.onclick := Dom.handler on_click;
   let set_ctrl = function
     | "checked" -> input##.checked := Js._true
     | "unchecked" -> input##.checked := Js._false
@@ -174,33 +182,35 @@ let make_checked_input ?class_ ?id on_change input checked =
   let get_ctrl () =
     if Js.to_bool input##.checked then "checked" else "unchecked"
   in
-  make ?class_ ?id ~value:get_ctrl ~set_value:set_ctrl input
+  make ?class_ ?id ~value:get_ctrl ~set_value:set_ctrl ~on_action input
 
-let checkbox_input ?class_ ?id on_change checked =
+let checkbox_input ?class_ ?id checked =
   let input = Dom_html.(createInput ~_type:(Js.string "checkbox") document) in
-  make_checked_input ?class_ ?id on_change input checked
+  make_checked_input ?class_ ?id input checked
 
-let radio_input ?class_ ?id on_change name checked =
+let radio_input ?class_ ?id name checked =
   let input =
     Dom_html.(
       createInput ~name:(Js.string name) ~_type:(Js.string "radio") document)
   in
-  make_checked_input ?class_ ?id on_change input checked
+  make_checked_input ?class_ ?id input checked
 
-let make_text_input ?class_ ?id on_change input value =
+let make_text_input ?class_ ?id input value =
   input##.value := Js.string value;
-  let on_input _ =
-    if on_change (Js.to_string input##.value) then input##.value := Js.string "";
-    Js._true
+  let on_action on_change =
+    let on_input _ =
+      on_change ();
+      Js._true
+    in
+    input##.onchange := Dom.handler on_input
   in
-  input##.onchange := Dom.handler on_input;
   let set_value value = input##.value := Js.string value in
   let get_value () = Js.to_string input##.value in
-  make ?class_ ?id ~value:get_value ~set_value input
+  make ?class_ ?id ~value:get_value ~set_value ~on_action input
 
-let text_input ?class_ ?id on_change value =
+let text_input ?class_ ?id value =
   let input = Dom_html.(createInput ~_type:(Js.string "text") document) in
-  make_text_input ?class_ ?id on_change input value
+  make_text_input ?class_ ?id input value
 
 let option ?(def = false) value =
   let opt = Dom_html.(createOption document) in
@@ -209,19 +219,21 @@ let option ?(def = false) value =
   if def then opt##.defaultSelected := Js._true;
   make opt
 
-let select ?class_ ?id ?def on_change sl =
+let select ?class_ ?id ?def sl =
   let sel = Dom_html.(createSelect document) in
   List.iter
     (fun s ->
       append_node sel
         (option ~def:(match def with None -> false | Some x -> x = s) s))
     sl;
-  let on_input _ =
-    on_change (Js.to_string sel##.value);
-    Js._true
+  let on_action on_change =
+    let on_input _ =
+      on_change ();
+      Js._true
+    in
+    sel##.oninput := Dom.handler on_input
   in
-  sel##.oninput := Dom.handler on_input;
-  make ?class_ ?id sel
+  make ?class_ ?id ~on_action sel
 
 let string_of_date = function
   | None -> ""
@@ -233,21 +245,16 @@ let date_of_string value =
   let d = Js.date##parse (Js.string value) in
   if Float.is_nan d then None else Some d
 
-let date_input ?class_ ?id on_change value =
+let date_input ?class_ ?id value =
   let input = Dom_html.(createInput ~_type:(Js.string "date") document) in
   let ds = string_of_date value in
-  let on_input _ =
-    let d = Js.date##parse input##.value in
-    let d2 = if Float.is_nan d then None else Some d in
-    on_change d2
-  in
-  make_text_input ?class_ ?id on_input input ds
+  make_text_input ?class_ ?id input ds
 
-let text_area ?class_ ?id on_change ?(is_read_only = false) value =
+let text_area ?class_ ?id ?(is_read_only = false) value =
   let input = Dom_html.(createTextarea document) in
   if is_read_only then
     input##setAttribute (Js.string "readonly") (Js.string "true");
-  make_text_input ?class_ ?id on_change input value
+  make_text_input ?class_ ?id input value
 
 let run htmls =
   let on_load _ =

front/html.mli

@@ -11,6 +11,7 @@ type t = {
   scroll_to_bottom : unit -> unit;
   value : unit -> string;
   set_value : string -> unit;
+  on_action : (unit -> unit) -> unit
 }
 (** type of HTML nodes *)
 
@@ -43,9 +44,6 @@ val a :
 val kbd : ?class_:string -> ?id:string -> t list -> t
 (** tag {{:https://developer.mozilla.org/fr/docs/Web/HTML/Element/kbd} <kbd> } *)
 
-val button : ?class_:string -> ?id:string -> (unit -> unit) -> t list -> t
-(** tag {{:https://developer.mozilla.org/fr/docs/Web/HTML/Element/button} <button> } *)
-
 val td : ?class_:string -> ?id:string -> t list -> t
 (** tag {{:https://developer.mozilla.org/fr/docs/Web/HTML/Element/td} <td> } *)
 
@@ -79,14 +77,17 @@ val span : ?class_:string -> ?id:string -> t list -> t
 (** {2 Form elements}
  tag {{:https://developer.mozilla.org/fr/docs/Web/HTML/Element/input} <input> } *)
 
-val checkbox_input : ?class_:string -> ?id:string -> (bool -> unit) -> bool -> t
+val button : ?class_:string -> ?id:string -> t list -> t
+(** tag {{:https://developer.mozilla.org/fr/docs/Web/HTML/Element/button} <button> } *)
+
+val checkbox_input : ?class_:string -> ?id:string -> bool -> t
 (** tag {{:https://developer.mozilla.org/fr/docs/Web/HTML/Element/Input/checkbox} <input type="checkbox"> } *)
 
 val radio_input :
-  ?class_:string -> ?id:string -> (bool -> unit) -> string -> bool -> t
+  ?class_:string -> ?id:string -> string -> bool -> t
 (** tag {{:https://developer.mozilla.org/fr/docs/Web/HTML/Element/Input/radio} <input type="radio"> } *)
 
-val text_input : ?class_:string -> ?id:string -> (string -> bool) -> string -> t
+val text_input : ?class_:string -> ?id:string -> string -> t
 (** tag {{:https://developer.mozilla.org/fr/docs/Web/HTML/Element/Input/text} <input type="text"> } *)
 
 val option : ?def:bool -> string -> t
@@ -96,7 +97,6 @@ val select :
   ?class_:string ->
   ?id:string ->
   ?def:string ->
-  (string -> unit) ->
   string list ->
   t
 (** tag {{:https://developer.mozilla.org/fr/docs/Web/HTML/Element/select} <select> } *)
@@ -108,13 +108,12 @@ val date_of_string : string -> float option
 (** converts a string to a date using {{:https://developer.mozilla.org/fr/docs/Web/JavaScript/Reference/Global_Objects/Date/parse} Date.parse() } *)
 
 val date_input :
-  ?class_:string -> ?id:string -> (float option -> bool) -> float option -> t
+  ?class_:string -> ?id:string -> float option -> t
 (** tag {{:https://developer.mozilla.org/fr/docs/Web/HTML/Element/Input/date} <input type="date"> } *)
 
 val text_area :
   ?class_:string ->
   ?id:string ->
-  (string -> bool) ->
   ?is_read_only:bool ->
   string ->
   t

front/simpleEvent.ml

@@ -13,9 +13,9 @@ let gen_nonce () =
   done;
   Bytes.to_string buff
 
-let addr = "https://prog-reseau-m1.lacl.fr/padiflac/"
+(* let addr = "https://prog-reseau-m1.lacl.fr/padiflac/" *)
 
-(* let addr = "http://localhost/padiflac/" *)
+let addr = "http://localhost/padiflac/"
 
 (* let print_str s =
   let n = String.length s in

front/test_ocaml.ml

@@ -12,11 +12,13 @@ let send,event_loop = connect canal
 
 let input_field =
   text_input ~class_:"chat-input-text"
-    (fun data ->
-      send data;
-      true)
     ""
 
+let _ = input_field.on_action (fun () ->
+    send (input_field.value ());
+    input_field.set_value "")
+
+
 let handler _ event = container.append [ text event; br () ]
     
 let _ =

front/tictactoe.ml

@@ -58,16 +58,19 @@ let upstate st = function
 
 let send,_,event_loop =
    connect canal (true, initstate)
-     
+
+let send_button b i j =
+  let btn = button [ text (if b then "x" else "o") ] in
+  btn.on_action (fun () -> send (Some (b, i, j)));
+  btn
+
 let display finish (b, state) =
   let but i j =
     match get33 state i j with
     | Empty when not finish ->
         td
           [
-            button
-              (fun () -> send (Some (b, i, j)))
-              [ text (if b then "x" else "o") ];
+            send_button b i j
           ]
     | Empty -> td [ text "_" ]
     | Circle -> td [ text "o" ]
@@ -82,7 +85,12 @@ let display finish (b, state) =
 
      
 let container = div [display false (false, initstate)]
-     
+
+let restart_button =
+  let btn = button [ text "restart" ] in
+  btn.on_action (fun () -> send None);
+  btn
+
 let receive _ (b, state) event =
   let state2 = upstate state event in
   match finish state2 with
@@ -98,7 +106,7 @@ let receive _ (b, state) event =
         text "Finish !";
         text msg;
         display true (b, state2);
-        button (fun () -> send None) [ text "restart" ];
+        restart_button;
       ];
     (not b, initstate)
   | None ->