From 3b90a643b3820e97bf1dab28ce41dacc4ca2831f Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Mon, 20 Sep 2021 22:27:04 +0200 Subject: Updated from js usage --- src/lib/repr/telcontar.ml | 398 +++++++++------------------------------------- 1 file changed, 73 insertions(+), 325 deletions(-) (limited to 'src/lib/repr/telcontar.ml') 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 - *) -- cgit v1.2.3