From 040c74ea186f195b8579960d2a74418c38cd9b76 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Fri, 10 Sep 2021 20:50:40 +0200 Subject: Added js code --- src/bin/transcriptor.ml | 2 +- src/js/dune | 18 ++++++++++ src/js/tengwar.ml | 58 +++++++++++++++++++++++++++++++++ src/lib/lexer.mll | 4 +-- src/lib/parser.mly | 10 ++++-- src/lib/prononciation.mly | 8 ++--- src/lib/repr/default.ml | 2 ++ src/lib/repr/tengwar.ml | 83 ++++++++++++++++++----------------------------- src/lib/sounds/sig.ml | 2 ++ src/lib/sounds/sounds.ml | 7 +++- src/lib/sounds/sounds.mli | 2 ++ src/lib/tokens.mly | 2 +- src/test/test.ml | 1 - 13 files changed, 136 insertions(+), 63 deletions(-) create mode 100755 src/js/dune create mode 100644 src/js/tengwar.ml (limited to 'src') 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 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 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)" -- cgit v1.2.3