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

module type T = sig

  type t
  val muted : t -> t

  val a : t
  val e : [`Closed | `Opened] -> t
  val eu : t

  val o : t
  val schwa : unit -> t

  (** This is an empty sound.

      It can be used to replace any element in a syllabus *)
  val none: t

  (** This is the voyel i like in "ici"
      When nazalized, the voyel become [in] like in "ainsi" *)
  val i : t

  (** This is the sound ou like in "ouvrier"
      When nazalized, the voyel does not change *)
  val voyel_u : t

  (** This is the sound u like in "unis"
      When nazalized, the voyel becom [un] like in "brun" *)
  val voyel_y : t

  (** Create a diphtongue from a semi-voyel and a voyel *)
  val diphtongue: t -> t -> t

  val nasal: t -> t option

  val p: t
  val b: t
  val t: t
  val d: t
  val k: t
  val g: t
  val f: t
  val v: t
  val s: t
  val z: t
  val sz: t
  val ch: t
  (* val j: t *)

  val n: t
  val m: t

  val r: t
  val l: t

  val semi_voyel_w: t
  val semi_voyel_y: t

  val is_voyel : t -> bool
  val is_nasal : t -> bool

end

module T = struct
  type kind =
    | None
    | Voyel

  type code =
    | None
    | SZ (* This is a possible Z if followed by a voyel *)
    | Voyel_A
    | Voyel_E
    | Voyel_I
    | Voyel_O
    | Voyel_U (* OU like in Ouvrir *)
    | Voyel_Y (* U like in Unique *)
    | SemiVoyel_W
    | SemiVoyel_Y
    | Consonant_P
    | Consonant_B
    | Consonant_T
    | Consonant_D
    | Consonant_K
    | Consonant_G
    | Consonant_F
    | Consonant_V
    | Consonant_S
    | Consonant_Z
    | Consonant_M
    | Consonant_N
    | Consonant_L
    | Consonant_R
    | Diphtonge of t * t

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

end

module Repr = struct

  type t = string

  let a = "a"
  and a_nasal = "@"

  and o = "o"
  and o_nasal = "§"

  and i = "i"
  and i_nasal = "5"
  and y = "y"
  and y_nasal = "1"

  and u = "u"

  and p = "p"
  and b = "b"
  and t = "t"
  and d = "d"

  and k = "k"
  and g = "g"

  and f = "f"
  and v = "v"

  and ch = "S"

  and s = "s"
  and z = "z"

  and m = "m"
  and n = "n"

  and l = "L"
  and r = "R"

  and semi_voyel_w = "w"
  and semi_voyel_y = "j"
end

module S = struct

  include T

  let is_voyel t = t.kind = Voyel
  let is_nasal t = t.nasal


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

  let voyel =
    { none with kind = Voyel }


  let diphtongue v1 v2 =
    { voyel with
      code = Diphtonge (v1, v2)
    ; repr = "[" ^ (v1.repr) ^ (v2.repr) ^ "]"
    }

  let code t = t.code

  let a =
    { voyel with
      code = Voyel_A
    ; repr = Repr.a
    }

  let e = function
    | `Closed -> { voyel with repr = "e" ; code = Voyel_E }
    | `Opened -> { voyel with repr = "E" ; code = Voyel_E }

  let eu =
    { voyel with repr = "9" }


  let schwa () =
    { voyel with
      code = Voyel_E
    ; repr = "°" }

  let o =
    { voyel with
      repr = Repr.o
    ; code = Voyel_O }

  let i =
    { voyel with
      repr = Repr.i
    ; code = Voyel_I }

  let voyel_y =
    { voyel with
      repr = Repr.y
    ; code = Voyel_Y }

  let voyel_u =
    { voyel with
      repr = Repr.u
    ; code = Voyel_U }

  let p =
    { none with
      code = Consonant_P
    ; repr = Repr.p
    ; mutable_ = false }

  let b =
    { none with
      code = Consonant_B
    ; repr = Repr.b
    ; mutable_ = false
    }

  let t =
    { none with
      code = Consonant_T
    ; repr = Repr.t
    }

  let d =
    { none with
      code = Consonant_D
    ; repr = Repr.d }

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

  let g =
    { none with
      code = Consonant_G
    ; repr = Repr.g }

  let f =
    { none with
      code = Consonant_F
    ; repr = Repr.f }

  let v =
    { none with
      code = Consonant_V
    ; repr = Repr.v }

  let s =
    { none with
      code = Consonant_S
    ; repr = Repr.s }

  let ch =
    { none with
      repr = Repr.ch
    ; mutable_ = false }

  let sz =
    { s with code = SZ }

  let z =
    { none with
      code = Consonant_Z
    ; repr = Repr.z }

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

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

  let l =
    { none with
      code = Consonant_L
    ; repr = Repr.l }

  let r =
    { none with
      code = Consonant_R
    ; repr = Repr.r }

  let semi_voyel_w =
    { none with
      repr = Repr.semi_voyel_w
    ; code = SemiVoyel_W}

  let semi_voyel_y =
    { none with
      repr = Repr.semi_voyel_y
    ; code = SemiVoyel_Y}

  let nasal t =

    match t.code with
    | Voyel_E -> Some { t with repr = Repr.a_nasal ; nasal = true }
    | Voyel_A -> Some { t with repr = Repr.a_nasal ; nasal = true }
    | Voyel_O -> Some { t with repr = Repr.o_nasal ; nasal = true }
    | Voyel_I -> Some { t with repr = Repr.i_nasal ; nasal = true }
    | Voyel_Y -> Some { t with repr = Repr.y_nasal ; nasal = true }
    | Diphtonge (s1, s2) ->
      begin match s1.code, s2.code with
        | (SemiVoyel_W, Voyel_I) ->
          (* The only case we could have the nasalisation of such diphtongue, is
             the case O I, N -> wich is transformed into O, I N *)
          Some (
            diphtongue
              semi_voyel_w
              { i with repr = Repr.i_nasal ; nasal = true } )
        | (Voyel_I, Voyel_E) ->
          (* The only case we could have the nasalisation of such diphtongue, is
             the case I E, N -> wich is transformed into I, E N *)
          Some (
            diphtongue
              i
              { t with repr = Repr.i_nasal ; nasal = true } )
        | _ -> None
      end
    | _ -> None

  let muted f =
    match f.mutable_ with
    | false -> f
    | true ->
      { none with
        repr = "(" ^ f.repr ^ ")" }

  let rec repr
    : t -> Repr.t
    = fun letter ->
      match letter.code, letter.nasal with

      | None, _ -> ""

      | Voyel_A, false -> Repr.a
      | Voyel_A, true  -> Repr.a_nasal
      | Voyel_E, _ -> ""
      | 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

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

      | 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_M, _ -> Repr.m
      | Consonant_N, _ -> Repr.n
      | Consonant_L, _ -> Repr.l
      | Consonant_R, _ -> Repr.r
      | Diphtonge (l1, l2), _ ->
        "["  ^ (repr l1) ^ (repr l2) ^ "]"
end

include S