Update tengwar

4 files changed, 200 insertions, 74 deletions

diff --git a/src/lib/repr/default.ml b/src/lib/repr/default.ml
index 2688411..22a023f 100644
--- a/src/lib/repr/default.ml
+++ b/src/lib/repr/default.ml
@@ -51,6 +51,7 @@ and r = "R"
 
 and semi_voyel_w = "w"
 and semi_voyel_y = "j"
+and semi_voyel_u = "8"
 
 let muted
   : t -> t
diff --git a/src/lib/repr/default.mli b/src/lib/repr/default.mli
index 27a84bb..26c7d73 100644
--- a/src/lib/repr/default.mli
+++ b/src/lib/repr/default.mli
@@ -1 +1 @@
-include Sounds.Sig.REPR with type t = String.t
+include Sounds.Sig.REPR
diff --git a/src/lib/repr/tengwar.ml b/src/lib/repr/tengwar.ml
index 4d9ad5e..4fc224b 100644
--- a/src/lib/repr/tengwar.ml
+++ b/src/lib/repr/tengwar.ml
@@ -13,10 +13,12 @@ type category =
 
 type voyel =
   { opened : bool
+  ; position : [`Above | `Below ]
   ; app : (position -> string) }
 
 type consonant =
   { position : position
+  ; muted: string option
   ; repr : string
   ; primary : bool
   ; category : category }
@@ -28,29 +30,19 @@ and t =
   | Consonant of consonant
   | Voyel of voyel
   | Nasal of nasal
+  | Repr of string
+  | Nothing
 
-let none = ""
+let none = Nothing
 
-let a =
-  { opened = true
-  ; app = function
-      | Pos1 -> "#"
-      | Pos2 -> "E"
-      | Pos3 -> "D"
-      | Pos4 -> "C" }
-
-and a_nasal = Nasal
-    (fun f -> match f with
-       | Consonant c -> begin match c.primary, c.position, c.category with
-           | true, Pos1, _ -> "{#"
-           | true, _, _ -> "[E"
-           | false, _, I -> "5#"
-           | false, _, II -> "t#"
-           | false, _, III -> "g#"
-         end
-       | _ -> "`pC"
-
-    )
+let a = Voyel
+    { opened = true
+    ; position = `Above
+    ; app = function
+        | Pos1 -> "#"
+        | Pos2 -> "E"
+        | Pos3 -> "D"
+        | Pos4 -> "C" }
 
 let app_e = function
   | Pos1 -> "$"
@@ -64,20 +56,68 @@ and app_eu = function
   | Pos3 -> "Þ"
   | Pos4 -> "ß"
 
-let e_opened = { opened = true  ; app = app_e }
-and e_closed = { opened = false ; app = app_e }
-and schwa = "°"
+let e_opened = Voyel { opened = true ; position = `Above ; app = app_e }
+and e_closed = Voyel { opened = false; position = `Above ; app = app_e }
+and schwa = Voyel
+    { opened = true
+    ; position = `Below
+    ; app = function
+        | Pos1 -> "È"
+        | Pos2 -> "É"
+        | Pos3 -> "Ê"
+        | Pos4 -> "Ë" }
+
+and eu_opened = Voyel { opened = true  ; position = `Above ; app = app_eu }
+and eu_closed = Voyel { opened = false ; position = `Above ; app = app_eu }
+
+and o = Voyel
+    { opened = true
+    ; position = `Above
+    ; app = function
+        | Pos1 -> "^"
+        | Pos2 -> "Y"
+        | Pos3 -> "H"
+        | Pos4 -> "N" }
+
+and i = Voyel
+    { opened = true
+    ; position = `Above
+    ; app = function
+        | Pos1 -> "%"
+        | Pos2 -> "T"
+        | Pos3 -> "G"
+        | Pos4 -> "B" }
+
+and y = Voyel
+    { opened = true
+    ; position = `Above
+    ; app = function
+        | Pos1 -> "Ø"
+        | Pos2 -> "Ù"
+        | Pos3 -> "Ú"
+        | Pos4 -> "Û" }
+
+and u = Voyel
+    { opened = true
+    ; position = `Above
+    ; app = function
+        | Pos1 -> "&"
+        | Pos2 -> "U"
+        | Pos3 -> "J"
+        | Pos4 -> "M" }
 
-and eu_opened = { opened = true  ; app = app_eu }
-and eu_closed = { opened = false ; app = app_eu }
+and a_nasal = Nasal
+    (fun f -> match f with
+       | Consonant c -> begin match c.primary, c.position, c.category with
+           | true, Pos1, _ -> "{#"
+           | true, _, _ -> "[E"
+           | false, _, I -> "5#"
+           | false, _, II -> "t#"
+           | false, _, III -> "g#"
+         end
+       | _ -> "5#"
 
-and o =
-  { opened = true
-  ; app = function
-      | Pos1 -> "^"
-      | Pos2 -> "Y"
-      | Pos3 -> "H"
-      | Pos4 -> "N" }
+    )
 
 and o_nasal = Nasal
     (fun f -> match f with
@@ -88,17 +128,9 @@ and o_nasal = Nasal
            | false, _, II -> "t^"
            | false, _, III -> "g^"
          end
-       | _ -> "`pN"
+       | _ -> "5^"
     )
 
-and i =
-  { opened = true
-  ; app = function
-      | Pos1 -> "%"
-      | Pos2 -> "T"
-      | Pos3 -> "G"
-      | Pos4 -> "B" }
-
 and i_nasal = Nasal
     (fun f -> match f with
        | Consonant c -> begin match c.primary, c.position, c.category with
@@ -108,16 +140,7 @@ and i_nasal = Nasal
            | false, _, II -> "t$"
            | false, _, III -> "g$"
          end
-       | _ -> "`pV"
-    )
-
-and y =
-  { opened = true
-  ; app = function
-      | Pos1 -> "Ø"
-      | Pos2 -> "Ù"
-      | Pos3 -> "Ú"
-      | Pos4 -> "Û" }
+       | _ -> "5$")
 
 and y_nasal = Nasal
     (fun f -> match f with
@@ -128,144 +151,245 @@ and y_nasal = Nasal
            | false, _, II -> "tØ"
            | false, _, III -> "gØ"
          end
-       | _ -> "`pÛ"
-
-    )
-
-and u =
-  { opened = true
-  ; app = function
-      | Pos1 -> "&"
-      | Pos2 -> "U"
-      | Pos3 -> "J"
-      | Pos4 -> "M" }
+       | _ -> "5Ø")
 
 and p = Consonant
     { position = Pos2
+    ; muted = Some "y"
     ; category = II
     ; primary = true
     ; repr = "q" }
+
 and b = Consonant
     { position = Pos1
+    ; muted = Some "y"
     ; category = II
     ; primary = true
     ; repr = "w" }
 
 and t = Consonant
     { position = Pos2
+    ; muted = Some "6"
     ; category = I
     ; primary = true
     ; repr = "1" }
+
 and d = Consonant
     { position = Pos1
+    ; muted = Some "6"
     ; category = I
     ; primary = true
     ; repr = "2" }
 
 and k = Consonant
     { position = Pos3
+    ; muted = Some "h"
     ; category = III
     ; primary = true
     ; repr = "a" }
+
 and g = Consonant
     { position = Pos1
+    ; muted = Some "h"
     ; category = III
     ; primary = true
     ; repr = "s" }
 
 and f = Consonant
     { position = Pos3
+    ; muted = None
     ; category = II
     ; primary = true
     ; repr = "e" }
 
 and v = Consonant
     { position = Pos1
+    ; muted = None
     ; category = II
     ; primary = true
     ; repr = "r" }
 
 and ch = Consonant
     { position = Pos1
+    ; muted = None
     ; category = III
     ; primary = true
     ; repr = "d" }
+
 and j = Consonant
     { position = Pos1
+    ; muted = None
     ; category = III
     ; primary = true
     ; repr = "f" }
 
 and s = Consonant
-    { position = Pos3
+    { 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" }
 
 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 = "]" }
+
+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 muted
   : t -> t
   = fun t ->
-    Printf.sprintf "(%s)" t
-
-let diphtongue
-  : t -> t -> t
-  = fun t1 t2 ->
-    Printf.sprintf "[%s%s]" t1 t2
+    match t with
+    | Consonant c ->
+      begin match c.muted with
+        | None -> t
+        | Some s -> Consonant {c with repr = s}
+      end
+    | _ -> t
+
+
+and portant =
+  { position = Pos4
+  ; muted = None
+  ; category = III
+  ; primary = false
+  ; repr = "`" }
 
 let fold
   : t list -> string
   = fun elems ->
     let buff = Buffer.create 16 in
-    List.iter elems
-      ~f:(fun f -> Buffer.add_string buff f);
+
+    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
+
+    in
+    _fold None elems;
     Buffer.contents buff
-    *)
diff --git a/src/lib/repr/tengwar.mli b/src/lib/repr/tengwar.mli
new file mode 100644
index 0000000..8204341
--- /dev/null
+++ b/src/lib/repr/tengwar.mli
@@ -0,0 +1 @@
+include Sounds.Sig.REPR