path: root/src/lib/sounds/sounds.ml

module Sig = Sig

type kind =
  | None
  | Voyel
  | SemiVoyel

type code =
  | None
  | Space of string
  | SZ (* This is a possible Z if followed by a voyel *)
  | Voyel_A
  | Voyel_E
  | E_Opened
  | E_Closed
  | Voyel_I
  | Voyel_O
  | Voyel_U (* OU like in Ouvrir *)
  | Voyel_Y (* U like in Unique *)
  | Voyel_AI
  | Voyel_EU_Closed
  | Voyel_EU_Opened
  | SemiVoyel_W
  | SemiVoyel_Y
  | SemiVoyel_U
  | Consonant_P
  | Consonant_B
  | Consonant_T
  | Consonant_D
  | Consonant_K
  | Consonant_G
  | Consonant_F
  | Consonant_V
  | Consonant_S
  | Consonant_Z
  | Consonant_X
  | Consonant_J

  | Consonant_M
  | Consonant_N
  | Consonant_GN
  | Consonant_L
  | Consonant_R
  | Diphtonge of t * t
  | Muted of t

and t =
  { code : code
  ; mutable_: bool (* Can the sound be muted ? *)
  ; kind : kind
  ; nasal : bool
  }

let is_voyel t =
  t.kind = Voyel
  || t.kind = SemiVoyel

let is_nasal t = t.nasal

let none =
  { mutable_ = true
  ; kind = None
  ; nasal = false
  ; code = None }

let space s =
  { none with code = Space s }

let voyel =
  { none with kind = Voyel }


let diphtongue v1 v2 =
  { voyel with
    code = Diphtonge (v1, v2)
  }

let a =
  { voyel with
    code = Voyel_A
  }

let voyel_ai =
  { voyel with
    code = Voyel_AI
  }

let e = function
  | `Closed -> { voyel with code = E_Closed }
  | `Opened -> { voyel with code = E_Opened }

let eu = function
  | `Closed -> { voyel with code = Voyel_EU_Closed }
  | `Opened -> { voyel with code = Voyel_EU_Opened }


let schwa =
  { voyel with
    code = Voyel_E }

let o =
  { voyel with
    code = Voyel_O }

let i =
  { voyel with
    code = Voyel_I }

let voyel_y =
  { voyel with
    code = Voyel_Y }

let voyel_u =
  { voyel with
    code = Voyel_U }

let p =
  { none with
    code = Consonant_P }

let b =
  { none with
    code = Consonant_B }

let t =
  { none with
    code = Consonant_T
  }

let d =
  { none with
    code = Consonant_D }

let k =
  { none with
    code = Consonant_K
  ; mutable_ = false }

let g =
  { none with
    code = Consonant_G }

(** f is alway pronounend in ending consonant. Know exeception are :
    - cerf
    - clef
    - nerf
    - serf *)
let f =
  { none with
    code = Consonant_F
  ; mutable_ = false
  }

let v =
  { none with
    code = Consonant_V }

let s =
  { none with
    code = Consonant_S }

let sz =
  { s with code = SZ }

let z =
  { none with
    code = Consonant_Z }

let ch =
  { none with
    code = Consonant_X
  ; mutable_ = false }

let j =
  { none with
    code = Consonant_J
  ; mutable_ = false }

let gn =
  { none with
    code = Consonant_GN
  ; nasal = true }

let n =
  { none with
    code = Consonant_N
  ; nasal = true }

let m =
  { none with
    code = Consonant_M
  ; nasal = true }

let l =
  { none with
    code = Consonant_L
  ; mutable_ = false }

let r =
  { none with
    code = Consonant_R }

let semi_voyel_w =
  { none with
    kind = SemiVoyel
  ; code = SemiVoyel_W}

let semi_voyel_y =
  { none with
    kind = SemiVoyel
  ; code = SemiVoyel_Y}

let semi_voyel_u =
  { none with
    kind = SemiVoyel
  ; code = SemiVoyel_U}

let rec nasal t =

  match t.kind, t.code with
  | Voyel, Diphtonge (s1, s2) ->
    begin match s1.code, s2.code with
      | (SemiVoyel_Y, Voyel_E) ->
        (* The only case we could have the nasalisation of such diphtongue, is
           the case I E, N -> wich is transformed into I, I N. *)
        Some ( diphtongue s1 { i with nasal = true } )
      | _ -> Option.map (fun s -> diphtongue s1 s) (nasal s2)
    end
  | Voyel, _ -> Some { t with nasal = true }
  | _ -> None

let is_muted t =
  match t.code with
  | Muted _ -> true
  | _ -> false

let mute f =
  match f.mutable_ with
  | false -> f
  | true ->
    { none with
      code = Muted f }

let unmute t =
  match t.code with
  | Muted t -> t
  | _ -> t

let repr
  : (module Sig.REPR) -> t list -> string
  = fun m letters ->
    let module Repr = (val m:Sig.REPR) in

    let rec _repr letter =

      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
      | Voyel_AI        , true  -> Repr.i_nasal
      | E_Closed        , _     -> Repr.e_closed
      | E_Opened        , false -> Repr.e_opened
      | E_Opened        , true
      | Voyel_E         , true  -> Repr.a_nasal
      | Voyel_E         , false -> Repr.schwa
      | Voyel_I         , false -> Repr.i
      | Voyel_I         , true  -> Repr.i_nasal
      | Voyel_O         , true  -> Repr.o_nasal
      | Voyel_O         , false -> Repr.o
      | Voyel_U         , _     -> Repr.u
      | Voyel_Y         , false -> Repr.y
      | Voyel_Y         , true  -> Repr.y_nasal
      | Voyel_EU_Closed , _     -> Repr.eu_closed
      | Voyel_EU_Opened , _     -> Repr.eu_opened

      | SemiVoyel_W     , _     -> Repr.semi_voyel_w
      | SemiVoyel_Y     , _     -> Repr.semi_voyel_y
      | SemiVoyel_U     , _     -> Repr.semi_voyel_u

      | Consonant_P     , _     -> Repr.p
      | Consonant_B     , _     -> Repr.b
      | Consonant_T     , _     -> Repr.t
      | Consonant_D     , _     -> Repr.d
      | Consonant_K     , _     -> Repr.k
      | Consonant_G     , _     -> Repr.g
      | Consonant_F     , _     -> Repr.f
      | Consonant_V     , _     -> Repr.v
      | SZ              , _
      | Consonant_S     , _     -> Repr.s
      | Consonant_Z     , _     -> Repr.z

      | Consonant_X     , _     -> Repr.ch
      | Consonant_J     , _     -> Repr.j

      | Consonant_M     , _     -> Repr.m
      | Consonant_N     , _     -> Repr.n
      | Consonant_GN    , _     -> Repr.gn
      | Consonant_L     , _     -> Repr.l
      | Consonant_R     , _     -> Repr.r
      | Muted t         , _     -> Repr.muted (_repr t)
      | Diphtonge (l1, l2), _   -> Repr.diphtongue (_repr l1) (_repr l2)

    in

    List.map _repr letters
    |> Repr.fold