Updated from js usage

3 files changed, 132 insertions, 27 deletions

diff --git a/src/js/application.ml b/src/js/application.ml
new file mode 100755
index 0000000..01724ac
--- /dev/null
+++ b/src/js/application.ml
@@ -0,0 +1,49 @@
+(** The Make module build the main application loop.contents

+

+    The function [run] update the state on each event, and return a new state.

+    Each event must follow the [event] type, which is composed from the type

+    [t], and a module with a fonction [update].

+

+    This example create an application with the state containing a simple

+    counter. An even which increment this counter is created and can be used to

+    update the state.

+

+

+    [

+        type state = { value : int }

+

+        (** Increment the state *)

+        module Incr = struct

+            type t = unit

+

+            let update () state = { value = state.value + 1 }

+        end

+

+        module App = Make(struct type t = state end)

+

+        (* Create the event itself *)

+        let incr_event = App.E ((), (module Incr:App.Event with type t = Incr.t))

+

+    ]

+

+*)

+module Make(S:sig type t end) = struct

+  module type Event = sig

+

+    type t

+

+    val update: t -> S.t -> S.t

+

+  end

+

+  type event = E : 'a * (module Event with type t = 'a) -> event

+

+  (** Simple helper for the main event loop *)

+  let run

+    : ?eq:(S.t -> S.t -> bool) -> S.t -> event Note.E.t -> S.t Note.S.t

+    = fun ?eq init event ->

+      let action = Note.E.map (fun (E (t, (module Event))) st -> Event.update t st) event in

+      Note.S.accum ?eq init action

+end

+

+

diff --git a/src/js/dune b/src/js/dune
index 9387c5f..4f1e8c6 100755
--- a/src/js/dune
+++ b/src/js/dune
@@ -3,7 +3,6 @@
  (libraries 
    brr
    brr.note
-   application
    translator
    sounds
    )
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 () =