From 3b90a643b3820e97bf1dab28ce41dacc4ca2831f Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Mon, 20 Sep 2021 22:27:04 +0200
Subject: Updated from js usage

---
 src/js/application.ml |  49 +++++++++++++++++++++++
 src/js/dune           |   1 -
 src/js/tengwar.ml     | 109 ++++++++++++++++++++++++++++++++++++++------------
 3 files changed, 132 insertions(+), 27 deletions(-)
 create mode 100755 src/js/application.ml

(limited to 'src/js')

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 () =
 
-- 
cgit v1.2.3