1 files changed, 173 insertions, 0 deletions
diff --git a/motus/js/fieldList.ml b/motus/js/fieldList.ml
new file mode 100644
index 0000000..85755aa
--- /dev/null
+++ b/motus/js/fieldList.ml
@@ -0,0 +1,173 @@
+open Brr
+open Note
+open Brr_note
+open StdLabels
+
+type elements = Brr.El.t list
+
+(** Depending of the class, extract the letter validity. 
+
+  If no class is specified, consider the letter is at the right position.
+
+ *)
+let get_validity_from_element : El.t -> State.letter_validity =
+ fun el ->
+  if El.class' (Jstr.v "missing") el
+  then State.Missing
+  else if El.class' (Jstr.v "misplaced") el
+  then State.Misplaced
+  else State.Wellplaced
+
+
+let get_rules : elements -> State.proposition =
+ fun t ->
+  List.map
+    ~f:(fun input ->
+      let value = El.prop El.Prop.value input in
+      if Jstr.equal Jstr.empty value
+      then None
+      else
+        let validity = get_validity_from_element input in
+        Some (value, validity) )
+    t
+
+
+let get_class : State.letter_validity -> Jstr.t = function
+  | Wellplaced -> Jstr.v "wellplaced"
+  | Misplaced -> Jstr.v "misplaced"
+  | _ -> Jstr.v "missing"
+
+
+(** Create the field list modifiied by the user *)
+let make : int -> (int * Jstr.t * State.letter_validity) E.send -> elements =
+ fun len change_sender ->
+  List.init ~len ~f:(fun i ->
+      let input =
+        El.input
+          ~at:
+            At.
+              [ type' (Jstr.v "text")
+              ; v (Jstr.v "maxLength") (Jstr.v "1")
+              ; value Jstr.empty
+              ; class' (Jstr.v "missing")
+              ; v (Jstr.v "readonly") (Jstr.v "true")
+              ]
+          ()
+      in
+
+      Ev.listen
+        Ev.change
+        (fun _ ->
+          let validity = get_validity_from_element input in
+          change_sender (i, El.prop El.Prop.value input, validity) )
+        (El.as_target input);
+      Ev.listen
+        Ev.click
+        (fun _ ->
+          let validity =
+            match get_validity_from_element input with
+            | State.Missing -> State.Misplaced
+            | State.Misplaced -> State.Wellplaced
+            | State.Wellplaced -> State.Missing
+          in
+          change_sender (i, El.prop El.Prop.value input, validity) )
+        (El.as_target input);
+
+      El.td [ input ] )
+
+
+(** Set the element class depending of the proposition validity for each letter
+ *)
+let set_with_props :
+    State.proposition -> elements -> Motus_lib.Criteria.t list -> unit =
+ fun current_prop fields rules ->
+  let i = ref 0 in
+  List.iter2 current_prop fields ~f:(fun prop field ->
+      (* Check if we have a rule for this letter *)
+      let wellplaced =
+        List.exists rules ~f:(function
+            | Motus_lib.Criteria.Contain (_, Some i') when !i = i' -> true
+            | _ -> false )
+      in
+      incr i;
+
+      match (wellplaced, El.children field, prop) with
+      | true, hd :: _, Some (letter, _) ->
+          El.set_prop El.Prop.value letter hd;
+          El.set_class (Jstr.v "wellplaced") true hd;
+          El.set_class (Jstr.v "misplaced") false hd;
+          El.set_class (Jstr.v "missing") false hd;
+          El.set_at (Jstr.v "readonly") (Some (Jstr.v "true")) hd
+      | _, hd :: _, None ->
+          El.set_class (Jstr.v "wellplaced") false hd;
+          El.set_class (Jstr.v "misplaced") false hd;
+          El.set_class (Jstr.v "missing") false hd
+      | false, hd :: _, Some (letter, validity) ->
+          El.set_prop El.Prop.value letter hd;
+          El.set_class (Jstr.v "wellplaced") false hd;
+          El.set_class (Jstr.v "misplaced") false hd;
+          El.set_class (Jstr.v "missing") false hd;
+          El.set_class (get_class validity) true hd
+      | _, [], _ -> () )
+
+
+let build : El.t -> int S.t -> State.proposition S.t =
+ fun container length ->
+  (* Build the element list *)
+  S.bind length (fun len ->
+      let elements =
+        List.init ~len ~f:(fun _ ->
+            let input =
+              El.input
+                ~at:
+                  At.
+                    [ type' (Jstr.v "text")
+                    ; v (Jstr.v "maxLength") (Jstr.v "1")
+                    ; value Jstr.empty
+                    ]
+                ()
+            in
+            input )
+      in
+      let events =
+        List.mapi
+          ~f:(fun i input ->
+            Evr.on_el
+              Ev.input
+              (fun _ ->
+                let value = El.prop El.Prop.value input in
+                if Jstr.equal Jstr.empty value
+                then (i, None)
+                else
+                  let validity = State.Wellplaced in
+                  (i, Some (Jstr.uppercased value, validity)) )
+              input )
+          elements
+      (* As the state is in a list, we have no way to be sure that the list
+         length is the same as the number of elements… except to rely on the
+         compiler contract.
+
+         But this would cause nasty bug if we had a difference here.
+      *)
+      and init_prop = List.init ~len ~f:(fun _ -> None) in
+
+      (* Replace the children in the element *)
+      El.set_children
+        container
+        [ El.table
+            [ (* The table has only one row *)
+              El.tr
+                (List.map elements ~f:(fun el ->
+                     El.td [ (* Each cell is the input element *) el ] ) )
+            ]
+        ];
+
+      let change =
+        E.select events
+        |> E.map (fun (position, value) acc ->
+               List.mapi acc ~f:(fun i prop ->
+                   if i <> position then prop else value ) )
+      in
+      let initial_proposition = S.accum init_prop change in
+
+      initial_proposition )