Updated from js usage

author: Sébastien Dailly <sebastien@chimrod.com> 2021-09-20 22:27:04 +0200
committer: Sébastien Dailly <sebastien@chimrod.com> 2021-09-20 22:27:04 +0200
commit: 3b90a643b3820e97bf1dab28ce41dacc4ca2831f (patch)
tree: d9155ffdb21f109f41b69438c87b5fb0b3ee41fb
parent: 21d05774e5f78b6d070d69f714873b2c2a7cfe28 (diff)
13 files changed, 458 insertions, 550 deletions
diff --git a/Makefile b/Makefile
index 3ffc6d9..8fef8df 100644
--- a/Makefile
+++ b/Makefile
@@ -6,3 +6,6 @@ release:
 
 test:
 	dune runtest src/test
+
+serve:
+	cd _build/default && python3 -m http.server 8000
diff --git a/index.html b/index.html
new file mode 100755
index 0000000..2a51602
--- /dev/null
+++ b/index.html
@@ -0,0 +1,80 @@
+
+<!DOCTYPE html>
+<html lang="fr_fr">
+<head>
+  <meta charset="utf-8" />
+  <meta http-equiv="X-UA-Compatible" content="IE=edge" />
+  <meta name="HandheldFriendly" content="True" />
+  <meta name="viewport" content="width=device-width, initial-scale=1.0" />
+  <meta name="robots" content="noindex, nofollow" />
+
+  <title>Tengwar transcription</title>
+
+</head>
+<style>
+input[type='text'] { font-size: 24px; }
+.annatar { 
+  font-family: "Tengwar Annatar"
+}
+.telcontar { 
+  font-family: "Tengwar Telcontar"
+}
+
+fieldset {
+  display: table;
+}
+fieldset p {
+  display: table-row;
+}
+fieldset label {
+ display: table-cell;
+ margin: 100px;
+}
+
+
+</style>
+<body>
+  <main>
+
+  <header>
+    <h1 id="Application">Application</h1>
+  </header>
+  <div>
+    <noscript>Sorry, you need to enable JavaScript to see this page.</noscript>
+      <script id="lib" type="text/javascript" defer="defer" src="src/js/tengwar.js"></script>
+    <script>
+      var script = document.getElementById('lib');
+      script.addEventListener('load', function() {
+        lib.run("source", "phono", "tengwar", "font");
+      });
+    </script>
+
+ <fieldset>
+  <p>
+    <label for="source">Entrée :</label>
+    <input type="text" id="source" name="source">
+  </p>
+  <p>
+  <label for="output">Phonétique :</label>
+  <input type="text" id="phono" name="output">
+  </p>
+  <p>
+  <label for="font">Police :</label>
+  <select id="font">
+    <option value="annatar">Tengwar Annatar</option>
+    <option selected value="telcontar">Tengwar Telcontar</option>
+  </select>
+  </p>
+  <p>
+  <label for="output">Tengwar :</label>
+  <input type="text" id="tengwar" class="telcontar" name="output">
+  </p>
+ </fieldset> 
+
+  </div>
+
+  </main>
+
+
+</body>
+</html>
diff --git a/src/application/dune b/src/application/dune
deleted file mode 100755
index 77eb6b9..0000000
--- a/src/application/dune
+++ /dev/null
@@ -1,7 +0,0 @@
-(library
- (name application)
- (libraries 
-   brr
-   brr.note
-   )
- )
diff --git a/src/bin/transcriptor.ml b/src/bin/transcriptor.ml
index d759452..dc83634 100644
--- a/src/bin/transcriptor.ml
+++ b/src/bin/transcriptor.ml
@@ -17,7 +17,13 @@ let process (optional_line : string option) =
         (fun t-> Sounds.repr (module Repr.Anatar) t)
         result in
     let () = match res2 with
-      | Ok response -> print_endline response
+      | Ok response -> print_endline ( "Anatar : " ^ response)
+      | Error err -> print_endline err in
+    let res3 = Result.map
+        (fun t-> Sounds.repr (module Repr.Telcontar) t)
+        result in
+    let () = match res3 with
+      | Ok response -> print_endline ( "Telcontar : " ^ response)
       | Error err -> print_endline err in
     ()
 
diff --git a/src/application/application.ml b/src/js/application.ml
index 01724ac..01724ac 100755
--- a/src/application/application.ml
+++ b/src/js/application.ml
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 () =
 
diff --git a/src/lib/lexer.mll b/src/lib/lexer.mll
index 2fbffb5..8654dca 100644
--- a/src/lib/lexer.mll
+++ b/src/lib/lexer.mll
@@ -46,6 +46,7 @@ rule letter = parse
 | 'y'            { Y }
 | 'z'            { Z }
 | ending         { EOL }
+| "er" ending    { ER_ }
 | "erf" ending   { ERF_ }
 | "el" ending    { EL_ }
 (*| "ent" ending   { ENT_ }*)
diff --git a/src/lib/prononciation.mly b/src/lib/prononciation.mly
index 74d9373..c473462 100644
--- a/src/lib/prononciation.mly
+++ b/src/lib/prononciation.mly
@@ -19,6 +19,7 @@
 %token X_
 %token ENT_
 %token ERF_
+%token ER_
 %token EL_
 %token IENT_
 %token IE_
@@ -141,6 +142,7 @@ ending:
   | X_        { S::EOL::[]}
   | IENT_     { I::T::EOL::[]}
   | IE_       { I::EOL::[]}
+  | ER_       { E_ACUTE::R::EOL::[]}
   | ERF_      { E_AGRAVE::R::EOL::[]}
   | EL_       { E_AGRAVE::L::EOL::[]}
   | EOL       { EOL::[] }
diff --git a/src/lib/repr/anatar.ml b/src/lib/repr/anatar.ml
index 1d00266..cca6162 100644
--- a/src/lib/repr/anatar.ml
+++ b/src/lib/repr/anatar.ml
@@ -6,27 +6,19 @@ type position =
   | Pos2
   | Pos3
   | Pos4
-  | Lambe (* Position for the Lambe (Theta inside) *)
-  | Lower_1_2 (* Position for the Harma *)
-  | Lower_3_1 (* Position for the Calma *)
-  | Lower_4_2 (* Position for the Thule *)
+  | Lambe       (* Position for the Lambe (Theta inside) *)
+  | Lower_1_2   (* Position for the Harma *)
+  | Lower_3_1   (* Position for the Calma *)
+  | Lower_4_2   (* Position for the Thule *)
 
 type t = position T.t
 
-let portant =
-  { T.position = Pos4
-  ; T.muted = None
-  ; T.category = I
-  ; T.primary = false
-  ; T.repr = "`" }
+let none = T.none
 
-let none = T.Nothing
-
-let space s = T.Repr s
+let space s = T.space s
 
 let a' =
-  { T.opened = true
-  ; T.position = `Above
+  { T.position = `Above
   ; T.app = function
       | Pos1 | Lower_1_2 | Lambe -> "#"
       | Pos2 -> "E"
@@ -48,13 +40,12 @@ and app_eu = function
   | Pos4 | Lower_4_2 -> "ß"
 
 let e_opened =
-  T.Voyel { opened = true ; position = `Above ; app = app_e }
+  T.Voyel { position = `Above ; app = app_e }
 and e_closed =
-  T.Voyel { opened = false; position = `Above ; app = app_e }
+  T.Voyel { position = `Above ; app = app_e }
 
 and schwa = T.Voyel
-    { opened = true
-    ; position = `Below
+    { position = `Below
     ; app = function
         | Pos1 | Lower_3_1 -> "È"
         | Pos2 | Lower_1_2 | Lower_4_2 -> "É"
@@ -63,12 +54,11 @@ and schwa = T.Voyel
         | Lambe -> "L"
     }
 
-and eu_opened = T.Voyel { opened = true  ; position = `Above ; app = app_eu }
-and eu_closed = T.Voyel { opened = false ; position = `Above ; app = app_eu }
+and eu_opened = T.Voyel { position = `Above ; app = app_eu }
+and eu_closed = T.Voyel { position = `Above ; app = app_eu }
 
 and o' =
-  { T.opened = true
-  ; T.position = `Above
+  { T.position = `Above
   ; T.app = function
       | Pos1 | Lower_1_2 | Lambe -> "^"
       | Pos2 -> "Y"
@@ -79,8 +69,7 @@ and o' =
 let o = T.Voyel o'
 
 and i' =
-  { T.opened = true
-  ; T.position = `Above
+  { T.position = `Above
   ; T.app = function
       | Pos1 | Lower_1_2 | Lambe -> "%"
       | Pos2 -> "T"
@@ -91,8 +80,7 @@ and i' =
 let i = T.Voyel i'
 
 and y' =
-  { T.opened = true
-  ; T.position = `Above
+  { T.position = `Above
   ; T.app = function
       | Pos1 | Lower_1_2 | Lambe -> "Ø"
       | Pos2 -> "Ù"
@@ -103,8 +91,7 @@ and y' =
 let y = T.Voyel y'
 
 and u = T.Voyel
-    { T.opened = true
-    ; T.position = `Above
+    { T.position = `Above
     ; T.app = function
         | Pos1 | Lower_1_2 | Lambe -> "&"
         | Pos2 -> "U"
@@ -112,159 +99,35 @@ and u = T.Voyel
         | Pos4 | Lower_4_2 -> "M"
     }
 
-and p = T.Consonant
-    { position = Pos2
-    ; muted = Some "y"
-    ; category = II
-    ; primary = true
-    ; repr = "q" }
-
-and b = T.Consonant
-    { position = Pos1
-    ; muted = Some "y"
-    ; category = II
-    ; primary = true
-    ; repr = "w" }
-
-and t = T.Consonant
-    { position = Pos2
-    ; muted = Some "6"
-    ; category = I
-    ; primary = true
-    ; repr = "1" }
-
-and d = T.Consonant
-    { position = Pos1
-    ; muted = Some "6"
-    ; category = I
-    ; primary = true
-    ; repr = "2" }
-
-and k = T.Consonant
-    { position = Lower_3_1
-    ; muted = Some "h"
-    ; category = III
-    ; primary = true
-    ; repr = "a" }
-
-and g = T.Consonant
-    { position = Pos1
-    ; muted = Some "h"
-    ; category = III
-    ; primary = true
-    ; repr = "s" }
-
-and f = T.Consonant
-    { position = Pos3
-    ; muted = None
-    ; category = II
-    ; primary = true
-    ; repr = "e" }
-
-and v = T.Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = II
-    ; primary = true
-    ; repr = "r" }
-
-and ch = T.Consonant
-    { position = Lower_1_2
-    ; muted = None
-    ; category = III
-    ; primary = true
-    ; repr = "d" }
-
-and j = T.Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = III
-    ; primary = true
-    ; repr = "f" }
-
-and s = T.Consonant
-    { position = Lower_4_2
-    ; muted = Some "i"
-    ; category = I
-    ; primary = true
-    ; repr = "3" }
-
-and z = T.Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = I
-    ; primary = true
-    ; repr = "4" }
-
-and m = T.Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = II
-    ; primary = true
-    ; repr = "t" }
-
-and n = T.Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = I
-    ; primary = true
-    ; repr = "5" }
-
-and gn = T.Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = III
-    ; primary = false
-    ; repr = "b" }
-
-and ng = T.Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = III
-    ; primary = true
-    ; repr = "g" }
-
-and r = T.Consonant
-    { position = Pos2
-    ; muted = Some "u"
-    ; category = I
-    ; primary = false
-    ; repr = "7" }
-
-and semi_voyel_w = T.Consonant
-    { position = Pos3
-    ; muted = None
-    ; category = II
-    ; primary = false
-    ; repr = "." }
-
-and semi_voyel_y = T.Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = II
-    ; primary = false
-    ; repr = "l" }
-
-and semi_voyel_u = T.Consonant
-    { position = Pos2
-    ; muted = None
-    ; category = II
-    ; primary = false
-    ; repr = "]" }
-
-let l =
-  let default =
-    { T.position = Lambe
-    ; T.muted = None
-    ; T.category = II
-    ; T.primary = false
-    ; T.repr = "j" } in
-  T.Consonant default
-
-let a_nasal = T.nasal m ng n a'
-and o_nasal = T.nasal m ng n o'
-and i_nasal = T.nasal m ng n i'
-and y_nasal = T.nasal m ng n y'
+let portant =       T.portant       "`"             Pos4
+
+and t =             T.t             "1" (Some "6")  Pos2
+and d =             T.d             "2" (Some "6")  Pos1
+and p =             T.p             "q" (Some "y")  Pos2
+and b =             T.b             "w" (Some "y")  Pos1
+and k =             T.k             "a" (Some "h")  Lower_3_1
+and g =             T.g             "s" (Some "h")  Pos1
+and f =             T.f             "e"             Pos3
+and v =             T.v             "r"             Pos1
+and ch =            T.ch            "d"             Lower_1_2
+and j =             T.j             "f"             Pos1
+and s =             T.s             "3" (Some "i")  Lower_4_2
+and z =             T.z             "4"             Pos1
+and m =             T.m             "t"             Pos1
+and n =             T.n             "5"             Pos1
+and gn =            T.gn            "b"             Pos1
+and ng =            T.ng            "g"             Pos1
+and r =             T.r             "7" (Some "u")  Pos2
+and l =             T.l             "j"             Lambe
+
+and semi_voyel_w =  T.semi_voyel_w  "."             Pos3
+and semi_voyel_y =  T.semi_voyel_y  "l"             Pos1
+and semi_voyel_u =  T.semi_voyel_u  "]"             Pos2
+
+let a_nasal =       T.nasal m ng n a'
+and o_nasal =       T.nasal m ng n o'
+and i_nasal =       T.nasal m ng n i'
+and y_nasal =       T.nasal m ng n y'
 
 let muted
   : t -> t
diff --git a/src/lib/repr/telcontar.ml b/src/lib/repr/telcontar.ml
index ef55f37..219fa46 100644
--- a/src/lib/repr/telcontar.ml
+++ b/src/lib/repr/telcontar.ml
@@ -1,276 +1,90 @@
-(** Glyph position for the diacritc *)
-type position =
-  | Pos1
-  | Pos2
-  | Pos3
-  | Pos4
-
-(** Consonant category *)
-type category =
-  | I
-  | II
-  | III
+module T = Tengwar
 
-type voyel =
-  { opened : bool
-  ; position : [`Above | `Below ]
-  ; repr : string }
-
-type consonant =
-  { position : position
-  ; muted: string option
-  ; repr : string
-  ; primary : bool
-  ; category : category }
+(** Glyph position for the diacritc *)
+type position = unit
+type t = position T.t
 
+let none = T.none
 
-type nasal = (t -> string)
+let space s = T.space s
 
-and t =
-  | Consonant of consonant
-  | Voyel of voyel
-  | Nasal of nasal
-  | Repr of string
-  | Nothing
+let a' =
+  { T.position = `Above
+  ; T.app = fun () -> ""
+  }
+let a = T.Voyel a'
 
-let none = Nothing
+let app_e = fun () -> ""
+and app_eu = fun () -> ""
 
-let space s = Repr s
+let e_opened =
+  T.Voyel { position = `Above ; app = app_e }
+and e_closed =
+  T.Voyel { position = `Above ; app = app_e }
 
-let a = Voyel
-    { opened = true
-    ; position = `Above
-    ; repr = ""
+and schwa = T.Voyel
+    { position = `Below
+    ; app = fun () -> ""
     }
 
+and eu_opened = T.Voyel { position = `Above ; app = app_eu }
+and eu_closed = T.Voyel { position = `Above ; app = app_eu }
 
-let app_e = function
-  | Pos1 -> "$"
-  | Pos2 -> "R"
-  | Pos3 -> "F"
-  | Pos4 -> "V"
-
-and app_eu = function
-  | Pos1 -> "Ü"
-  | Pos2 -> "Ý"
-  | Pos3 -> "Þ"
-  | Pos4 -> "ß"
-
-let e_opened = Voyel { opened = true ; position = `Above ; repr = "" }
-and e_closed = Voyel { opened = false; position = `Above ; repr = ""  }
-and schwa = Voyel
-    { opened = true
-    ; position = `Below
-    ; repr = "" }
-
-and eu_opened = Voyel { opened = true  ; position = `Above ; repr = "" }
-and eu_closed = Voyel { opened = false ; position = `Above ; repr = "" }
-
-and o = Voyel
-    { opened = true
-    ; position = `Above
-    ; repr = "" }
-
-and i = Voyel
-    { opened = true
-    ; position = `Above
-    ; repr =  "" }
-
-and y = Voyel
-    { opened = true
-    ; position = `Above
-    ; repr = "" }
-
-and u = Voyel
-    { opened = true
-    ; position = `Above
-    ; repr = "" }
-
-let p = Consonant
-    { position = Pos2
-    ; muted = Some ""
-    ; category = II
-    ; primary = true
-    ; repr = "" }
-
-and b = Consonant
-    { position = Pos1
-    ; muted = Some ""
-    ; category = II
-    ; primary = true
-    ; repr = "" }
-
-and t = Consonant
-    { position = Pos2
-    ; muted = Some ""
-    ; category = I
-    ; primary = true
-    ; repr = "" }
-
-and d = Consonant
-    { position = Pos1
-    ; muted = Some ""
-    ; category = I
-    ; primary = true
-    ; repr = "" }
-
-and k = Consonant
-    { position = Pos3
-    ; muted = Some "h"
-    ; category = III
-    ; primary = true
-    ; repr = "a" }
+and o' =
+  { T.position = `Above
+  ; T.app = fun () -> ""
+  }
 
-and g = Consonant
-    { position = Pos1
-    ; muted = Some "h"
-    ; category = III
-    ; primary = true
-    ; repr = "s" }
+let o = T.Voyel o'
 
-and f = Consonant
-    { position = Pos3
-    ; muted = None
-    ; category = II
-    ; primary = true
-    ; repr = "e" }
+and i' =
+  { T.position = `Above
+  ; T.app = fun () -> ""
+  }
 
-and v = Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = II
-    ; primary = true
-    ; repr = "r" }
+let i = T.Voyel i'
 
-and ch = Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = III
-    ; primary = true
-    ; repr = "d" }
+and y' =
+  { T.position = `Above
+  ; T.app = fun () -> ""
+  }
 
-and j = Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = III
-    ; primary = true
-    ; repr = "f" }
+let y = T.Voyel y'
 
-and s = Consonant
-    { position = Pos4
-    ; muted = Some "i"
-    ; category = I
-    ; primary = true
-    ; repr = "3" }
-
-and z = Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = I
-    ; primary = true
-    ; repr = "4" }
-
-and m = Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = II
-    ; primary = true
-    ; repr = "t" }
-
-and n = Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = I
-    ; primary = true
-    ; repr = "5" }
-
-and gn = Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = III
-    ; primary = false
-    ; repr = "b" }
-
-and l = Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = II
-    ; primary = false
-    ; repr = "j" }
-
-and r = Consonant
-    { position = Pos2
-    ; muted = None
-    ; category = I
-    ; primary = false
-    ; repr = "7" }
-
-let nasal v =
-  let Voyel letter = v [@@warning "-8"] in
-  Nasal
-    ( fun f ->
-        let Consonant c = m [@@warning "-8"] in
-        let default = c.repr ^ letter.repr in
-
-        match f with
-        | Consonant c -> begin match c.category with
-            | I -> default
-            | II ->
-              let Consonant c = n [@@warning "-8"] in
-              c.repr ^ letter.repr
-            | III ->
-              let Consonant c = gn [@@warning "-8"] in
-              c.repr ^ letter.repr
-          end
-        | _ -> default
-    )
-
-let a_nasal = nasal a
-and o_nasal = nasal o
-and i_nasal = nasal i
-and y_nasal = nasal y
-
-and semi_voyel_w = Consonant
-    { position = Pos3
-    ; muted = None
-    ; category = II
-    ; primary = false
-    ; repr = "." }
-
-and semi_voyel_y = Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = II
-    ; primary = false
-    ; repr = "l" }
-
-and semi_voyel_u = Consonant
-    { position = Pos2
-    ; muted = None
-    ; category = II
-    ; primary = false
-    ; repr = "]" }
+and u = T.Voyel
+    { T.position = `Above
+    ; T.app = fun () -> ""
+    }
 
-  (*
-let diphtongue
-  : t -> t -> t
-  = fun t1 t2 -> match t1, t2 with
-    (*
-    | Consonant _, Voyel _ when t1 = semi_voyel_y && t2 = schwa ->
-      Consonant
-        { position = Pos1
-        ; muted = None
-        ; category = II
-        ; primary = false
-        ; repr = "m"}
-        *)
-    | Consonant c, Voyel v ->
-      Repr(c.repr ^ (v.app c.position))
-    | Consonant c, Nasal n ->
-      Repr(c.repr ^ (n none))
-    | _ ->
-      print_endline "Ignoring diphtongue";
-      none
+let portant =       T.portant       ""             ()
+
+and t =             T.t             "" (Some "")  ()
+and d =             T.d             "" (Some "")  ()
+and p =             T.p             "" (Some "")  ()
+and b =             T.b             "" (Some "")  ()
+and k =             T.k             "" (Some "")  ()
+and g =             T.g             "" (Some "")  ()
+and f =             T.f             ""             ()
+and v =             T.v             ""             ()
+and ch =            T.ch            ""             ()
+and j =             T.j             ""             ()
+and s =             T.s             "" (Some "")  ()
+and z =             T.z             ""             ()
+and m =             T.m             ""             ()
+and n =             T.n             ""             ()
+and gn =            T.gn            ""             ()
+and ng =            T.ng            ""             ()
+and r =             T.r             "" (Some "")  ()
+and l =             T.l             ""             ()
+
+and semi_voyel_w =  T.semi_voyel_w  ""             ()
+and semi_voyel_y =  T.semi_voyel_y  ""             ()
+and semi_voyel_u =  T.semi_voyel_u  ""             ()
+
+let a_nasal =       T.nasal m ng n a'
+and o_nasal =       T.nasal m ng n o'
+and i_nasal =       T.nasal m ng n i'
+and y_nasal =       T.nasal m ng n y'
 
 let muted
   : t -> t
@@ -279,77 +93,11 @@ let muted
     | Consonant c ->
       begin match c.muted with
         | None -> t
-        | Some s -> Consonant {c with repr = s}
+        | Some s -> Consonant {c with repr = s ; position = ()}
       end
     | _ -> t
 
+let diphtongue = T.diphtongue
 
-and portant =
-  { position = Pos4
-  ; muted = None
-  ; category = III
-  ; primary = false
-  ; repr = "`" }
-
-let fold
-  : t list -> string
-  = fun elems ->
-    let buff = Buffer.create 16 in
-
-    let rec _fold
-      = fun init -> function
-        | [] ->
-          begin match init with
-            | None
-            | Some Nothing
-              -> ()
-            | Some Voyel ( {position = `Above; _ } as v) ->
-              Buffer.add_string buff ("`" ^ (v.app portant.position))
-            | Some Voyel ( {position = `Below; _ } as v) ->
-              Buffer.add_string buff (v.app Pos1)
-            | Some Nasal n ->
-              Buffer.add_string buff ("`" ^ (n (Consonant portant)))
-            | Some Repr r ->
-              Buffer.add_string buff r
-            | Some Consonant c ->
-              Buffer.add_string buff (c.repr)
-          end
-        | hd::tl ->
-          match init, hd with
-          | Some Nothing, _ -> _fold (Some hd) tl
-          | _, Nothing      -> _fold init tl
-          | Some Voyel ({position = `Above; _} as v), Consonant c ->
-            Buffer.add_string buff (c.repr ^ (v.app c.position));
-            _fold None tl
-          | Some Voyel ({position = `Below; _} as v), Consonant c ->
-            Buffer.add_string buff ((v.app Pos1)^ c.repr);
-            _fold None tl
-          | Some Nasal n, Consonant c ->
-            Buffer.add_string buff (c.repr ^ (n hd));
-            _fold None tl
-          | Some Voyel v, _ ->
-            Buffer.add_string buff ("`" ^ (v.app portant.position));
-            _fold (Some hd) tl
-          | Some Nasal n, _ ->
-            Buffer.add_string buff ("`" ^ (n (Consonant portant)));
-            _fold (Some hd) tl
-          | Some Repr r, _ ->
-            Buffer.add_string buff r;
-            _fold (Some hd) tl
-          | Some Consonant c, _ ->
-            Buffer.add_string buff c.repr;
-            _fold (Some hd) tl
-
-          | None, Consonant c ->
-            Buffer.add_string buff c.repr;
-            _fold None tl
-          | None, Repr r ->
-            Buffer.add_string buff r;
-            _fold None tl
-          | None, Voyel _
-          | None, Nasal _ -> _fold (Some hd) tl
+let fold = T.fold ~portant
 
-    in
-    _fold None elems;
-    Buffer.contents buff
-    *)
diff --git a/src/lib/repr/tengwar.ml b/src/lib/repr/tengwar.ml
index 61fbc87..f9fde05 100644
--- a/src/lib/repr/tengwar.ml
+++ b/src/lib/repr/tengwar.ml
@@ -9,8 +9,7 @@ type category =
   | III
 
 type 'a voyel =
-  { opened : bool
-  ; position : position_type
+  { position : position_type
   ; app : ('a -> string) }
 
 type 'a consonant =
@@ -118,8 +117,7 @@ let nasal m ng n letter =
             {empty_glyph with
              tengwa = Some c
            ; tehta_above = Some letter } in
-        g::f::[]
-    )
+        g::f::[] )
 
 let diphtongue
   : 'a t -> 'a t -> 'a t
@@ -185,6 +183,10 @@ let fold
             _fold
               (Some {empty_glyph with tengwa = Some c})
               tl
+          | Some ({ tehta_below = None ; _} as t), Voyel ({position = `Below; _} as v) ->
+            _fold
+              (Some {t with tehta_below = Some v})
+              tl
           | Some ({ tehta_below = Some _ ; _} as t), Voyel ({position = `Below; _} as v) ->
             repr_glyph ~portant t buff;
             _fold
@@ -200,10 +202,6 @@ let fold
             _fold
               (Some {empty_glyph with tehta_above = Some v})
               tl
-          | Some t, Voyel v ->
-            _fold
-              (Some (add_voyel_to_glyph t v))
-              tl
           | Some ({ tengwa = None ; _} as t), Consonant c ->
             _fold
               (Some {t with tengwa = Some c})
@@ -227,3 +225,160 @@ let fold
     in
     _fold None elems;
     Buffer.contents buff
+
+let p repr muted position = Consonant
+    { position
+    ; muted
+    ; category = II
+    ; primary = true
+    ; repr }
+
+and b repr muted position = Consonant
+    { position
+    ; muted
+    ; category = II
+    ; primary = true
+    ; repr }
+
+and t repr muted position = Consonant
+    { position
+    ; muted
+    ; category = I
+    ; primary = true
+    ; repr }
+
+and d repr muted position = Consonant
+    { position
+    ; muted
+    ; category = I
+    ; primary = true
+    ; repr }
+
+and k repr muted position = Consonant
+    { position
+    ; muted
+    ; category = III
+    ; primary = true
+    ; repr }
+
+and g repr muted position = Consonant
+    { position
+    ; muted
+    ; category = III
+    ; primary = true
+    ; repr }
+
+and f repr position = Consonant
+    { position
+    ; muted = None
+    ; category = II
+    ; primary = true
+    ; repr }
+
+and v repr position = Consonant
+    { position
+    ; muted = None
+    ; category = II
+    ; primary = true
+    ; repr }
+
+and ch repr position = Consonant
+    { position
+    ; muted = None
+    ; category = III
+    ; primary = true
+    ; repr }
+
+and j repr position = Consonant
+    { position
+    ; muted = None
+    ; category = III
+    ; primary = true
+    ; repr }
+
+and s repr muted position = Consonant
+    { position
+    ; muted
+    ; category = I
+    ; primary = true
+    ; repr }
+
+and z repr position = Consonant
+    { position
+    ; muted = None
+    ; category = I
+    ; primary = true
+    ; repr }
+
+and m repr position = Consonant
+    { position
+    ; muted = None
+    ; category = II
+    ; primary = true
+    ; repr }
+
+and n repr position = Consonant
+    { position
+    ; muted = None
+    ; category = I
+    ; primary = true
+    ; repr }
+
+and gn repr position = Consonant
+    { position
+    ; muted = None
+    ; category = III
+    ; primary = false
+    ; repr }
+
+and ng repr position = Consonant
+    { position
+    ; muted = None
+    ; category = III
+    ; primary = true
+    ; repr }
+
+and r repr muted position = Consonant
+    { position
+    ; muted
+    ; category = I
+    ; primary = false
+    ; repr }
+
+and semi_voyel_w repr position = Consonant
+    { position
+    ; muted = None
+    ; category = II
+    ; primary = false
+    ; repr }
+
+and semi_voyel_y repr position = Consonant
+    { position
+    ; muted = None
+    ; category = II
+    ; primary = false
+    ; repr }
+
+and semi_voyel_u repr position = Consonant
+    { position
+    ; muted = None
+    ; category = II
+    ; primary = false
+    ; repr }
+
+let l repr position =
+  let default =
+    { position
+    ; muted = None
+    ; category = II
+    ; primary = false
+    ; repr } in
+  Consonant default
+
+let portant repr position =
+  { position
+  ; muted = None
+  ; category = I
+  ; primary = false
+  ; repr }
+
diff --git a/src/test/test.ml b/src/test/test.ml
index 0d1f1c4..cbbf498 100644
--- a/src/test/test.ml
+++ b/src/test/test.ml
@@ -98,6 +98,7 @@ let tests =
   ; "joues",        "Zu(s)"
   ; "libellule",    "LibELyL°"
   ; "main",         "m5"
+  ; "manger",       "m@ge(R)"
   ; "merci",        "mERsi"
   ; "ménageais",    "menaZE(s)"
   ; "mouillage",    "mu[ja]Z°"
author	Sébastien Dailly <sebastien@chimrod.com>	2021-09-20 22:27:04 +0200
committer	Sébastien Dailly <sebastien@chimrod.com>	2021-09-20 22:27:04 +0200
commit	3b90a643b3820e97bf1dab28ce41dacc4ca2831f (patch)
tree	d9155ffdb21f109f41b69438c87b5fb0b3ee41fb
parent	21d05774e5f78b6d070d69f714873b2c2a7cfe28 (diff)