some changes in Thai coding

3 files changed, 48 insertions, 33 deletions

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