summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2021-09-13 22:54:57 +0200
committerSébastien Dailly <sebastien@chimrod.com>2021-09-13 22:54:57 +0200
commit1d53f5efd02b228f22c2eba0bdfca6c2aabbd8f6 (patch)
treeed9299c649b7f15b3c6ecfee10f5403437d950c4
parent7bdea3ee4c25e16d2827bb61d451134f8cf64982 (diff)
Finalize tengwar transcription
-rw-r--r--src/lib/repr/tengwar.ml312
1 files changed, 170 insertions, 142 deletions
diff --git a/src/lib/repr/tengwar.ml b/src/lib/repr/tengwar.ml
index 1f34928..c913574 100644
--- a/src/lib/repr/tengwar.ml
+++ b/src/lib/repr/tengwar.ml
@@ -29,14 +29,85 @@ type consonant =
; primary : bool
; category : category }
-type application = (t -> t * t option)
+
+type glyph =
+ { tengwa : consonant option
+ (* The eventual Tehta above the tengwa *)
+ ; tehta_above : voyel option
+ (* And below *)
+ ; tehta_below : voyel option
+ }
+
+let empty_glyph =
+ { tengwa = None
+ ; tehta_above = None
+ ; tehta_below = None }
+
+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 portant =
+ { position = Pos4, Lower1
+ ; muted = None
+ ; category = I
+ ; primary = false
+ ; repr = "`" }
+
+let repr_glyph
+ : glyph -> Buffer.t -> unit
+ = fun { tengwa; tehta_above; tehta_below } b ->
+ let () = match tengwa with
+ | None -> Buffer.add_string b @@ portant.repr
+ | Some c ->Buffer.add_string b @@ c.repr in
+ let () = match tehta_above, tengwa with
+ | None, _ -> ()
+ | Some v, Some c -> Buffer.add_string b @@ pair v c
+ | Some v, None -> Buffer.add_string b @@ pair v portant in
+ let () = match tehta_below, tengwa with
+ | None, _ -> ()
+ | Some v, Some c -> Buffer.add_string b @@ pair v c
+ | Some v, None -> Buffer.add_string b @@ pair v portant in
+ ()
+
+let combine_glyph
+ : glyph -> glyph -> glyph option
+ = fun g1 g2 ->
+ let tengwa = match g1.tengwa, g2.tengwa with
+ | Some _, Some _ -> Error ()
+ | None, any -> Ok (any)
+ | any, None -> Ok (any) in
+ let above = match g1.tehta_above, g2.tehta_above with
+ | Some _, Some _ -> Error ()
+ | None, any -> Ok any
+ | any, None -> Ok any in
+ let below = match g1.tehta_below, g2.tehta_below with
+ | Some _, Some _ -> Error ()
+ | None, any -> Ok any
+ | any, None -> Ok any in
+ match tengwa, above, below with
+ | Ok tengwa, Ok tehta_above, Ok tehta_below ->
+ Some { tengwa; tehta_above; tehta_below}
+ | _, _, _ -> None
+
+let add_voyel_to_glyph
+ : glyph -> voyel -> glyph
+ = fun g v ->
+ match v.position with
+ | `Above -> { g with tehta_above = Some v }
+ | `Below -> { g with tehta_below = Some v }
+
+type application = (t -> t list)
and t =
| Consonant of consonant
| Voyel of voyel
| Nasal of application
- | App of application
| Repr of string
+ | Glyph of glyph
| Nothing
let none = Nothing
@@ -279,16 +350,9 @@ and semi_voyel_u = Consonant
; primary = false
; repr = "]" }
-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
+ { position = Pos1, Lower2
; muted = None
; category = II
; primary = false
@@ -300,33 +364,32 @@ let nasal letter =
( 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
+ let g = Glyph
+ {empty_glyph with
+ tengwa = Some c
+ ; tehta_above = Some letter } in
+ g::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
+ let g = Glyph
+ {empty_glyph with
+ tengwa = Some c
+ ; tehta_above = Some letter } in
+ g::f::[]
+
| f ->
let Consonant c = n [@@warning "-8"] in
- let v = pair letter c in
- let repr = c.repr ^ v in
- let default = Consonant { c with repr } in
- default, Some f
+ let g = Glyph
+ {empty_glyph with
+ tengwa = Some c
+ ; tehta_above = Some letter } in
+ g::f::[]
)
let a_nasal = nasal a'
and o_nasal = nasal o'
and i_nasal = nasal i'
and y_nasal = nasal y'
-and portant =
- { position = Pos4, Lower1
- ; muted = None
- ; category = I
- ; primary = false
- ; repr = "`" }
-
let muted
: t -> t
= fun t ->
@@ -341,57 +404,17 @@ let muted
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
+ = fun t1 t2 ->
+ match t1 with
+
+ | Consonant c->
+ let semi_voyel =
+ Glyph
+ { empty_glyph with tengwa = Some c} in
+ Nasal (fun t -> semi_voyel::t2::t::[])
| _ ->
print_endline "Ignoring diphtongue";
- none
+ Nothing
let fold
: t list -> string
@@ -399,81 +422,86 @@ let fold
let buff = Buffer.create 16 in
let rec _fold
+ : glyph option -> t list -> unit
= fun init -> function
| [] ->
begin match init with
- | None
- | Some Nothing
- -> ()
- | Some Voyel ( {position = `Above; _ } as v) ->
- Buffer.add_string buff ("`" ^ (pair v portant))
- | Some Voyel ( {position = `Below; _ } as v) ->
- Buffer.add_string buff (v.app Pos1)
- | 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 ->
- Buffer.add_string buff (c.repr)
+ | None -> ()
+ | Some glyph ->
+ repr_glyph glyph buff
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 ^ (pair v c));
- _fold None tl
- | Some Voyel ({position = `Below; _} as v), Consonant c ->
- Buffer.add_string buff ((pair v c) ^ c.repr);
- _fold None tl
- | Some Voyel v, _ ->
- 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
- | Some Consonant c, _ ->
- Buffer.add_string buff c.repr;
- _fold (Some hd) tl
-
+ | any, Nothing -> _fold any tl
| None, Consonant c ->
- Buffer.add_string buff c.repr;
- _fold None tl
+ _fold
+ (Some {empty_glyph with tengwa = Some c})
+ tl
+ | None, Voyel ({position = `Above; _} as v) ->
+ _fold
+ (Some {empty_glyph with tehta_above = Some v})
+ tl
+ | None, Voyel ({position = `Below; _} as v) ->
+ _fold
+ (Some {empty_glyph with tehta_below = Some v})
+ tl
| None, Repr r ->
Buffer.add_string buff r;
- _fold None tl
- | None, Voyel _
- | None, Nasal _
- | None, App _ ->
- _fold (Some hd) tl
+ _fold
+ None tl
+ | any, Nasal n ->
+ let next, rest = match tl with
+ | [] -> Nothing, []
+ | other::ll -> other, ll in
+ let result = n next in
+ _fold any (result @ rest)
+
+ | Some t, Repr s ->
+ repr_glyph t buff;
+ Buffer.add_string buff s;
+ _fold
+ None
+ tl
+ | Some ({ tengwa = Some _ ; _} as t), Consonant c ->
+ repr_glyph t buff;
+ _fold
+ (Some {empty_glyph with tengwa = Some c})
+ tl
+ | Some ({ tehta_below = Some _ ; _} as t), Voyel ({position = `Below; _} as v) ->
+ repr_glyph t buff;
+ _fold
+ (Some {empty_glyph with tehta_below = Some v})
+ tl
+ | Some t, Voyel ({position = `Above; _} as v) ->
+ repr_glyph t buff;
+ _fold
+ (Some {empty_glyph with tehta_above = Some v})
+ tl
+ | Some t, Voyel v ->
+ _fold
+ (Some (add_voyel_to_glyph t v))
+ tl
+ | Some ({ tengwa = None ; _} as t), Consonant c ->
+ _fold
+ (Some {t with tengwa = Some c})
+ tl
+ | None, Glyph g ->
+ _fold
+ (Some g)
+ tl
+ | Some g1, Glyph g2 ->
+ begin match combine_glyph g1 g2 with
+ | Some _ as res ->
+ _fold
+ res
+ tl
+ | None ->
+ repr_glyph g1 buff;
+ _fold
+ (Some g2)
+ tl
+ end
+
in
_fold None elems;