diff options
author | Sébastien Dailly <sebastien@chimrod.com> | 2021-09-13 13:44:25 +0200 |
---|---|---|
committer | Sébastien Dailly <sebastien@chimrod.com> | 2021-09-13 13:44:25 +0200 |
commit | 7bdea3ee4c25e16d2827bb61d451134f8cf64982 (patch) | |
tree | edb8f96be2bf81b9dba8c11cc72d02f58485fb14 | |
parent | 040c74ea186f195b8579960d2a74418c38cd9b76 (diff) |
Update
-rw-r--r-- | src/lib/repr/telcontar.ml | 355 | ||||
-rw-r--r-- | src/lib/repr/tengwar.ml | 364 |
2 files changed, 589 insertions, 130 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 + *) diff --git a/src/lib/repr/tengwar.ml b/src/lib/repr/tengwar.ml index d291a8b..1f34928 100644 --- a/src/lib/repr/tengwar.ml +++ b/src/lib/repr/tengwar.ml @@ -1,9 +1,15 @@ +type position_type = + [ `Above + | `Below ] + (** Glyph position for the diacritc *) type position = | Pos1 | Pos2 | Pos3 | Pos4 + | Lower1 + | Lower2 (** Consonant category *) type category = @@ -13,23 +19,23 @@ type category = type voyel = { opened : bool - ; position : [`Above | `Below ] + ; position : position_type ; app : (position -> string) } type consonant = - { position : position + { position : position * position ; muted: string option ; repr : string ; primary : bool ; category : category } - -type nasal = (t -> string) +type application = (t -> t * t option) and t = | Consonant of consonant | Voyel of voyel - | Nasal of nasal + | Nasal of application + | App of application | Repr of string | Nothing @@ -37,29 +43,40 @@ let none = Nothing let space s = Repr s -let a = Voyel - { opened = true - ; position = `Above - ; app = function - | Pos1 -> "#" - | Pos2 -> "E" - | Pos3 -> "D" - | Pos4 -> "C" } +let a' = + { opened = true + ; position = `Above + ; app = function + | Pos1 -> "#" + | Pos2 -> "E" + | Pos3 -> "D" + | Pos4 -> "C" + | Lower1 -> "" + | Lower2 -> "" + } +let a = Voyel a' let app_e = function | Pos1 -> "$" | Pos2 -> "R" | Pos3 -> "F" | Pos4 -> "V" + | Lower1 -> "" + | Lower2 -> "" and app_eu = function | Pos1 -> "Ü" | Pos2 -> "Ý" | Pos3 -> "Þ" | Pos4 -> "ß" + | Lower1 -> "" + | Lower2 -> "" + +let e_opened = + Voyel { opened = true ; position = `Above ; app = app_e } +and e_closed = + Voyel { opened = false; position = `Above ; app = app_e } -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 @@ -67,37 +84,55 @@ and schwa = Voyel | Pos1 -> "È" | Pos2 -> "É" | Pos3 -> "Ê" - | Pos4 -> "Ë" } + | Pos4 -> "Ë" + | Lower1 -> "Ë" + | Lower2 -> "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 = Voyel - { opened = true - ; position = `Above - ; app = function - | Pos1 -> "^" - | Pos2 -> "Y" - | Pos3 -> "H" - | Pos4 -> "N" } - -and i = Voyel - { opened = true - ; position = `Above - ; app = function - | Pos1 -> "%" - | Pos2 -> "T" - | Pos3 -> "G" - | Pos4 -> "B" } - -and y = Voyel - { opened = true - ; position = `Above - ; app = function - | Pos1 -> "Ø" - | Pos2 -> "Ù" - | Pos3 -> "Ú" - | Pos4 -> "Û" } +and o' = + { opened = true + ; position = `Above + ; app = function + | Pos1 -> "^" + | Pos2 -> "Y" + | Pos3 -> "H" + | Pos4 -> "N" + | Lower1 -> "" + | Lower2 -> "" + } + +let o = Voyel o' + +and i' = + { opened = true + ; position = `Above + ; app = function + | Pos1 -> "%" + | Pos2 -> "T" + | Pos3 -> "G" + | Pos4 -> "B" + | Lower1 -> "" + | Lower2 -> "" + } + +let i = Voyel i' + +and y' = + { opened = true + ; position = `Above + ; app = function + | Pos1 -> "Ø" + | Pos2 -> "Ù" + | Pos3 -> "Ú" + | Pos4 -> "Û" + | Lower1 -> "" + | Lower2 -> "" + } + +let y = Voyel y' and u = Voyel { opened = true @@ -106,193 +141,191 @@ and u = Voyel | Pos1 -> "&" | Pos2 -> "U" | Pos3 -> "J" - | Pos4 -> "M" } + | Pos4 -> "M" + | Lower1 -> "" + | Lower2 -> "" + } and p = Consonant - { position = Pos2 + { position = Pos2, Lower1 ; muted = Some "y" ; category = II ; primary = true ; repr = "q" } and b = Consonant - { position = Pos1 + { position = Pos1, Lower1 ; muted = Some "y" ; category = II ; primary = true ; repr = "w" } and t = Consonant - { position = Pos2 + { position = Pos2, Lower1 ; muted = Some "6" ; category = I ; primary = true ; repr = "1" } and d = Consonant - { position = Pos1 + { position = Pos1, Lower1 ; muted = Some "6" ; category = I ; primary = true ; repr = "2" } and k = Consonant - { position = Pos3 + { position = Pos3, Lower1 ; muted = Some "h" ; category = III ; primary = true ; repr = "a" } and g = Consonant - { position = Pos1 + { position = Pos1, Lower1 ; muted = Some "h" ; category = III ; primary = true ; repr = "s" } and f = Consonant - { position = Pos3 + { position = Pos3, Lower1 ; muted = None ; category = II ; primary = true ; repr = "e" } and v = Consonant - { position = Pos1 + { position = Pos1, Lower1 ; muted = None ; category = II ; primary = true ; repr = "r" } and ch = Consonant - { position = Pos1 + { position = Pos1, Lower1 ; muted = None ; category = III ; primary = true ; repr = "d" } and j = Consonant - { position = Pos1 + { position = Pos1, Lower1 ; muted = None ; category = III ; primary = true ; repr = "f" } and s = Consonant - { position = Pos4 + { position = Pos4, Lower1 ; muted = Some "i" ; category = I ; primary = true ; repr = "3" } and z = Consonant - { position = Pos1 + { position = Pos1, Lower1 ; muted = None ; category = I ; primary = true ; repr = "4" } and m = Consonant - { position = Pos1 + { position = Pos1, Lower1 ; muted = None ; category = II ; primary = true ; repr = "t" } and n = Consonant - { position = Pos1 + { position = Pos1, Lower1 ; muted = None ; category = I ; primary = true ; repr = "5" } and gn = Consonant - { position = Pos1 + { position = Pos1, Lower1 ; 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 + { position = Pos2, Lower1 + ; muted = Some "u" ; category = I ; primary = false ; repr = "7" } and semi_voyel_w = Consonant - { position = Pos3 + { position = Pos3, Lower1 ; muted = None ; category = II ; primary = false ; repr = "." } and semi_voyel_y = Consonant - { position = Pos1 + { position = Pos1, Lower1 ; muted = None ; category = II ; primary = false ; repr = "l" } and semi_voyel_u = Consonant - { position = Pos2 + { position = Pos2, Lower1 ; muted = None ; category = II ; primary = false ; repr = "]" } -let nasal v = - let Voyel letter = v [@@warning "-8"]in +let pair + : voyel -> consonant -> string + = fun voyel consonant -> + match voyel.position with + | `Above -> voyel.app (fst consonant.position) + | `Below -> voyel.app (snd consonant.position) + +let l = + let default = + { position = Pos1, Lower1 + ; muted = None + ; category = II + ; primary = false + ; repr = "j" } in + Consonant default + +let nasal letter = Nasal - ( fun f -> + ( function + | Consonant { category = II; _} as f -> + let Consonant c = m [@@warning "-8"] in + let v = pair letter c in + let repr = c.repr ^ v in + Consonant {c with repr}, Some f + | Consonant { category = III; _} as f -> + let Consonant c = gn [@@warning "-8"] in + let v = pair letter c in + let repr = c.repr ^ v in + Consonant {c with repr}, Some f + | f -> let Consonant c = n [@@warning "-8"] in - let default = c.repr ^ letter.app c.position in - - match f with - | Consonant c -> begin match c.category with - | I -> default - | II -> - let Consonant c = m [@@warning "-8"] in - c.repr ^ letter.app c.position - | III -> - let Consonant c = gn [@@warning "-8"] in - c.repr ^ letter.app c.position - end - | _ -> default + let v = pair letter c in + let repr = c.repr ^ v in + let default = Consonant { c with repr } in + default, Some f ) +let a_nasal = nasal a' +and o_nasal = nasal o' +and i_nasal = nasal i' +and y_nasal = nasal y' -let a_nasal = nasal a -and o_nasal = nasal o -and i_nasal = nasal i -and y_nasal = nasal y - - -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 +and portant = + { position = Pos4, Lower1 + ; muted = None + ; category = I + ; primary = false + ; repr = "`" } let muted : t -> t @@ -306,12 +339,59 @@ let muted | _ -> t -and portant = - { position = Pos4 - ; muted = None - ; category = I - ; primary = false - ; repr = "`" } +let diphtongue + : t -> t -> t + = fun t1 t2 -> match t1, t2 with + | Consonant c, Voyel v -> + + Nasal (fun t -> + match t with + | Nothing -> + let repr = c.repr in + Repr repr, (Some t2) + | Consonant c2 -> + let b = Buffer.create 4 in + Buffer.add_string b c.repr; + Buffer.add_string b c2.repr; + let v2 = pair v c2 in + Buffer.add_string b v2; + let repr = Buffer.contents b in + Repr repr, None + | Repr r -> + let v_repr = pair v portant in + Repr(c.repr ^ portant.repr ^ v_repr ^ r), None + | Voyel _ + | Nasal _ + | App _ -> + let b = Buffer.create 4 in + let v = pair v portant in + Buffer.add_string b c.repr; + Buffer.add_string b portant.repr; + Buffer.add_string b v; + let repr = Buffer.contents b in + ( Repr repr + , Some t) + ) + + | Consonant c, Nasal n + | Consonant c, App n + -> + begin match n none with + | Consonant c2, _ -> + Repr(c.repr ^ c2.repr) + | Repr r, _ -> + Repr(c.repr ^ r) + | Voyel v, _ -> + let v_repr = pair v c in + Repr(c.repr ^ v_repr) + | Nothing, _ + | Nasal _, _ + | App _, _ -> + t1 + end + | _ -> + print_endline "Ignoring diphtongue"; + none let fold : t list -> string @@ -326,11 +406,16 @@ let fold | Some Nothing -> () | Some Voyel ( {position = `Above; _ } as v) -> - Buffer.add_string buff ("`" ^ (v.app portant.position)) + Buffer.add_string buff ("`" ^ (pair v portant)) | Some Voyel ( {position = `Below; _ } as v) -> Buffer.add_string buff (v.app Pos1) - | Some Nasal n -> - Buffer.add_string buff (n (Consonant portant)) + | Some Nasal n + | Some App n -> + let result, next = (n Nothing) in + begin match next with + | None -> _fold (Some result) [] + | Some v -> _fold (Some result) [v] + end | Some Repr r -> Buffer.add_string buff r | Some Consonant c -> @@ -341,20 +426,37 @@ let fold | 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)); + Buffer.add_string buff (c.repr ^ (pair v c)); _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 ((n hd) ^ c.repr); + Buffer.add_string buff ((pair v c) ^ c.repr); _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)); + Buffer.add_string buff ("`" ^ (pair v portant)); _fold (Some hd) tl + | Some Nasal n, Consonant _ + | Some App n, Consonant _ + -> + let result, next = n hd in + begin match next with + | None -> _fold (Some result) tl + | Some hd -> _fold (Some result) (hd::tl) + end + | Some Nasal n, Voyel v + | Some App n, Voyel v + -> + let result, next = (n hd) in + begin match next with + | None -> _fold (Some result) (tl) + | Some next -> _fold (Some result) (next::tl) + end + | Some Nasal n, _ + | Some App n, _ -> + let result, next = (n (Consonant portant)) in + begin match next with + | None -> _fold (Some result) (hd::tl) + | Some next -> _fold (Some result) (next::hd::tl) + end | Some Repr r, _ -> Buffer.add_string buff r; _fold (Some hd) tl @@ -369,7 +471,9 @@ let fold Buffer.add_string buff r; _fold None tl | None, Voyel _ - | None, Nasal _ -> _fold (Some hd) tl + | None, Nasal _ + | None, App _ -> + _fold (Some hd) tl in _fold None elems; |