summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/bin/transcriptor.ml2
-rwxr-xr-xsrc/js/dune18
-rw-r--r--src/js/tengwar.ml58
-rw-r--r--src/lib/lexer.mll4
-rw-r--r--src/lib/parser.mly10
-rw-r--r--src/lib/prononciation.mly8
-rw-r--r--src/lib/repr/default.ml2
-rw-r--r--src/lib/repr/tengwar.ml83
-rw-r--r--src/lib/sounds/sig.ml2
-rw-r--r--src/lib/sounds/sounds.ml7
-rw-r--r--src/lib/sounds/sounds.mli2
-rw-r--r--src/lib/tokens.mly2
-rw-r--r--src/test/test.ml1
13 files changed, 136 insertions, 63 deletions
diff --git a/src/bin/transcriptor.ml b/src/bin/transcriptor.ml
index 77a7b6f..feb24db 100644
--- a/src/bin/transcriptor.ml
+++ b/src/bin/transcriptor.ml
@@ -5,7 +5,7 @@ let process (optional_line : string option) =
| None -> ()
| Some line ->
- let result =(T.Reader.process line) in
+ let result = T.Reader.process line in
let res1 = Result.map
(fun t-> Sounds.repr (module Repr.Default) t)
diff --git a/src/js/dune b/src/js/dune
new file mode 100755
index 0000000..9387c5f
--- /dev/null
+++ b/src/js/dune
@@ -0,0 +1,18 @@
+(executable
+ (name tengwar)
+ (libraries
+ brr
+ brr.note
+ application
+ translator
+ sounds
+ )
+ (modes js)
+ (preprocess (pps js_of_ocaml-ppx))
+ (link_flags (:standard -no-check-prims))
+ )
+
+(rule
+ (targets tengwar.js)
+ (deps tengwar.bc.js)
+ (action (copy %{deps} %{targets})))
diff --git a/src/js/tengwar.ml b/src/js/tengwar.ml
new file mode 100644
index 0000000..dd37c2d
--- /dev/null
+++ b/src/js/tengwar.ml
@@ -0,0 +1,58 @@
+open Brr
+open Note
+open Brr_note
+
+let get_element_by_id id =
+ id
+ |> Jv.Id.of_jv
+ |> Jv.to_jstr
+ |> Brr.Document.find_el_by_id Brr.G.document
+
+let (let=?) : 'a option -> ('a -> unit) -> unit
+ = fun f opt -> Option.iter opt f
+
+let main id phon tengwar =
+ match (Jv.is_none id) with
+ | true -> Console.(error [str "No element with id '%s' found"; id])
+ | false ->
+
+ let=? source = get_element_by_id id in
+ let=? phon = get_element_by_id phon in
+ let=? tengwar = get_element_by_id tengwar in
+
+ let ev = Evr.on_el
+ Ev.input
+ (fun _ ->
+ let value = El.prop El.Prop.value source in
+ let str = Jstr.to_string value in
+ let transcription = Translator.Reader.process str in
+
+ let res1 = Result.map
+ (fun t-> Sounds.repr (module Repr.Default) t)
+ transcription in
+ let () = match res1 with
+ | Ok response ->
+ El.set_prop El.Prop.value (Jstr.of_string response) phon
+ | Error _err -> () in
+ let res2 = Result.map
+ (fun t-> Sounds.repr (module Repr.Tengwar) t)
+ transcription in
+ let () = match res2 with
+ | Ok response ->
+ El.set_prop El.Prop.value (Jstr.of_string response) tengwar
+ | Error _err -> () in
+ ()
+ )
+ source in
+
+ match (E.log ev (fun _ -> ())) with
+ | None -> ()
+ | Some v -> Logr.hold v
+
+let () =
+
+ let open Jv in
+ let main = obj
+ [| "run", (repr main) |] in
+
+ set global "lib" main
diff --git a/src/lib/lexer.mll b/src/lib/lexer.mll
index 2d6224c..2fbffb5 100644
--- a/src/lib/lexer.mll
+++ b/src/lib/lexer.mll
@@ -45,14 +45,14 @@ rule letter = parse
| 'x' { X }
| 'y' { Y }
| 'z' { Z }
-| ' ' { Space }
| ending { EOL }
| "erf" ending { ERF_ }
| "el" ending { EL_ }
-| "ent" ending { ENT_ }
+(*| "ent" ending { ENT_ }*)
| "ient" ending { IENT_ }
| "ie" ending { IE_ }
| "x" ending { X_ }
+| _ { Space (Lexing.lexeme lexbuf)}
(* This rule looks for a single line, terminated with '\n' or eof.
It returns a pair of an optional string (the line that was found)
diff --git a/src/lib/parser.mly b/src/lib/parser.mly
index fbd22f6..70590a0 100644
--- a/src/lib/parser.mly
+++ b/src/lib/parser.mly
@@ -148,7 +148,13 @@ syllables:
word:
- | Sep? syllables consonant_group(opening_consonant)? EOL { Process.rebuild $3 $2 }
+ | Sep? syllables consonant_group(opening_consonant)?
+ { Process.rebuild $3 $2 }
+
+words:
+ | word { $1::[] }
+ | ww=words Space w=word { w:: [Sounds.space $2] ::ww }
main:
- | word { $1 }
+ | words EOL
+ { List.concat (List.rev $1) }
diff --git a/src/lib/prononciation.mly b/src/lib/prononciation.mly
index 614f120..74d9373 100644
--- a/src/lib/prononciation.mly
+++ b/src/lib/prononciation.mly
@@ -50,7 +50,7 @@
%token X
%token Y (* semi voyel j *)
%token Z
-%token Space
+%token <string>Space
%token EOL
%nonassoc Low
@@ -76,7 +76,7 @@ voyel
letters
: voyel { $1 :: [] }
| voyel_without_i I { $1 :: I :: []}
- | Space { Space :: [] }
+ | Space { (Space $1) :: [] }
| Sep { Sep :: [] }
| B { B :: [] }
@@ -93,7 +93,7 @@ letters
| G { G :: [] }
| G I { J :: I :: [] }
| G E { J :: letter_e $2 :: [] }
- | G E voyel { J :: $3 :: [] }
+ | G E voyel { J :: $3 :: [] }
| G U { G :: U :: [] }
| G U I { G :: I :: [] }
| G U E { G :: letter_e $3 :: [] }
@@ -116,6 +116,7 @@ letters
| O IENT_ { W :: A :: [] }
| O I N { W :: I :: N :: [] }
+ | P P { Nothing :: P :: [] }
| P { P :: [] }
| Q { K :: [] }
@@ -140,7 +141,6 @@ ending:
| X_ { S::EOL::[]}
| IENT_ { I::T::EOL::[]}
| IE_ { I::EOL::[]}
- | ENT_ { E::T::EOL::[]}
| ERF_ { E_AGRAVE::R::EOL::[]}
| EL_ { E_AGRAVE::L::EOL::[]}
| EOL { EOL::[] }
diff --git a/src/lib/repr/default.ml b/src/lib/repr/default.ml
index 22a023f..9daa4fb 100644
--- a/src/lib/repr/default.ml
+++ b/src/lib/repr/default.ml
@@ -4,6 +4,8 @@ type t = string
let none = ""
+let space s = s
+
let a = "a"
and a_nasal = "@"
diff --git a/src/lib/repr/tengwar.ml b/src/lib/repr/tengwar.ml
index 4fc224b..d291a8b 100644
--- a/src/lib/repr/tengwar.ml
+++ b/src/lib/repr/tengwar.ml
@@ -35,6 +35,8 @@ and t =
let none = Nothing
+let space s = Repr s
+
let a = Voyel
{ opened = true
; position = `Above
@@ -106,53 +108,6 @@ and u = Voyel
| Pos3 -> "J"
| Pos4 -> "M" }
-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_nasal = Nasal
- (fun f -> match f with
- | Consonant c -> begin match c.primary, c.position, c.category with
- | true, Pos1, _ -> "{^"
- | true, _, _ -> "[Y"
- | false, _, I -> "5^"
- | false, _, II -> "t^"
- | false, _, III -> "g^"
- end
- | _ -> "5^"
- )
-
-and i_nasal = Nasal
- (fun f -> match f with
- | Consonant c -> begin match c.primary, c.position, c.category with
- | true, Pos1, _ -> "{$"
- | true, _, _ -> "[T"
- | false, _, I -> "5$"
- | false, _, II -> "t$"
- | false, _, III -> "g$"
- end
- | _ -> "5$")
-
-and y_nasal = Nasal
- (fun f -> match f with
- | Consonant c -> begin match c.primary, c.position, c.category with
- | true, Pos1, _ -> "{Ø"
- | true, _, _ -> "[Ù"
- | false, _, I -> "5Ø"
- | false, _, II -> "tØ"
- | false, _, III -> "gØ"
- end
- | _ -> "5Ø")
-
and p = Consonant
{ position = Pos2
; muted = Some "y"
@@ -293,6 +248,32 @@ and semi_voyel_u = Consonant
; primary = false
; repr = "]" }
+let nasal v =
+ let Voyel letter = v [@@warning "-8"]in
+ Nasal
+ ( fun 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 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
@@ -328,7 +309,7 @@ let muted
and portant =
{ position = Pos4
; muted = None
- ; category = III
+ ; category = I
; primary = false
; repr = "`" }
@@ -349,7 +330,7 @@ let fold
| Some Voyel ( {position = `Below; _ } as v) ->
Buffer.add_string buff (v.app Pos1)
| Some Nasal n ->
- Buffer.add_string buff ("`" ^ (n (Consonant portant)))
+ Buffer.add_string buff (n (Consonant portant))
| Some Repr r ->
Buffer.add_string buff r
| Some Consonant c ->
@@ -366,13 +347,13 @@ let fold
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));
+ Buffer.add_string buff ((n hd) ^ 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 (n (Consonant portant));
_fold (Some hd) tl
| Some Repr r, _ ->
Buffer.add_string buff r;
diff --git a/src/lib/sounds/sig.ml b/src/lib/sounds/sig.ml
index 3c3c731..3ff6bf2 100644
--- a/src/lib/sounds/sig.ml
+++ b/src/lib/sounds/sig.ml
@@ -1,6 +1,8 @@
module type REPR = sig
type t
+ val space : string -> t
+
val none: t
val a : t
diff --git a/src/lib/sounds/sounds.ml b/src/lib/sounds/sounds.ml
index 47fea2b..cc801dd 100644
--- a/src/lib/sounds/sounds.ml
+++ b/src/lib/sounds/sounds.ml
@@ -7,6 +7,7 @@ type kind =
type code =
| None
+ | Space of string
| SZ (* This is a possible Z if followed by a voyel *)
| Voyel_A
| Voyel_E
@@ -53,8 +54,8 @@ and t =
let is_voyel t =
t.kind = Voyel
|| t.kind = SemiVoyel
-let is_nasal t = t.nasal
+let is_nasal t = t.nasal
let none =
{ mutable_ = true
@@ -62,6 +63,9 @@ let none =
; nasal = false
; code = None }
+let space s =
+ { none with code = Space s }
+
let voyel =
{ none with kind = Voyel }
@@ -245,6 +249,7 @@ let repr
match letter.code, letter.nasal with
| None , _ -> Repr.none
+ | Space s , _ -> Repr.space s
| Voyel_A , false -> Repr.a
| Voyel_A , true -> Repr.a_nasal
| Voyel_AI , false -> Repr.e_opened
diff --git a/src/lib/sounds/sounds.mli b/src/lib/sounds/sounds.mli
index 7dea8c0..3b7b760 100644
--- a/src/lib/sounds/sounds.mli
+++ b/src/lib/sounds/sounds.mli
@@ -15,6 +15,8 @@ val schwa: t
It can be used to replace any element in a syllabus *)
val none: t
+val space: string -> t
+
(** This is the voyel i like in "ici"
When nazalized, the voyel become [in] like in "ainsi" *)
val i : t
diff --git a/src/lib/tokens.mly b/src/lib/tokens.mly
index 35c8e1d..8bad0f7 100644
--- a/src/lib/tokens.mly
+++ b/src/lib/tokens.mly
@@ -28,7 +28,7 @@
%token X
%token Y (* semi voyel j *)
%token Z
-%token Space
+%token <string>Space
%token EOL
%nonassoc Low
diff --git a/src/test/test.ml b/src/test/test.ml
index 0c320bd..0d1f1c4 100644
--- a/src/test/test.ml
+++ b/src/test/test.ml
@@ -53,7 +53,6 @@ let tests =
; "achat", "aSa(t)"
; "agneau", "aNo"
; "aimes", "Em°(s)"
- ; "aiment", "Em°(t)"
; "anniversaire", "anivERsER°"
; "anta", "@ta"
; "anneaux", "ano(s)"
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-14 23:35:31 +0000