1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
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 )
|
