Separation between font and tengwar

4 files changed, 313 insertions, 306 deletions

diff --git a/src/lib/repr/anatar.ml b/src/lib/repr/anatar.ml
new file mode 100644
index 0000000..1d00266
--- /dev/null
+++ b/src/lib/repr/anatar.ml
@@ -0,0 +1,282 @@
+module T = Tengwar
+
+(** Glyph position for the diacritc *)
+type position =
+  | Pos1
+  | 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 *)
+
+type t = position T.t
+
+let portant =
+  { T.position = Pos4
+  ; T.muted = None
+  ; T.category = I
+  ; T.primary = false
+  ; T.repr = "`" }
+
+let none = T.Nothing
+
+let space s = T.Repr s
+
+let a' =
+  { T.opened = true
+  ; T.position = `Above
+  ; T.app = function
+      | Pos1 | Lower_1_2 | Lambe -> "#"
+      | Pos2 -> "E"
+      | Pos3 | Lower_3_1 -> "D"
+      | Pos4 | Lower_4_2 -> "C"
+  }
+let a = T.Voyel a'
+
+let app_e = function
+  | Pos1 | Lower_1_2 | Lambe -> "$"
+  | Pos2 -> "R"
+  | Pos3 | Lower_3_1 -> "F"
+  | Pos4 | Lower_4_2 -> "V"
+
+and app_eu = function
+  | Pos1 | Lower_1_2 | Lambe -> "Ü"
+  | Pos2 -> "Ý"
+  | Pos3 | Lower_3_1 -> "Þ"
+  | Pos4 | Lower_4_2 -> "ß"
+
+let e_opened =
+  T.Voyel { opened = true ; position = `Above ; app = app_e }
+and e_closed =
+  T.Voyel { opened = false; position = `Above ; app = app_e }
+
+and schwa = T.Voyel
+    { opened = true
+    ; position = `Below
+    ; app = function
+        | Pos1 | Lower_3_1 -> "È"
+        | Pos2 | Lower_1_2 | Lower_4_2 -> "É"
+        | Pos3 -> "Ê"
+        | Pos4 -> "Ë"
+        | 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 o' =
+  { T.opened = true
+  ; T.position = `Above
+  ; T.app = function
+      | Pos1 | Lower_1_2 | Lambe -> "^"
+      | Pos2 -> "Y"
+      | Pos3 | Lower_3_1 -> "H"
+      | Pos4 | Lower_4_2 -> "N"
+  }
+
+let o = T.Voyel o'
+
+and i' =
+  { T.opened = true
+  ; T.position = `Above
+  ; T.app = function
+      | Pos1 | Lower_1_2 | Lambe -> "%"
+      | Pos2 -> "T"
+      | Pos3 | Lower_3_1 -> "G"
+      | Pos4 | Lower_4_2 -> "B"
+  }
+
+let i = T.Voyel i'
+
+and y' =
+  { T.opened = true
+  ; T.position = `Above
+  ; T.app = function
+      | Pos1 | Lower_1_2 | Lambe -> "Ø"
+      | Pos2 -> "Ù"
+      | Pos3 | Lower_3_1 -> "Ú"
+      | Pos4 | Lower_4_2 -> "Û"
+  }
+
+let y = T.Voyel y'
+
+and u = T.Voyel
+    { T.opened = true
+    ; T.position = `Above
+    ; T.app = function
+        | Pos1 | Lower_1_2 | Lambe -> "&"
+        | Pos2 -> "U"
+        | Pos3 | Lower_3_1 -> "J"
+        | 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 muted
+  : t -> t
+  = fun t ->
+    match t with
+    | Consonant c ->
+      begin match c.muted with
+        | None -> t
+        | Some s -> Consonant {c with repr = s ; position = Pos2}
+      end
+    | _ -> t
+
+let diphtongue = T.diphtongue
+
+let fold = T.fold ~portant
diff --git a/src/lib/repr/anatar.mli b/src/lib/repr/anatar.mli
new file mode 100644
index 0000000..26c7d73
--- /dev/null
+++ b/src/lib/repr/anatar.mli
@@ -0,0 +1 @@
+include Sounds.Sig.REPR
diff --git a/src/lib/repr/tengwar.ml b/src/lib/repr/tengwar.ml
index d529016..61fbc87 100644
--- a/src/lib/repr/tengwar.ml
+++ b/src/lib/repr/tengwar.ml
@@ -2,42 +2,30 @@ type position_type =
   [ `Above
   | `Below ]
 
-(** Glyph position for the diacritc *)
-type position =
-  | Pos1
-  | Pos2
-  | Pos3
-  | Pos4
-  | Lower5 (* 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 *)
-
 (** Consonant category *)
 type category =
   | I
   | II
   | III
 
-type voyel =
+type 'a voyel =
   { opened : bool
   ; position : position_type
-  ; app : (position -> string) }
+  ; app : ('a -> string) }
 
-type consonant =
-  { position : position
+type 'a consonant =
+  { position : 'a
   ; muted: string option
   ; repr : string
   ; primary : bool
   ; category : category }
 
-
-type glyph =
-  { tengwa : consonant option
+type 'a glyph =
+  { tengwa : 'a consonant option
   (* The eventual Tehta above the tengwa *)
-  ; tehta_above : voyel option
+  ; tehta_above : 'a voyel option
   (* And below *)
-  ; tehta_below : voyel option
+  ; tehta_below : 'a voyel option
   }
 
 let empty_glyph =
@@ -46,20 +34,13 @@ let empty_glyph =
   ; tehta_below = None }
 
 let pair
-  : voyel -> consonant -> string
+  : 'a voyel -> 'a consonant -> string
   = fun voyel consonant ->
     voyel.app consonant.position
 
-let portant =
-  { position = Pos4
-  ; muted = None
-  ; category = I
-  ; primary = false
-  ; repr = "`" }
-
 let repr_glyph
-  : glyph -> Buffer.t -> unit
-  = fun { tengwa; tehta_above; tehta_below } b ->
+  : portant:'a consonant -> 'a glyph -> Buffer.t -> unit
+  = fun ~portant { tengwa; tehta_above; tehta_below } b ->
     let () =  match tengwa with
       | None -> Buffer.add_string b @@ portant.repr
       | Some c ->Buffer.add_string b @@ c.repr in
@@ -74,7 +55,7 @@ let repr_glyph
     ()
 
 let combine_glyph
-  : glyph -> glyph -> glyph option
+  : 'a glyph -> 'a glyph -> 'a glyph option
   = fun g1 g2 ->
     let tengwa = match g1.tengwa, g2.tengwa with
       | Some _, Some _ -> Error ()
@@ -95,264 +76,25 @@ let combine_glyph
     | _, _, _ -> None
 
 let add_voyel_to_glyph
-  : glyph -> voyel -> glyph
+  : 'a glyph -> 'a voyel -> 'a glyph
   = fun g v ->
     match v.position with
     | `Above -> { g with tehta_above = Some v }
     | `Below -> { g with tehta_below = Some v }
 
-type application = (t -> t list)
-
-and t =
-  | Consonant of consonant
-  | Voyel of voyel
-  | Application of application
+type 'a t =
+  | Consonant of 'a consonant
+  | Voyel of 'a voyel
+  | Application of ('a t -> 'a t list)
   | Repr of string
-  | Glyph of glyph
+  | Glyph of 'a glyph
   | Nothing
 
 let none = Nothing
 
 let space s = Repr s
 
-let a' =
-  { opened = true
-  ; position = `Above
-  ; app = function
-      | Pos1 | Lower_1_2 |Lower5 -> "#"
-      | Pos2 -> "E"
-      | Pos3 | Lower_3_1 -> "D"
-      | Pos4 | Lower_4_2 -> "C"
-  }
-let a = Voyel a'
-
-let app_e = function
-  | Pos1 | Lower_1_2 | Lower5 -> "$"
-  | Pos2 -> "R"
-  | Pos3 | Lower_3_1 -> "F"
-  | Pos4 | Lower_4_2 -> "V"
-
-and app_eu = function
-  | Pos1 | Lower_1_2 | Lower5 -> "Ü"
-  | Pos2 -> "Ý"
-  | Pos3 | Lower_3_1 -> "Þ"
-  | Pos4 | Lower_4_2 -> "ß"
-
-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 | Lower_3_1 -> "È"
-        | Pos2 | Lower_1_2 | Lower_4_2 -> "É"
-        | Pos3 -> "Ê"
-        | Pos4 -> "Ë"
-        | Lower5 -> "L"
-    }
-
-and eu_opened = Voyel { opened = true  ; position = `Above ; app = app_eu }
-and eu_closed = Voyel { opened = false ; position = `Above ; app = app_eu }
-
-and o' =
-  { opened = true
-  ; position = `Above
-  ; app = function
-      | Pos1 | Lower_1_2 | Lower5 -> "^"
-      | Pos2 -> "Y"
-      | Pos3 | Lower_3_1 -> "H"
-      | Pos4 | Lower_4_2 -> "N"
-  }
-
-let o = Voyel o'
-
-and i' =
-  { opened = true
-  ; position = `Above
-  ; app = function
-      | Pos1 | Lower_1_2 | Lower5 -> "%"
-      | Pos2 -> "T"
-      | Pos3 | Lower_3_1 -> "G"
-      | Pos4 | Lower_4_2 -> "B"
-  }
-
-let i = Voyel i'
-
-and y' =
-  { opened = true
-  ; position = `Above
-  ; app = function
-      | Pos1 | Lower_1_2 | Lower5 -> "Ø"
-      | Pos2 -> "Ù"
-      | Pos3 | Lower_3_1 -> "Ú"
-      | Pos4 | Lower_4_2 -> "Û"
-  }
-
-let y = Voyel y'
-
-and u = Voyel
-    { opened = true
-    ; position = `Above
-    ; app = function
-        | Pos1 | Lower_1_2 | Lower5 -> "&"
-        | Pos2 -> "U"
-        | Pos3 | Lower_3_1 -> "J"
-        | Pos4 | Lower_4_2 -> "M"
-    }
-
-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 = Lower_3_1
-    ; 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 = Lower_1_2
-    ; 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 = Lower_4_2
-    ; 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 ng = Consonant
-    { position = Pos1
-    ; muted = None
-    ; category = III
-    ; primary = true
-    ; repr = "g" }
-
-and r = Consonant
-    { position = Pos2
-    ; muted = Some "u"
-    ; 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 l =
-  let default =
-    { position = Lower5
-    ; muted = None
-    ; category = II
-    ; primary = false
-    ; repr = "j" } in
-  Consonant default
-
-let nasal letter =
+let nasal m ng n letter =
   Application
     ( function
       | Consonant { category = II; _} as f ->
@@ -378,24 +120,9 @@ let nasal letter =
            ; tehta_above = Some letter } in
         g::f::[]
     )
-let a_nasal = nasal a'
-and o_nasal = nasal o'
-and i_nasal = nasal i'
-and y_nasal = nasal y'
-
-let muted
-  : t -> t
-  = fun t ->
-    match t with
-    | Consonant c ->
-      begin match c.muted with
-        | None -> t
-        | Some s -> Consonant {c with repr = s ; position = Pos2}
-      end
-    | _ -> t
 
 let diphtongue
-  : t -> t -> t
+  : 'a t -> 'a t -> 'a t
   = fun t1 t2 ->
     match t1 with
 
@@ -409,18 +136,18 @@ let diphtongue
       Nothing
 
 let fold
-  : t list -> string
-  = fun elems ->
+  : portant:'a consonant -> 'a t list -> string
+  = fun ~portant elems ->
     let buff = Buffer.create 16 in
 
     let rec _fold
-      : glyph option -> t list -> unit
+      : 'a glyph option -> 'a t list -> unit
       = fun init -> function
         | [] ->
           begin match init with
             | None -> ()
             | Some glyph ->
-              repr_glyph glyph buff
+              repr_glyph ~portant glyph buff
           end
         | hd::tl ->
           match init, hd with
@@ -448,28 +175,28 @@ let fold
             _fold any (result @ rest)
 
           | Some t, Repr s ->
-            repr_glyph t buff;
+            repr_glyph ~portant t buff;
             Buffer.add_string buff s;
             _fold
               None
               tl
           | Some ({ tengwa = Some _ ; _} as t), Consonant c ->
-            repr_glyph t buff;
+            repr_glyph ~portant t buff;
             _fold
               (Some {empty_glyph with tengwa = Some c})
               tl
           | Some ({ tehta_below = Some _ ; _} as t), Voyel ({position = `Below; _} as v) ->
-            repr_glyph t buff;
+            repr_glyph ~portant t buff;
             _fold
               (Some {empty_glyph with tehta_below = Some v})
               tl
           | Some ({ tehta_below = Some _ ; _} as t), Consonant c ->
-            repr_glyph t buff;
+            repr_glyph ~portant t buff;
             _fold
               (Some {empty_glyph with tengwa = Some c})
               tl
           | Some t, Voyel ({position = `Above; _} as v) ->
-            repr_glyph t buff;
+            repr_glyph ~portant t buff;
             _fold
               (Some {empty_glyph with tehta_above = Some v})
               tl
@@ -492,13 +219,11 @@ let fold
                   res
                   tl
               | None ->
-                repr_glyph g1 buff;
+                repr_glyph ~portant g1 buff;
                 _fold
                   (Some g2)
                   tl
             end
-
-
     in
     _fold None elems;
     Buffer.contents buff
diff --git a/src/lib/repr/tengwar.mli b/src/lib/repr/tengwar.mli
deleted file mode 100644
index 8204341..0000000
--- a/src/lib/repr/tengwar.mli
+++ /dev/null
@@ -1 +0,0 @@
-include Sounds.Sig.REPR