1 files changed, 83 insertions, 26 deletions

diff --git a/src/js/tengwar.ml b/src/js/tengwar.ml
index 24b8a3c..31eb1ed 100644
--- a/src/js/tengwar.ml
+++ b/src/js/tengwar.ml
@@ -11,7 +11,44 @@ let get_element_by_id id =
 let (let=?) : 'a option -> ('a -> unit) -> unit
   = fun f opt -> Option.iter opt f
 
-let main id phon tengwar =
+type state =
+  { text : (Sounds.t list, string) result
+  ; font : [`Telcontar | `Annatar ]}
+
+module App = Application.Make(struct type t = state end)
+
+module SetText = struct
+  type t = Jstr.t
+  let update t state =
+
+    let text =
+      Jstr.lowercased t
+      |> Jstr.to_string
+      |> Translator.Reader.process in
+    { state with text }
+end
+
+module SetFont = struct
+  type t = string * El.t
+  let update (t, el) state =
+    let font = match t with
+      | "annatar" ->
+        El.set_class (Jstr.v "annatar") true el;
+        El.set_class (Jstr.v "telcontar") false el;
+        `Annatar
+      | _ ->
+        El.set_class (Jstr.v "annatar") false el;
+        El.set_class (Jstr.v "telcontar") true el;
+        `Telcontar in
+    { state with font }
+end
+
+let init =
+  { text = Ok []
+  ; font = `Telcontar
+  }
+
+let main id phon tengwar font =
   match (Jv.is_none id) with
   | true -> Console.(error [str "No element with id '%s' found"; id])
   | false ->
@@ -19,35 +56,55 @@ let main id phon tengwar =
     let=? source = get_element_by_id id in
     let=? phon = get_element_by_id phon in
     let=? tengwar = get_element_by_id tengwar in
+    let=? font = get_element_by_id font in
 
-    let ev = Evr.on_el
+    let text_event =
+      Evr.on_el
         Ev.input
         (fun _ ->
-           let value = El.prop El.Prop.value source in
+           App.E ( El.prop El.Prop.value source
+                 , (module SetText: App.Event with type t = SetText.t ))
+        ) source in
+
+    let font_event =
+      Evr.on_el
+        Ev.input
+        (fun _ ->
+           let value = El.prop El.Prop.value font in
            let str = Jstr.to_string value in
-           let transcription = Translator.Reader.process str in
-
-           let res1 = Result.map
-               (fun t-> Sounds.repr (module Repr.Default) t)
-               transcription in
-           let () = match res1 with
-             | Ok response ->
-               El.set_prop El.Prop.value (Jstr.of_string response) phon
-             | Error _err -> () in
-           let res2 = Result.map
-               (fun t-> Sounds.repr (module Repr.Anatar) t)
-               transcription in
-           let () = match res2 with
-             | Ok response ->
-               El.set_prop El.Prop.value (Jstr.of_string response) tengwar
-             | Error _err -> () in
-           ()
-        )
-        source in
-
-    match (E.log ev (fun _ -> ())) with
-    | None -> ()
-    | Some v -> Logr.hold v
+           App.E ( (str, tengwar)
+                 , (module SetFont: App.Event with type t = SetFont.t ))
+        ) font in
+
+    let ev = App.run
+        init
+        (E.select
+           [ text_event
+           ; font_event ]
+        ) in
+
+    let log state =
+      let transcription = state.text in
+      let res1 = Result.map
+          (fun t-> Sounds.repr (module Repr.Default) t)
+          transcription in
+      let () = match res1 with
+        | Ok response ->
+          El.set_prop El.Prop.value (Jstr.of_string response) phon
+        | Error _err -> () in
+      let res2 = Result.map
+          (fun t->
+             match state.font with
+             | `Annatar -> Sounds.repr (module Repr.Anatar) t
+             | `Telcontar -> Sounds.repr (module Repr.Telcontar) t)
+          transcription in
+      let () = match res2 with
+        | Ok response ->
+          El.set_prop El.Prop.value (Jstr.of_string response) tengwar
+        | Error _err -> () in
+      ()
+    in
+    Logr.hold (S.log ev log)
 
 let () =