summaryrefslogtreecommitdiff
path: root/src/lib/repr/telcontar.ml
diff options
context:
space:
mode:
Diffstat (limited to 'src/lib/repr/telcontar.ml')
-rw-r--r--src/lib/repr/telcontar.ml398
1 files changed, 73 insertions, 325 deletions
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
- *)