From 3b90a643b3820e97bf1dab28ce41dacc4ca2831f Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Mon, 20 Sep 2021 22:27:04 +0200 Subject: Updated from js usage --- Makefile | 3 + index.html | 80 +++++++++ src/application/application.ml | 49 ----- src/application/dune | 7 - src/bin/transcriptor.ml | 8 +- src/js/application.ml | 49 +++++ src/js/dune | 1 - src/js/tengwar.ml | 109 ++++++++--- src/lib/lexer.mll | 1 + src/lib/prononciation.mly | 2 + src/lib/repr/anatar.ml | 227 +++++------------------ src/lib/repr/telcontar.ml | 398 ++++++++--------------------------------- src/lib/repr/tengwar.ml | 171 +++++++++++++++++- src/test/test.ml | 1 + 14 files changed, 507 insertions(+), 599 deletions(-) create mode 100755 index.html delete mode 100755 src/application/application.ml delete mode 100755 src/application/dune create mode 100755 src/js/application.ml diff --git a/Makefile b/Makefile index 3ffc6d9..8fef8df 100644 --- a/Makefile +++ b/Makefile @@ -6,3 +6,6 @@ release: test: dune runtest src/test + +serve: + cd _build/default && python3 -m http.server 8000 diff --git a/index.html b/index.html new file mode 100755 index 0000000..2a51602 --- /dev/null +++ b/index.html @@ -0,0 +1,80 @@ + + + + + + + + + + + Tengwar transcription + + + + +

+ +

Application

+ + + + +

+ Entrée : + +

+ Phonétique : + +

+ Police : + +

+ Tengwar : + +

+ +

+ + + + diff --git a/src/application/application.ml b/src/application/application.ml deleted file mode 100755 index 01724ac..0000000 --- a/src/application/application.ml +++ /dev/null @@ -1,49 +0,0 @@ -(** The Make module build the main application loop.contents - - The function [run] update the state on each event, and return a new state. - Each event must follow the [event] type, which is composed from the type - [t], and a module with a fonction [update]. - - This example create an application with the state containing a simple - counter. An even which increment this counter is created and can be used to - update the state. - - - [ - type state = { value : int } - - (** Increment the state *) - module Incr = struct - type t = unit - - let update () state = { value = state.value + 1 } - end - - module App = Make(struct type t = state end) - - (* Create the event itself *) - let incr_event = App.E ((), (module Incr:App.Event with type t = Incr.t)) - - ] - -*) -module Make(S:sig type t end) = struct - module type Event = sig - - type t - - val update: t -> S.t -> S.t - - end - - type event = E : 'a * (module Event with type t = 'a) -> event - - (** Simple helper for the main event loop *) - let run - : ?eq:(S.t -> S.t -> bool) -> S.t -> event Note.E.t -> S.t Note.S.t - = fun ?eq init event -> - let action = Note.E.map (fun (E (t, (module Event))) st -> Event.update t st) event in - Note.S.accum ?eq init action -end - - diff --git a/src/application/dune b/src/application/dune deleted file mode 100755 index 77eb6b9..0000000 --- a/src/application/dune +++ /dev/null @@ -1,7 +0,0 @@ -(library - (name application) - (libraries - brr - brr.note - ) - ) diff --git a/src/bin/transcriptor.ml b/src/bin/transcriptor.ml index d759452..dc83634 100644 --- a/src/bin/transcriptor.ml +++ b/src/bin/transcriptor.ml @@ -17,7 +17,13 @@ let process (optional_line : string option) = (fun t-> Sounds.repr (module Repr.Anatar) t) result in let () = match res2 with - | Ok response -> print_endline response + | Ok response -> print_endline ( "Anatar : " ^ response) + | Error err -> print_endline err in + let res3 = Result.map + (fun t-> Sounds.repr (module Repr.Telcontar) t) + result in + let () = match res3 with + | Ok response -> print_endline ( "Telcontar : " ^ response) | Error err -> print_endline err in () diff --git a/src/js/application.ml b/src/js/application.ml new file mode 100755 index 0000000..01724ac --- /dev/null +++ b/src/js/application.ml @@ -0,0 +1,49 @@ +(** The Make module build the main application loop.contents + + The function [run] update the state on each event, and return a new state. + Each event must follow the [event] type, which is composed from the type + [t], and a module with a fonction [update]. + + This example create an application with the state containing a simple + counter. An even which increment this counter is created and can be used to + update the state. + + + [ + type state = { value : int } + + (** Increment the state *) + module Incr = struct + type t = unit + + let update () state = { value = state.value + 1 } + end + + module App = Make(struct type t = state end) + + (* Create the event itself *) + let incr_event = App.E ((), (module Incr:App.Event with type t = Incr.t)) + + ] + +*) +module Make(S:sig type t end) = struct + module type Event = sig + + type t + + val update: t -> S.t -> S.t + + end + + type event = E : 'a * (module Event with type t = 'a) -> event + + (** Simple helper for the main event loop *) + let run + : ?eq:(S.t -> S.t -> bool) -> S.t -> event Note.E.t -> S.t Note.S.t + = fun ?eq init event -> + let action = Note.E.map (fun (E (t, (module Event))) st -> Event.update t st) event in + Note.S.accum ?eq init action +end + + diff --git a/src/js/dune b/src/js/dune index 9387c5f..4f1e8c6 100755 --- a/src/js/dune +++ b/src/js/dune @@ -3,7 +3,6 @@ (libraries brr brr.note - application translator sounds ) diff --git a/src/js/tengwar.ml b/src/js/tengwar.ml index 24b8a3c..31eb1ed 100644 --- a/src/js/tengwar.ml +++ b/src/js/tengwar.ml @@ -11,7 +11,44 @@ let get_element_by_id id = let (let=?) : 'a option -> ('a -> unit) -> unit = fun f opt -> Option.iter opt f -let main id phon tengwar = +type state = + { text : (Sounds.t list, string) result + ; font : [`Telcontar | `Annatar ]} + +module App = Application.Make(struct type t = state end) + +module SetText = struct + type t = Jstr.t + let update t state = + + let text = + Jstr.lowercased t + |> Jstr.to_string + |> Translator.Reader.process in + { state with text } +end + +module SetFont = struct + type t = string * El.t + let update (t, el) state = + let font = match t with + | "annatar" -> + El.set_class (Jstr.v "annatar") true el; + El.set_class (Jstr.v "telcontar") false el; + `Annatar + | _ -> + El.set_class (Jstr.v "annatar") false el; + El.set_class (Jstr.v "telcontar") true el; + `Telcontar in + { state with font } +end + +let init = + { text = Ok [] + ; font = `Telcontar + } + +let main id phon tengwar font = match (Jv.is_none id) with | true -> Console.(error [str "No element with id '%s' found"; id]) | false -> @@ -19,35 +56,55 @@ let main id phon tengwar = 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=? font = get_element_by_id font in - let ev = Evr.on_el + let text_event = + Evr.on_el Ev.input (fun _ -> - let value = El.prop El.Prop.value source in + App.E ( El.prop El.Prop.value source + , (module SetText: App.Event with type t = SetText.t )) + ) source in + + let font_event = + Evr.on_el + Ev.input + (fun _ -> + let value = El.prop El.Prop.value font 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.Anatar) 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 + App.E ( (str, tengwar) + , (module SetFont: App.Event with type t = SetFont.t )) + ) font in + + let ev = App.run + init + (E.select + [ text_event + ; font_event ] + ) in + + let log state = + let transcription = state.text 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-> + match state.font with + | `Annatar -> Sounds.repr (module Repr.Anatar) t + | `Telcontar -> Sounds.repr (module Repr.Telcontar) t) + transcription in + let () = match res2 with + | Ok response -> + El.set_prop El.Prop.value (Jstr.of_string response) tengwar + | Error _err -> () in + () + in + Logr.hold (S.log ev log) let () = diff --git a/src/lib/lexer.mll b/src/lib/lexer.mll index 2fbffb5..8654dca 100644 --- a/src/lib/lexer.mll +++ b/src/lib/lexer.mll @@ -46,6 +46,7 @@ rule letter = parse | 'y' { Y } | 'z' { Z } | ending { EOL } +| "er" ending { ER_ } | "erf" ending { ERF_ } | "el" ending { EL_ } (*| "ent" ending { ENT_ }*) diff --git a/src/lib/prononciation.mly b/src/lib/prononciation.mly index 74d9373..c473462 100644 --- a/src/lib/prononciation.mly +++ b/src/lib/prononciation.mly @@ -19,6 +19,7 @@ %token X_ %token ENT_ %token ERF_ +%token ER_ %token EL_ %token IENT_ %token IE_ @@ -141,6 +142,7 @@ ending: | X_ { S::EOL::[]} | IENT_ { I::T::EOL::[]} | IE_ { I::EOL::[]} + | ER_ { E_ACUTE::R::EOL::[]} | ERF_ { E_AGRAVE::R::EOL::[]} | EL_ { E_AGRAVE::L::EOL::[]} | EOL { EOL::[] } diff --git a/src/lib/repr/anatar.ml b/src/lib/repr/anatar.ml index 1d00266..cca6162 100644 --- a/src/lib/repr/anatar.ml +++ b/src/lib/repr/anatar.ml @@ -6,27 +6,19 @@ type position = | Pos2 | Pos3 | Pos4 - | Lambe (* Position for the Lambe (Theta inside) *) - | Lower_1_2 (* Position for the Harma *) - | Lower_3_1 (* Position for the Calma *) - | Lower_4_2 (* Position for the Thule *) + | Lambe (* Position for the Lambe (Theta inside) *) + | Lower_1_2 (* Position for the Harma *) + | Lower_3_1 (* Position for the Calma *) + | Lower_4_2 (* Position for the Thule *) type t = position T.t -let portant = - { T.position = Pos4 - ; T.muted = None - ; T.category = I - ; T.primary = false - ; T.repr = "`" } +let none = T.none -let none = T.Nothing - -let space s = T.Repr s +let space s = T.space s let a' = - { T.opened = true - ; T.position = `Above + { T.position = `Above ; T.app = function | Pos1 | Lower_1_2 | Lambe -> "#" | Pos2 -> "E" @@ -48,13 +40,12 @@ and app_eu = function | Pos4 | Lower_4_2 -> "ß" let e_opened = - T.Voyel { opened = true ; position = `Above ; app = app_e } + T.Voyel { position = `Above ; app = app_e } and e_closed = - T.Voyel { opened = false; position = `Above ; app = app_e } + T.Voyel { position = `Above ; app = app_e } and schwa = T.Voyel - { opened = true - ; position = `Below + { position = `Below ; app = function | Pos1 | Lower_3_1 -> "È" | Pos2 | Lower_1_2 | Lower_4_2 -> "É" @@ -63,12 +54,11 @@ and schwa = T.Voyel | Lambe -> "L" } -and eu_opened = T.Voyel { opened = true ; position = `Above ; app = app_eu } -and eu_closed = T.Voyel { opened = false ; position = `Above ; app = app_eu } +and eu_opened = T.Voyel { position = `Above ; app = app_eu } +and eu_closed = T.Voyel { position = `Above ; app = app_eu } and o' = - { T.opened = true - ; T.position = `Above + { T.position = `Above ; T.app = function | Pos1 | Lower_1_2 | Lambe -> "^" | Pos2 -> "Y" @@ -79,8 +69,7 @@ and o' = let o = T.Voyel o' and i' = - { T.opened = true - ; T.position = `Above + { T.position = `Above ; T.app = function | Pos1 | Lower_1_2 | Lambe -> "%" | Pos2 -> "T" @@ -91,8 +80,7 @@ and i' = let i = T.Voyel i' and y' = - { T.opened = true - ; T.position = `Above + { T.position = `Above ; T.app = function | Pos1 | Lower_1_2 | Lambe -> "Ø" | Pos2 -> "Ù" @@ -103,8 +91,7 @@ and y' = let y = T.Voyel y' and u = T.Voyel - { T.opened = true - ; T.position = `Above + { T.position = `Above ; T.app = function | Pos1 | Lower_1_2 | Lambe -> "&" | Pos2 -> "U" @@ -112,159 +99,35 @@ and u = T.Voyel | Pos4 | Lower_4_2 -> "M" } -and p = T.Consonant - { position = Pos2 - ; muted = Some "y" - ; category = II - ; primary = true - ; repr = "q" } - -and b = T.Consonant - { position = Pos1 - ; muted = Some "y" - ; category = II - ; primary = true - ; repr = "w" } - -and t = T.Consonant - { position = Pos2 - ; muted = Some "6" - ; category = I - ; primary = true - ; repr = "1" } - -and d = T.Consonant - { position = Pos1 - ; muted = Some "6" - ; category = I - ; primary = true - ; repr = "2" } - -and k = T.Consonant - { position = Lower_3_1 - ; muted = Some "h" - ; category = III - ; primary = true - ; repr = "a" } - -and g = T.Consonant - { position = Pos1 - ; muted = Some "h" - ; category = III - ; primary = true - ; repr = "s" } - -and f = T.Consonant - { position = Pos3 - ; muted = None - ; category = II - ; primary = true - ; repr = "e" } - -and v = T.Consonant - { position = Pos1 - ; muted = None - ; category = II - ; primary = true - ; repr = "r" } - -and ch = T.Consonant - { position = Lower_1_2 - ; muted = None - ; category = III - ; primary = true - ; repr = "d" } - -and j = T.Consonant - { position = Pos1 - ; muted = None - ; category = III - ; primary = true - ; repr = "f" } - -and s = T.Consonant - { position = Lower_4_2 - ; muted = Some "i" - ; category = I - ; primary = true - ; repr = "3" } - -and z = T.Consonant - { position = Pos1 - ; muted = None - ; category = I - ; primary = true - ; repr = "4" } - -and m = T.Consonant - { position = Pos1 - ; muted = None - ; category = II - ; primary = true - ; repr = "t" } - -and n = T.Consonant - { position = Pos1 - ; muted = None - ; category = I - ; primary = true - ; repr = "5" } - -and gn = T.Consonant - { position = Pos1 - ; muted = None - ; category = III - ; primary = false - ; repr = "b" } - -and ng = T.Consonant - { position = Pos1 - ; muted = None - ; category = III - ; primary = true - ; repr = "g" } - -and r = T.Consonant - { position = Pos2 - ; muted = Some "u" - ; category = I - ; primary = false - ; repr = "7" } - -and semi_voyel_w = T.Consonant - { position = Pos3 - ; muted = None - ; category = II - ; primary = false - ; repr = "." } - -and semi_voyel_y = T.Consonant - { position = Pos1 - ; muted = None - ; category = II - ; primary = false - ; repr = "l" } - -and semi_voyel_u = T.Consonant - { position = Pos2 - ; muted = None - ; category = II - ; primary = false - ; repr = "]" } - -let l = - let default = - { T.position = Lambe - ; T.muted = None - ; T.category = II - ; T.primary = false - ; T.repr = "j" } in - T.Consonant default - -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 portant = T.portant "`" Pos4 + +and t = T.t "1" (Some "6") Pos2 +and d = T.d "2" (Some "6") Pos1 +and p = T.p "q" (Some "y") Pos2 +and b = T.b "w" (Some "y") Pos1 +and k = T.k "a" (Some "h") Lower_3_1 +and g = T.g "s" (Some "h") Pos1 +and f = T.f "e" Pos3 +and v = T.v "r" Pos1 +and ch = T.ch "d" Lower_1_2 +and j = T.j "f" Pos1 +and s = T.s "3" (Some "i") Lower_4_2 +and z = T.z "4" Pos1 +and m = T.m "t" Pos1 +and n = T.n "5" Pos1 +and gn = T.gn "b" Pos1 +and ng = T.ng "g" Pos1 +and r = T.r "7" (Some "u") Pos2 +and l = T.l "j" Lambe + +and semi_voyel_w = T.semi_voyel_w "." Pos3 +and semi_voyel_y = T.semi_voyel_y "l" Pos1 +and semi_voyel_u = T.semi_voyel_u "]" Pos2 + +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 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 - *) diff --git a/src/lib/repr/tengwar.ml b/src/lib/repr/tengwar.ml index 61fbc87..f9fde05 100644 --- a/src/lib/repr/tengwar.ml +++ b/src/lib/repr/tengwar.ml @@ -9,8 +9,7 @@ type category = | III type 'a voyel = - { opened : bool - ; position : position_type + { position : position_type ; app : ('a -> string) } type 'a consonant = @@ -118,8 +117,7 @@ let nasal m ng n letter = {empty_glyph with tengwa = Some c ; tehta_above = Some letter } in - g::f::[] - ) + g::f::[] ) let diphtongue : 'a t -> 'a t -> 'a t @@ -185,6 +183,10 @@ let fold _fold (Some {empty_glyph with tengwa = Some c}) tl + | Some ({ tehta_below = None ; _} as t), Voyel ({position = `Below; _} as v) -> + _fold + (Some {t with tehta_below = Some v}) + tl | Some ({ tehta_below = Some _ ; _} as t), Voyel ({position = `Below; _} as v) -> repr_glyph ~portant t buff; _fold @@ -200,10 +202,6 @@ let fold _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}) @@ -227,3 +225,160 @@ let fold in _fold None elems; Buffer.contents buff + +let p repr muted position = Consonant + { position + ; muted + ; category = II + ; primary = true + ; repr } + +and b repr muted position = Consonant + { position + ; muted + ; category = II + ; primary = true + ; repr } + +and t repr muted position = Consonant + { position + ; muted + ; category = I + ; primary = true + ; repr } + +and d repr muted position = Consonant + { position + ; muted + ; category = I + ; primary = true + ; repr } + +and k repr muted position = Consonant + { position + ; muted + ; category = III + ; primary = true + ; repr } + +and g repr muted position = Consonant + { position + ; muted + ; category = III + ; primary = true + ; repr } + +and f repr position = Consonant + { position + ; muted = None + ; category = II + ; primary = true + ; repr } + +and v repr position = Consonant + { position + ; muted = None + ; category = II + ; primary = true + ; repr } + +and ch repr position = Consonant + { position + ; muted = None + ; category = III + ; primary = true + ; repr } + +and j repr position = Consonant + { position + ; muted = None + ; category = III + ; primary = true + ; repr } + +and s repr muted position = Consonant + { position + ; muted + ; category = I + ; primary = true + ; repr } + +and z repr position = Consonant + { position + ; muted = None + ; category = I + ; primary = true + ; repr } + +and m repr position = Consonant + { position + ; muted = None + ; category = II + ; primary = true + ; repr } + +and n repr position = Consonant + { position + ; muted = None + ; category = I + ; primary = true + ; repr } + +and gn repr position = Consonant + { position + ; muted = None + ; category = III + ; primary = false + ; repr } + +and ng repr position = Consonant + { position + ; muted = None + ; category = III + ; primary = true + ; repr } + +and r repr muted position = Consonant + { position + ; muted + ; category = I + ; primary = false + ; repr } + +and semi_voyel_w repr position = Consonant + { position + ; muted = None + ; category = II + ; primary = false + ; repr } + +and semi_voyel_y repr position = Consonant + { position + ; muted = None + ; category = II + ; primary = false + ; repr } + +and semi_voyel_u repr position = Consonant + { position + ; muted = None + ; category = II + ; primary = false + ; repr } + +let l repr position = + let default = + { position + ; muted = None + ; category = II + ; primary = false + ; repr } in + Consonant default + +let portant repr position = + { position + ; muted = None + ; category = I + ; primary = false + ; repr } + diff --git a/src/test/test.ml b/src/test/test.ml index 0d1f1c4..cbbf498 100644 --- a/src/test/test.ml +++ b/src/test/test.ml @@ -98,6 +98,7 @@ let tests = ; "joues", "Zu(s)" ; "libellule", "LibELyL°" ; "main", "m5" + ; "manger", "m@ge(R)" ; "merci", "mERsi" ; "ménageais", "menaZE(s)" ; "mouillage", "mu[ja]Z°" -- cgit v1.2.3