aboutsummaryrefslogtreecommitdiff
path: root/motus
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@dailly.me>2022-02-27 13:06:59 +0100
committerSébastien Dailly <sebastien@dailly.me>2022-02-27 13:06:59 +0100
commit5dc124b621ab05ba7dbde306a557947197941228 (patch)
tree73ac506a0540c4eff85c8cce38ff6c946144106f /motus
parent3235260a3dca98e96ab50458a5daf3baf3f238d0 (diff)
JS Update
Diffstat (limited to 'motus')
-rw-r--r--motus/js/fieldList.ml17
-rw-r--r--motus/js/initialize.ml8
-rw-r--r--motus/js/next.ml2
-rw-r--r--motus/js/reload.ml2
4 files changed, 16 insertions, 13 deletions
diff --git a/motus/js/fieldList.ml b/motus/js/fieldList.ml
index 428f364..26b89bb 100644
--- a/motus/js/fieldList.ml
+++ b/motus/js/fieldList.ml
@@ -61,6 +61,7 @@ let make : int -> (int * Jstr.t * Motus_lib.Validity.t) E.send -> elements =
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 _ ->
@@ -82,13 +83,17 @@ 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 )
+ match prop with
+ | None -> false
+ | Some v ->
+ let c = String.get (Jstr.to_string (fst v)) 0 in
+ let contain = Motus_lib.Criteria.Contain (c, Some !i) in
+ List.mem contain ~set:rules
in
+
incr i;
match (wellplaced, El.children field, prop) with
@@ -101,12 +106,14 @@ let set_with_props :
| _, 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
+ El.set_class (Jstr.v "missing") false hd;
+ El.set_at (Jstr.v "readonly") (Some (Jstr.v "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_at (Jstr.v "readonly") (Some (Jstr.v "false")) hd;
El.set_class (get_class validity) true hd
| _, [], _ -> () )
diff --git a/motus/js/initialize.ml b/motus/js/initialize.ml
index b721343..6a277df 100644
--- a/motus/js/initialize.ml
+++ b/motus/js/initialize.ml
@@ -40,12 +40,8 @@ let get_proposition :
word
|> String.to_seq
|> Seq.map (fun c ->
- let wellplaced =
- List.exists rules ~f:(function
- | Motus_lib.Criteria.Contain (_, Some i') when !i = i' ->
- true
- | _ -> false )
- in
+ let contain = Criteria.Contain (c, Some !i) in
+ let wellplaced = List.mem contain ~set:rules in
incr i;
let validity =
match wellplaced with
diff --git a/motus/js/next.ml b/motus/js/next.ml
index e6baf51..f26aa86 100644
--- a/motus/js/next.ml
+++ b/motus/js/next.ml
@@ -37,4 +37,4 @@ let process : t -> State.state -> State.state =
| None -> new_state
| Some prop ->
FieldList.set_with_props prop state.fields new_state.rules;
- State.{ new_state with rules; current_prop = prop }
+ State.{ new_state with current_prop = prop }
diff --git a/motus/js/reload.ml b/motus/js/reload.ml
index ee9ab37..912141d 100644
--- a/motus/js/reload.ml
+++ b/motus/js/reload.ml
@@ -34,5 +34,5 @@ let process : t -> State.state -> State.state =
match current_prop with
| None -> new_state
| Some prop ->
- FieldList.set_with_props prop state.fields new_state.rules;
+ FieldList.set_with_props prop new_state.fields new_state.rules;
State.{ new_state with current_prop = prop }