summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/bin/transcriptor.ml2
-rw-r--r--src/js/tengwar.ml2
-rw-r--r--src/lib/repr/anatar.ml282
-rw-r--r--src/lib/repr/anatar.mli1
-rw-r--r--src/lib/repr/tengwar.ml335
-rw-r--r--src/lib/repr/tengwar.mli1
6 files changed, 315 insertions, 308 deletions
diff --git a/src/bin/transcriptor.ml b/src/bin/transcriptor.ml
index feb24db..d759452 100644
--- a/src/bin/transcriptor.ml
+++ b/src/bin/transcriptor.ml
@@ -14,7 +14,7 @@ let process (optional_line : string option) =
| Ok response -> print_endline response
| Error err -> print_endline err in
let res2 = Result.map
- (fun t-> Sounds.repr (module Repr.Tengwar) t)
+ (fun t-> Sounds.repr (module Repr.Anatar) t)
result in
let () = match res2 with
| Ok response -> print_endline response
diff --git a/src/js/tengwar.ml b/src/js/tengwar.ml
index dd37c2d..24b8a3c 100644
--- a/src/js/tengwar.ml
+++ b/src/js/tengwar.ml
@@ -35,7 +35,7 @@ let main id phon tengwar =
El.set_prop El.Prop.value (Jstr.of_string response) phon
| Error _err -> () in
let res2 = Result.map
- (fun t-> Sounds.repr (module Repr.Tengwar) t)
+ (fun t-> Sounds.repr (module Repr.Anatar) t)
transcription in
let () = match res2 with
| Ok response ->
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