summaryrefslogtreecommitdiff
path: root/src/lib/repr/tengwar.ml
diff options
context:
space:
mode:
Diffstat (limited to 'src/lib/repr/tengwar.ml')
-rw-r--r--src/lib/repr/tengwar.ml270
1 files changed, 197 insertions, 73 deletions
diff --git a/src/lib/repr/tengwar.ml b/src/lib/repr/tengwar.ml
index 4d9ad5e..4fc224b 100644
--- a/src/lib/repr/tengwar.ml
+++ b/src/lib/repr/tengwar.ml
@@ -13,10 +13,12 @@ type category =
type voyel =
{ opened : bool
+ ; position : [`Above | `Below ]
; app : (position -> string) }
type consonant =
{ position : position
+ ; muted: string option
; repr : string
; primary : bool
; category : category }
@@ -28,29 +30,19 @@ and t =
| Consonant of consonant
| Voyel of voyel
| Nasal of nasal
+ | Repr of string
+ | Nothing
-let none = ""
+let none = Nothing
-let a =
- { opened = true
- ; app = function
- | Pos1 -> "#"
- | Pos2 -> "E"
- | Pos3 -> "D"
- | Pos4 -> "C" }
-
-and a_nasal = Nasal
- (fun f -> match f with
- | Consonant c -> begin match c.primary, c.position, c.category with
- | true, Pos1, _ -> "{#"
- | true, _, _ -> "[E"
- | false, _, I -> "5#"
- | false, _, II -> "t#"
- | false, _, III -> "g#"
- end
- | _ -> "`pC"
-
- )
+let a = Voyel
+ { opened = true
+ ; position = `Above
+ ; app = function
+ | Pos1 -> "#"
+ | Pos2 -> "E"
+ | Pos3 -> "D"
+ | Pos4 -> "C" }
let app_e = function
| Pos1 -> "$"
@@ -64,20 +56,68 @@ and app_eu = function
| Pos3 -> "Þ"
| Pos4 -> "ß"
-let e_opened = { opened = true ; app = app_e }
-and e_closed = { opened = false ; app = app_e }
-and schwa = "°"
+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
+ ; app = function
+ | Pos1 -> "È"
+ | Pos2 -> "É"
+ | Pos3 -> "Ê"
+ | Pos4 -> "Ë" }
+
+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 u = Voyel
+ { opened = true
+ ; position = `Above
+ ; app = function
+ | Pos1 -> "&"
+ | Pos2 -> "U"
+ | Pos3 -> "J"
+ | Pos4 -> "M" }
-and eu_opened = { opened = true ; app = app_eu }
-and eu_closed = { opened = false ; app = app_eu }
+and a_nasal = Nasal
+ (fun f -> match f with
+ | Consonant c -> begin match c.primary, c.position, c.category with
+ | true, Pos1, _ -> "{#"
+ | true, _, _ -> "[E"
+ | false, _, I -> "5#"
+ | false, _, II -> "t#"
+ | false, _, III -> "g#"
+ end
+ | _ -> "5#"
-and o =
- { opened = true
- ; app = function
- | Pos1 -> "^"
- | Pos2 -> "Y"
- | Pos3 -> "H"
- | Pos4 -> "N" }
+ )
and o_nasal = Nasal
(fun f -> match f with
@@ -88,17 +128,9 @@ and o_nasal = Nasal
| false, _, II -> "t^"
| false, _, III -> "g^"
end
- | _ -> "`pN"
+ | _ -> "5^"
)
-and i =
- { opened = true
- ; app = function
- | Pos1 -> "%"
- | Pos2 -> "T"
- | Pos3 -> "G"
- | Pos4 -> "B" }
-
and i_nasal = Nasal
(fun f -> match f with
| Consonant c -> begin match c.primary, c.position, c.category with
@@ -108,16 +140,7 @@ and i_nasal = Nasal
| false, _, II -> "t$"
| false, _, III -> "g$"
end
- | _ -> "`pV"
- )
-
-and y =
- { opened = true
- ; app = function
- | Pos1 -> "Ø"
- | Pos2 -> "Ù"
- | Pos3 -> "Ú"
- | Pos4 -> "Û" }
+ | _ -> "5$")
and y_nasal = Nasal
(fun f -> match f with
@@ -128,144 +151,245 @@ and y_nasal = Nasal
| false, _, II -> "tØ"
| false, _, III -> "gØ"
end
- | _ -> "`pÛ"
-
- )
-
-and u =
- { opened = true
- ; app = function
- | Pos1 -> "&"
- | Pos2 -> "U"
- | Pos3 -> "J"
- | Pos4 -> "M" }
+ | _ -> "5Ø")
and p = Consonant
{ position = Pos2
+ ; muted = Some "y"
; category = II
; primary = true
; repr = "q" }
+
and b = Consonant
{ position = Pos1
+ ; muted = Some "y"
; category = II
; primary = true
; repr = "w" }
and t = Consonant
{ position = Pos2
+ ; muted = Some "6"
; category = I
; primary = true
; repr = "1" }
+
and d = Consonant
{ position = Pos1
+ ; muted = Some "6"
; category = I
; primary = true
; repr = "2" }
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 = Pos3
+ { 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" }
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 ->
- Printf.sprintf "(%s)" t
-
-let diphtongue
- : t -> t -> t
- = fun t1 t2 ->
- Printf.sprintf "[%s%s]" t1 t2
+ 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
- List.iter elems
- ~f:(fun f -> Buffer.add_string buff f);
+
+ 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
- *)