From 741f88ab405995003eb6e9f301d3b065c1e84a4a Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Fri, 28 Jan 2022 14:44:57 +0100 Subject: Added a motus solver --- motus/js/fieldList.ml | 173 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 173 insertions(+) create mode 100644 motus/js/fieldList.ml (limited to 'motus/js/fieldList.ml') 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 ) -- cgit v1.2.3