diff options
Diffstat (limited to 'src/lib/repr/telcontar.ml')
-rw-r--r-- | src/lib/repr/telcontar.ml | 355 |
1 files changed, 355 insertions, 0 deletions
diff --git a/src/lib/repr/telcontar.ml b/src/lib/repr/telcontar.ml new file mode 100644 index 0000000..ef55f37 --- /dev/null +++ b/src/lib/repr/telcontar.ml @@ -0,0 +1,355 @@ +(** Glyph position for the diacritc *) +type position = + | Pos1 + | Pos2 + | Pos3 + | Pos4 + +(** Consonant category *) +type category = + | I + | II + | III + +type voyel = + { opened : bool + ; position : [`Above | `Below ] + ; repr : string } + +type consonant = + { position : position + ; muted: string option + ; repr : string + ; primary : bool + ; category : category } + + +type nasal = (t -> string) + +and t = + | Consonant of consonant + | Voyel of voyel + | Nasal of nasal + | Repr of string + | Nothing + +let none = Nothing + +let space s = Repr s + +let a = Voyel + { opened = true + ; position = `Above + ; repr = "" + } + + +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 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 = 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 = "]" } + + (* +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 -> + 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 + + 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 + *) |