diff --git a/examples/numerals/thai.gf b/examples/numerals/thai.gf index 1ef77a8a7..94bbe3982 100644 --- a/examples/numerals/thai.gf +++ b/examples/numerals/thai.gf @@ -16,15 +16,15 @@ lincat lin num x = x ; - pot01 = mkNum "hnvg" "hnvg" "eOMd'" ; + pot01 = mkNum "hnvg" "hnvg" "eOSd" ; - n2 = mkNum "s-Og" "y'i:T1" "s-Og" ; - n3 = regNum "s-a:m" ; - n4 = regNum "s-i:T1" ; -- T1 = E48 ' + n2 = mkNum "sOg" "yi:T1" "sOg" ; + n3 = regNum "sa:m" ; + n4 = regNum "si:T1" ; -- T1 = E48 ' n5 = regNum "hT2a:" ; -- T2 = E49 9 n6 = regNum "ho?k" ; - n7 = regNum "ecMd'" ; -- M = E47 w - n8 = regNum "e'pd'" ; + n7 = regNum "ecSd" ; -- S = E47 w + n8 = regNum "e'pd" ; n9 = regNum "eka:" ; @@ -32,12 +32,12 @@ lin pot110 = {s = sip} ; pot111 = {s = table { - Unit => ["s'ib et"] ; + Unit => ["sib eOSd"] ; Thousand => ["hnvg hmv:T1n hnvg p2an"] } } ; pot1to19 d = {s = table { - Unit => "s'ib" ++ d.s ! After ; + Unit => "sib" ++ d.s ! After ; Thousand => ["hnvg hmv:T1n"] ++ d.s ! Indep ++ "p2an" } } ; @@ -64,6 +64,6 @@ oper mkNum x x x ; - sip = table {Unit => "s'ib" ; Thousand => "hmv:T1n"} ; - roy = table {Unit => "rT2Oy'" ; Thousand => "e'sn"} ; - phan = table {Unit => [] ; Thousand => "p2an"} ; + sip = table {Unit => "sib" ; Thousand => "hmv:T1n"} ; + roy = table {Unit => "rT2Oy" ; Thousand => "e'sn"} ; + phan = table {Unit => [] ; Thousand => "p2an"} ; diff --git a/examples/numerals/thaiU.gf b/examples/numerals/thaiU.gf index a5f6ca685..35fbd8e8b 100644 --- a/examples/numerals/thaiU.gf +++ b/examples/numerals/thaiU.gf @@ -20,10 +20,10 @@ lin n2 = mkNum "สอง" "ยี่" "สอง" ; n3 = regNum "สาม" ; - n4 = regNum "สี่" ; -- E = E48 ' - n5 = regNum "ห้า" ; -- T = E49 9 + n4 = regNum "สี่" ; -- T1 = E48 ' + n5 = regNum "ห้า" ; -- T2 = E49 9 n6 = regNum "หก" ; - n7 = regNum "เจ็ด" ; -- M = E47 w + n7 = regNum "เจ็ด" ; -- S = E47 w n8 = regNum "แปด" ; n9 = regNum "เกา" ; @@ -32,12 +32,12 @@ lin pot110 = {s = sip} ; pot111 = {s = table { - Unit => ["ศิบเฏ"] ; + Unit => ["สิบเอ็ด"] ; Thousand => ["หนึงหมื่นหนึงพะน"] } } ; pot1to19 d = {s = table { - Unit => "ศิบ" ++ d.s ! After ; + Unit => "สิบ" ++ d.s ! After ; Thousand => ["หนึงหมื่น"] ++ d.s ! Indep ++ "พะน" } } ; @@ -64,6 +64,6 @@ oper mkNum x x x ; - sip = table {Unit => "ศิบ" ; Thousand => "หมื่น"} ; - roy = table {Unit => "ร้อย" ; Thousand => "ซแน"} ; + sip = table {Unit => "สิบ" ; Thousand => "หมื่น"} ; + roy = table {Unit => "ร้อย" ; Thousand => "แสน"} ; phan = table {Unit => [] ; Thousand => "พะน"} ; diff --git a/src/GF/Text/Thai.hs b/src/GF/Text/Thai.hs index b5e1f6b98..33d2b3a16 100644 --- a/src/GF/Text/Thai.hs +++ b/src/GF/Text/Thai.hs @@ -25,6 +25,8 @@ import Debug.Trace mkThai :: String -> String mkThai = concat . map mkThaiWord . words +mkThaiPron = unwords . map mkPronSyllable . words + type ThaiChar = Char @@ -40,10 +42,15 @@ thaiMap = Map.fromList $ zip allThaiTrans allThaiCodes -- convert all string literals in a text thaiStrings :: String -> String -thaiStrings s = case s of +thaiStrings = convStrings mkThai + +thaiPronStrings :: String -> String +thaiPronStrings = convStrings mkThaiPron + +convStrings conv s = case s of '"':cs -> let (t,_:r) = span (/='"') cs in - '"':mkThai t ++ "\"" ++ thaiStrings r - c:cs -> c:thaiStrings cs + '"': conv t ++ "\"" ++ convStrings conv r + c:cs -> c : convStrings conv cs _ -> s @@ -69,14 +76,13 @@ pronAndOrth s = case s of allThaiTrans :: [String] allThaiTrans = words $ - "- k k1 - k2 - k3 g c c1 c2 s c3 y d t " ++ - "t1 t2 t3 n d' t' t4 t5 t6 n b p p1 f p2 f' " ++ - "p3 m y' r - l - w s' r' s- h l' O h' - " ++ + "- k k1 - k2 - k3 g c c1 c2 s' c3 y' d' t' " ++ + "t1 t2 t3 n' d t t4 t5 t6 n b p p1 f p2 f' " ++ + "p3 m y r - l - w s- r' s h l' O h' - " ++ "a a. a: a+ i i: v v: u u: - - - - - - " ++ - "e e' o: a% a& L R M T1 T2 T3 T4 - - - - " ++ + "e e' o: a% a& L R S T1 T2 T3 T4 K - - - " ++ "N0 N1 N2 N3 N4 N5 N6 N7 N8 N9 - - - - - - " - allThaiCodes :: [Int] allThaiCodes = [0x0e00 .. 0x0e7f] @@ -109,17 +115,19 @@ data CClass = CLow | CMid | CHigh pronSyllable :: Syllable -> String pronSyllable s = - concatMap pronThaiChar (reverse $ initc s) ++ - tonem ++ - vowel ++ - finalCons - -- concatMap pronThaiChar (reverse $ finalc s) - + initCons ++ tonem ++ vowel ++ finalCons where vowel = case (initv s, midv s, finalv s, shorten s, tone s) of + ([0x0e40],[0x0e30,0x0e2d],_,_,_) -> "ö" -- eOa + ([0x0e40],[0x0e30,0x0e32],_,_,_) -> "o" -- ea:a (i,m,f,_,_) -> concatMap pronThaiChar (reverse $ f ++ m ++ i) ---- + initCons = concatMap pronThaiChar $ case (reverse $ initc s) of + 0x0e2b:cs@(_:_) -> cs -- high h + 0x0e2d:cs@(_:_) -> cs -- O + cs -> cs + finalCons = let (c,cs) = splitAt 1 $ finalc s in @@ -204,6 +212,12 @@ thaiFile f mo = do let put = maybe putStr writeFile mo put $ encodeUTF8 $ thaiStrings s +thaiPronFile :: FilePath -> Maybe FilePath -> IO () +thaiPronFile f mo = do + s <- readFile f + let put = maybe putStr writeFile mo + put $ encodeUTF8 $ thaiPronStrings s + finalThai c = maybe "" return (Map.lookup c thaiFinalMap) thaiFinalMap = Map.fromList $ zip allThaiCodes finals @@ -249,7 +263,8 @@ pronThai s = case s of | p=='+' -> c:"m" | s == "e'" -> "ä" | otherwise -> [c] - [c] | isUpper c -> "" --- O + "O" -> "O" + [c] | isUpper c -> "" _ -> s hex = map hx . reverse . digs where