summaryrefslogtreecommitdiff
path: root/src/lib
diff options
context:
space:
mode:
Diffstat (limited to 'src/lib')
-rw-r--r--src/lib/repr/telcontar.ml355
-rw-r--r--src/lib/repr/tengwar.ml364
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;
generated by cgit v1.2.3 (git 2.46.0) at 2025-10-31 03:28:42 +0000