diff options
| -rw-r--r-- | src/bin/transcriptor.ml | 2 | ||||
| -rw-r--r-- | src/js/tengwar.ml | 2 | ||||
| -rw-r--r-- | src/lib/repr/anatar.ml | 282 | ||||
| -rw-r--r-- | src/lib/repr/anatar.mli | 1 | ||||
| -rw-r--r-- | src/lib/repr/tengwar.ml | 335 | ||||
| -rw-r--r-- | src/lib/repr/tengwar.mli | 1 |
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 |