-- Implements the modifiied SAMPA coding decribed in transcription.txt
-- for Markus Forsbergs swedish transcription library.
module SAMPA_Swe_Mod where

import IPA

-------------------------------------------------------------------
prSMList :: [(String,[IPA])] -> [(String,String)]
prSMList es = [(s, prTrans is) | (s, is) <- es] 
  where prTrans = unwords . filter (not . null) . map prSM

prQuantity :: Quantity -> String -> String
prQuantity Long x = x ++ ":"
prQuantity _    t = t
 
prSM :: IPA -> String
prSM i = case i of
	    Cons cons cds   -> prDiacritics cds $ prConsonant cons
	    Vow  vow  vds   -> prDiacritics vds  $ prVowel vow
	    PrimaryStress   -> ""
	    SecondaryStress -> ""
	    Unknown         -> "?"

prDiacritics :: [Diacritics] -> String -> String
prDiacritics _ t = t
	    
prConsonant :: Consonant -> String
prConsonant HookTopHeng = "S"
prConsonant (C (manner,place,voice,quantity)) =
      case (manner,place,voice) of
       (Plosive,Bilabial,Unvoiced)       -> "p"
       (Plosive,Bilabial,Voiced)         -> "b"
       (Plosive,Alveolar,Unvoiced)       -> "t"
       (Plosive,Alveolar,Voiced)         -> "d"
       (Plosive,Velar, Unvoiced)         -> "k"
       (Plosive,Velar, Voiced)           -> "g"

       (Fricative,Labiodental,Unvoiced)  -> "f"
       (Fricative,Labiodental,Voiced)    -> "v"
       -- v after l
       (Approximant,Labiodental,Voiced) -> "v"
       (Fricative,Alveolar,Unvoiced)     -> "s"
       -- "S" is HookTopHeng above
       (Fricative,Glottal,Unvoiced)      -> "h"
       (Fricative,Palatal,Unvoiced)      -> "C"

       (Nasal,Bilabial,Voiced)           -> "m"
       (Nasal,Alveolar,Voiced)           -> "n"
       (Nasal,Velar,Voiced)              -> "N"
       (Trill,Alveolar,Voiced)           -> "r"
       (LateralApproximant,Alveolar,Voiced) -> "l"
       (Approximant,Palatal,Voiced)         -> "j"

       (Plosive,Retroflex,Unvoiced)      -> "rt"
       (Plosive,Retroflex,Voiced)        -> "rd"
       (Nasal,Retroflex,Voiced)          -> "rn"
       (Fricative,Retroflex,Unvoiced)    -> "rs"
       (LateralApproximant,Retroflex,Voiced) -> "rl"

       _   -> "?"

prVowel :: Vowel -> String
prVowel (V (orientation,openess,roundness,quantity)) =
    prQuantity quantity $
     case (orientation,openess,roundness) of
      -- short
      (Front,Close,UnRounded)       -> "i"
      (Front,CloseMid,UnRounded)    -> "e"
      (Front,OpenMid,UnRounded)     -> "E"
      (Front,Close,Rounded)         -> "y"
      (Central,Close,Rounded)       -> "u0"
      (Front,CloseMid,Rounded)      -> "o2"
      (Back,Close,Rounded)          -> "u"
      (Back,CloseMid,Rounded)       -> "o"
      (Back,Open,UnRounded)         -> "A"
      -- long
      (Front,HalfClose,UnRounded)   -> "I"
      (Front,HalfClose,Rounded)     -> "Y"
      (Central,CloseMid,Rounded)    -> "u0"
      (Front,OpenMid,Rounded)       -> "o2"
      (Back,HalfClose,Rounded)      -> "U"
      (Back,OpenMid,Rounded)        -> "O"
      (Front,Open,UnRounded)        -> "a"
      -- schwa
      (Central,Mid,UnRounded)       -> "eh"
      -- pre-r ä
      (Front,HalfOpen,UnRounded)    -> "E3"
      _                             -> "?"