thai phrase translator

2026-04-09 04:59:31 -06:00 · 2007-03-16 16:23:39 +00:00
parent f7ce8940fa
commit 232c9cbb37
22 changed files with 1501 additions and 9 deletions
--- a/devel/phrases/Makefile
+++ b/devel/phrases/Makefile
@@ -0,0 +1,71 @@
+GF_GRAMMAR_ABS = Travel
+GF_GRAMMAR_ENG = $(GF_GRAMMAR_ABS)Eng
+GF_GRAMMAR_THA = $(GF_GRAMMAR_ABS)Tha
+GF_GRAMMAR_THP = $(GF_GRAMMAR_ABS)ThaiP
+GF_GRAMMAR_CNC = $(GF_GRAMMAR_ABS)ThaiP $(GF_GRAMMAR_ABS)Tha $(GF_GRAMMAR_ABS)Eng
+GF_GRAMMAR_CNC_FILES = $(addsuffix .gf, $(GF_GRAMMAR_CNC))
+GF_GRAMMAR_FILES = $(addsuffix .gf, $(GF_GRAMMAR_ABS)) $(GF_GRAMMAR_CNC_FILES)
+GEN_FILES = $(addsuffix .grxml,        $(GF_GRAMMAR_ENG)) \
+            $(addsuffix .gram,         $(GF_GRAMMAR_ENG)) \
+            $(addsuffix .jsgf,         $(GF_GRAMMAR_ENG)) \
+            $(addsuffix .jsgf,         $(GF_GRAMMAR_THA)) \
+            $(addsuffix .jsgf,         $(GF_GRAMMAR_THP)) \
+            $(addsuffix .vxml,         $(GF_GRAMMAR_ENG)) \
+            $(addsuffix .vxml-generic, $(GF_GRAMMAR_ENG)) \
+            $(addsuffix .vxml-grxml,   $(GF_GRAMMAR_ENG)) \
+            $(addsuffix .vxml-gram,    $(GF_GRAMMAR_ENG)) \
+            $(addsuffix .vxml-jsgf,    $(GF_GRAMMAR_ENG)) \
+            $(addsuffix .js,           $(GF_GRAMMAR_ABS))
+SRG_FORMAT = gram
+
+.PHONY: all clean
+
+all: $(GEN_FILES)
+
+
+
+%.grxml: %.gf
+	echo "pg -printer=srgs_xml_sisr_old | wf $@" | gf -s -nocpu -batch $^
+	tidy -q -xml -i -wrap 200 -m $@
+# Work around tidy bug
+	perl -i -pe 's/ lang=/ xml:lang=/' $@
+
+%.gram: %.gf
+	echo "pg -printer=srgs_abnf_sisr_old | wf $@" | gf -s -nocpu -batch $^
+
+%.jsgf: %.gf
+	echo "pg -printer=jsgf_sisr_old | wf $@" | gf -s -nocpu -batch $^
+
+%.vxml: %.vxml-$(SRG_FORMAT)
+	cp $^ $@
+
+%.vxml-generic: %.gf
+	echo 'pg -printer=vxml | wf $@' | gf -s -nocpu -batch $^
+	tidy -q -xml -i -wrap 200 -m $@ 
+# Work around tidy bug
+	perl -i -pe 's/ lang=/ xml:lang=/' $@
+# Work around Opera bug
+	perl -i -pe "s/ src=\"#/ src=\"$*.vxml#/" $@
+
+%.vxml-grxml: %.vxml-generic
+	cp $^ $@
+
+%.vxml-gram: %.vxml-generic
+	cp $^ $@
+	perl -i -pe 's/\.grxml/\.gram/' $@
+
+%.vxml-jsgf: %.vxml-generic
+	cp $^ $@
+	perl -i -pe 's/\.grxml/\.jsgf/' $@
+# Work around Opera for Zaurus bug 
+	perl -i -pe 's/ src="(.*\.jsgf)#(\w+)"/ src="$$1" root="$$2"/' $@
+
+$(GF_GRAMMAR_ABS).js: $(GF_GRAMMAR_FILES)
+	echo "pm -printer=js | wf $@" | gf -s -nocpu -batch $(GF_GRAMMAR_CNC_FILES)
+
+gflib.js: $(GF_LIB_PATH)/javascript/gflib.js
+	cat $^ > $@
+
+clean:
+	-rm -f $(GEN_FILES)
+	-rm -f *.gfc
--- a/devel/phrases/Numeral.gf
+++ b/devel/phrases/Numeral.gf
@@ -0,0 +1,50 @@
+--1 Numerals
+
+-- This grammar defines numerals from 1 to 999999. 
+-- The implementations are adapted from the
+-- [numerals library http://www.cs.chalmers.se/~aarne/GF/examples/numerals/] 
+-- which defines numerals for 88 languages.
+-- The resource grammar implementations add to this inflection (if needed)
+-- and ordinal numbers.
+--
+-- *Note* 1. Number 1 as defined 
+-- in the category $Numeral$ here should not be used in the formation of
+-- noun phrases, and should therefore be removed. Instead, one should use
+-- [Structural Structural.html]$.one_Quant$. This makes the grammar simpler
+-- because we can assume that numbers form plural noun phrases.
+--
+-- *Note* 2. The implementations introduce spaces between
+-- parts of a numeral, which is often incorrect - more work on
+-- (un)lexing is needed to solve this problem.
+
+abstract Numeral = {
+
+cat 
+  Numeral ;
+  Digit ;       -- 2..9
+  Sub10 ;       -- 1..9
+  Sub100 ;      -- 1..99
+  Sub1000 ;     -- 1..999
+  Sub1000000 ;  -- 1..999999
+
+fun 
+  num : Sub1000000 -> Numeral ;
+
+  n2, n3, n4, n5, n6, n7, n8, n9 : Digit ;
+
+  pot01 : Sub10 ;                               -- 1
+  pot0 : Digit -> Sub10 ;                       -- d * 1
+  pot110 : Sub100 ;                             -- 10
+  pot111 : Sub100 ;                             -- 11
+  pot1to19 : Digit -> Sub100 ;                  -- 10 + d
+  pot0as1 : Sub10 -> Sub100 ;                   -- coercion of 1..9
+  pot1 : Digit -> Sub100 ;                      -- d * 10
+  pot1plus : Digit -> Sub10 -> Sub100 ;         -- d * 10 + n
+  pot1as2 : Sub100 -> Sub1000 ;                 -- coercion of 1..99
+  pot2 : Sub10 -> Sub1000 ;                     -- m * 100
+  pot2plus : Sub10 -> Sub100 -> Sub1000 ;       -- m * 100 + n
+  pot2as3 : Sub1000 -> Sub1000000 ;             -- coercion of 1..999
+  pot3 : Sub1000 -> Sub1000000 ;                -- m * 1000
+  pot3plus : Sub1000 -> Sub1000 -> Sub1000000 ; -- m * 1000 + n
+
+}
--- a/devel/phrases/NumeralEng.gf
+++ b/devel/phrases/NumeralEng.gf
@@ -0,0 +1,77 @@
+--# -path=.:prelude
+
+concrete NumeralEng of Numeral = open Prelude in {
+
+lincat 
+    Numeral = {s : Str} ; ---{s : CardOrd => Str ; n : Num} ;
+  Digit = {s : DForm => CardOrd => Str} ;
+  Sub10 = {s : DForm => CardOrd => Str ; n : Num} ;
+  Sub100     = {s : CardOrd => Str ; n : Num} ;
+  Sub1000    = {s : CardOrd => Str ; n : Num} ;
+  Sub1000000 = {s : CardOrd => Str ; n : Num} ;
+
+lin num x = {s = x.s ! NCard} ; ----
+lin n2 = let two = mkNum "two"   "twelve"   "twenty" "second" in
+         {s = \\f,c => case <f,c> of {
+             <teen,NOrd> => "twelfth" ;
+             _ => two.s ! f ! c
+             }
+         } ;
+
+lin n3 = mkNum "three" "thirteen" "thirty" "third" ;
+lin n4 = mkNum "four"  "fourteen" "forty" "fourth" ;
+lin n5 = mkNum "five"  "fifteen"  "fifty" "fifth" ;
+lin n6 = regNum "six" ;
+lin n7 = regNum "seven" ;
+lin n8 = mkNum "eight" "eighteen" "eighty" "eighth" ;
+lin n9 = mkNum "nine" "nineteen" "ninety" "ninth" ;
+
+lin pot01 = mkNum "one" "eleven" "ten" "first" ** {n = Sg} ;
+lin pot0 d = d ** {n = Pl} ;
+lin pot110 = regCardOrd "ten" ** {n = Pl} ;
+lin pot111 = regCardOrd "eleven" ** {n = Pl} ;
+lin pot1to19 d = {s = d.s ! teen} ** {n = Pl} ;
+lin pot0as1 n = {s = n.s ! unit}  ** {n = n.n} ;
+lin pot1 d = {s = d.s ! ten} ** {n = Pl} ;
+lin pot1plus d e = {
+   s = \\c => d.s ! ten ! NCard ++ "-" ++ e.s ! unit ! c ; n = Pl} ;
+lin pot1as2 n = n ;
+lin pot2 d = {s = \\c => d.s ! unit ! NCard ++ mkCard c "hundred"}  ** {n = Pl} ;
+lin pot2plus d e = {
+  s = \\c => d.s ! unit ! NCard ++ "hundred" ++ "and" ++ e.s ! c ; n = Pl} ;
+lin pot2as3 n = n ;
+lin pot3 n = {
+  s = \\c => n.s ! NCard ++ mkCard c "thousand" ; n = Pl} ;
+lin pot3plus n m = {
+  s = \\c => n.s ! NCard ++ "thousand" ++ m.s ! c ; n = Pl} ;
+
+oper
+  mkNum : Str -> Str -> Str -> Str -> {s : DForm => CardOrd => Str} = 
+    \two, twelve, twenty, second ->
+    {s = table {
+       unit => table {NCard => two ; NOrd => second} ; 
+       teen => \\c => mkCard c twelve ; 
+       ten  => \\c => mkCard c twenty
+       }
+    } ;
+
+  regNum : Str -> {s : DForm => CardOrd => Str} = 
+    \six -> mkNum six (six + "teen") (six + "ty") (regOrd six) ;
+
+  regCardOrd : Str -> {s : CardOrd => Str} = \ten ->
+    {s = table {NCard => ten ; NOrd => regOrd ten}} ;
+
+  mkCard : CardOrd -> Str -> Str = \c,ten -> 
+    (regCardOrd ten).s ! c ; 
+
+  regOrd : Str -> Str = \ten -> 
+    case last ten of {
+      "y" => init ten + "ieth" ;
+      _   => ten + "th"
+      } ;
+
+param Num = Sg | Pl ;
+    CardOrd = NCard | NOrd ;
+    DForm = unit | teen | ten  ;
+
+}
--- a/devel/phrases/NumeralTha.gf
+++ b/devel/phrases/NumeralTha.gf
@@ -0,0 +1,70 @@
+--# -path=.:prelude:resource-1.0/thai
+
+concrete NumeralTha of Numeral = open StringsTha in {
+
+flags coding=utf8 ; unlexer=concat ;
+
+lincat 
+  Numeral    = {s : Str} ;
+  Digit      = {s : DForm => Str} ;
+  Sub10      = {s : DForm => Str} ;
+  Sub100     = {s : NForm => Str} ;
+  Sub1000    = {s : NForm => Str} ;
+  Sub1000000 = {s : Str} ;
+
+lin 
+  num x = x ;
+
+  pot01 = mkNum nvg_s nvg_s et_s ;
+
+  n2 = mkNum soog_s yii_s soog_s ;
+  n3 = regNum saam_s ;
+  n4 = regNum sii_s ;
+  n5 = regNum haa_s ;
+  n6 = regNum hok_s ;
+  n7 = regNum cet_s ; 
+  n8 = regNum peet_s ;
+  n9 = regNum kaaw_s ;
+
+
+  pot0 d = d ;
+
+  pot110 = {s = sip} ;
+  pot111 = {s = table {
+    Unit => sip_s ++ et_s ;
+    Thousand => nvg_s ++ mvvn_s ++ nvg_s ++ phan_s
+    }
+  } ;
+  pot1to19 d = {s = table {
+    Unit => sip_s ++ d.s ! After ; 
+    Thousand => nvg_s ++ mvvn_s ++ d.s ! Indep ++ phan_s
+    }
+  } ;
+  pot0as1 d = {s = \\n => d.s ! Indep ++ phan ! n} ;
+  pot1 d = {s = \\n => d.s ! ModTen ++ sip ! n} ;
+  pot1plus d e = {
+    s = \\n => d.s ! ModTen ++ sip ! n ++ e.s ! After ++ phan ! n
+  } ;
+  pot1as2 n = n ;
+  pot2 d = {s = \\n => d.s ! Indep ++ roy ! n} ;
+  pot2plus d e = {s = \\n => d.s ! Indep ++ roy ! n ++ e.s ! n} ;
+  pot2as3 n = {s = n.s ! Unit} ;
+  pot3 n = {s = n.s ! Thousand} ;
+  pot3plus n m = {s = n.s ! Thousand ++ m.s ! Unit} ;
+
+param 
+  DForm = Indep | ModTen | After ;
+  NForm = Unit | Thousand ;
+
+oper 
+  mkNum : Str -> Str -> Str -> {s : DForm => Str} = \x,y,z ->
+    {s = table {Indep => x ; ModTen => y ; After => z}} ;
+  regNum : Str -> {s : DForm => Str} = \x -> 
+    mkNum x x x ;
+
+
+  sip  = table {Unit => sip_s   ; Thousand => mvvn_s} ;
+  roy  = table {Unit => rooy_s ; Thousand => seen_s} ;
+  phan = table {Unit => []      ; Thousand => phan_s} ;
+
+}
--- a/devel/phrases/NumeralThaiP.gf
+++ b/devel/phrases/NumeralThaiP.gf
@@ -0,0 +1,86 @@
+--# -path=.:prelude:resource-1.0/thai
+
+concrete NumeralThaiP of Numeral = {
+
+lincat 
+  Numeral    = {s : Str} ;
+  Digit      = {s : DForm => Str} ;
+  Sub10      = {s : DForm => Str} ;
+  Sub100     = {s : NForm => Str} ;
+  Sub1000    = {s : NForm => Str} ;
+  Sub1000000 = {s : Str} ;
+
+lin 
+  num x = x ;
+
+  pot01 = mkNum nvg_s nvg_s et_s ;
+
+  n2 = mkNum soog_s yii_s soog_s ;
+  n3 = regNum saam_s ;
+  n4 = regNum sii_s ;
+  n5 = regNum haa_s ;
+  n6 = regNum hok_s ;
+  n7 = regNum cet_s ; 
+  n8 = regNum peet_s ;
+  n9 = regNum kaaw_s ;
+
+  pot0 d = d ;
+
+  pot110 = {s = sip} ;
+  pot111 = {s = table {
+    Unit => sip_s ++ et_s ;
+    Thousand => nvg_s ++ mvvn_s ++ nvg_s ++ phan_s
+    }
+  } ;
+  pot1to19 d = {s = table {
+    Unit => sip_s ++ d.s ! After ; 
+    Thousand => nvg_s ++ mvvn_s ++ d.s ! Indep ++ phan_s
+    }
+  } ;
+  pot0as1 d = {s = \\n => d.s ! Indep ++ phan ! n} ;
+  pot1 d = {s = \\n => d.s ! ModTen ++ sip ! n} ;
+  pot1plus d e = {
+    s = \\n => d.s ! ModTen ++ sip ! n ++ e.s ! After ++ phan ! n
+  } ;
+  pot1as2 n = n ;
+  pot2 d = {s = \\n => d.s ! Indep ++ roy ! n} ;
+  pot2plus d e = {s = \\n => d.s ! Indep ++ roy ! n ++ e.s ! n} ;
+  pot2as3 n = {s = n.s ! Unit} ;
+  pot3 n = {s = n.s ! Thousand} ;
+  pot3plus n m = {s = n.s ! Thousand ++ m.s ! Unit} ;
+
+oper
+  phan_s = "pahn" ;
+  rooy_s = "rawy" ;
+  mvvn_s = "meun" ;
+  seen_s = "sain" ;
+
+  nvg_s = "neung" ; 
+  soog_s = "song" ;
+  saam_s = "sahm" ;
+  sii_s = "see" ; 
+  haa_s = "hah" ; 
+  hok_s = "hok" ; 
+  cet_s = "jet" ; 
+  peet_s = "baat" ; 
+  kaaw_s = "gow" ; 
+  sip_s = "sip" ;
+  yii_s = "yee" ;
+  et_s = "et" ;
+
+param 
+  DForm = Indep | ModTen | After ;
+  NForm = Unit | Thousand ;
+
+oper 
+  mkNum : Str -> Str -> Str -> {s : DForm => Str} = \x,y,z ->
+    {s = table {Indep => x ; ModTen => y ; After => z}} ;
+  regNum : Str -> {s : DForm => Str} = \x -> 
+    mkNum x x x ;
+
+
+  sip  = table {Unit => sip_s   ; Thousand => mvvn_s} ;
+  roy  = table {Unit => rooy_s ; Thousand => seen_s} ;
+  phan = table {Unit => []      ; Thousand => phan_s} ;
+
+}
--- a/devel/phrases/Numerals.gf
+++ b/devel/phrases/Numerals.gf
@@ -0,0 +1,32 @@
+-- numerals from 1 to 999999 in decimal notation
+
+flags startcat=Numeral ;
+
+cat 
+  Numeral ;     -- 0..
+  Digit ;       -- 2..9
+  Sub10 ;       -- 1..9
+  Sub100 ;      -- 1..99
+  Sub1000 ;     -- 1..999
+  Sub1000000 ;  -- 1..999999
+
+fun 
+  num : Sub1000000 -> Numeral ;
+
+  n2, n3, n4, n5, n6, n7, n8, n9 : Digit ;
+
+  pot01 : Sub10 ;                               -- 1
+  pot0 : Digit -> Sub10 ;                       -- d * 1
+  pot110 : Sub100 ;                             -- 10
+  pot111 : Sub100 ;                             -- 11
+  pot1to19 : Digit -> Sub100 ;                  -- 10 + d
+  pot0as1 : Sub10 -> Sub100 ;                   -- coercion of 1..9
+  pot1 : Digit -> Sub100 ;                      -- d * 10
+  pot1plus : Digit -> Sub10 -> Sub100 ;         -- d * 10 + n
+  pot1as2 : Sub100 -> Sub1000 ;                 -- coercion of 1..99
+  pot2 : Sub10 -> Sub1000 ;                     -- m * 100
+  pot2plus : Sub10 -> Sub100 -> Sub1000 ;       -- m * 100 + n
+  pot2as3 : Sub1000 -> Sub1000000 ;             -- coercion of 1..999
+  pot3 : Sub1000 -> Sub1000000 ;                -- m * 1000
+  pot3plus : Sub1000 -> Sub1000 -> Sub1000000 ; -- m * 1000 + n
+
--- a/devel/phrases/NumeralsEng.gf
+++ b/devel/phrases/NumeralsEng.gf
@@ -0,0 +1,43 @@
+include numerals.Abs.gf ;
+
+param DForm = unit  | teen  | ten  ;
+
+lincat Numeral =    { s : Str } ;
+lincat Digit = {s : DForm => Str} ;
+lincat Sub10 = {s : DForm => Str} ;
+lincat Sub100 =     { s : Str } ;
+lincat Sub1000 =    { s : Str } ;
+lincat Sub1000000 = { s : Str } ;
+
+oper mkNum : Str -> Str -> Str -> Lin Digit = 
+  \two -> \twelve -> \twenty -> 
+  {s = table {unit => two ; teen => twelve ; ten => twenty}} ;
+oper regNum : Str -> Lin Digit = 
+  \six -> mkNum six (six + "teen") (six + "ty") ;
+oper ss : Str -> {s : Str} = \s -> {s = s} ;
+
+lin num x = x ;
+lin n2 = mkNum "two"   "twelve"   "twenty" ;
+lin n3 = mkNum "three" "thirteen" "thirty" ;
+lin n4 = mkNum "four"  "fourteen" "forty" ;
+lin n5 = mkNum "five"  "fifteen"  "fifty" ;
+lin n6 = regNum "six" ;
+lin n7 = regNum "seven" ;
+lin n8 = mkNum "eight" "eighteen" "eighty" ;
+lin n9 = regNum "nine" ;
+
+lin pot01 = {s = table {f => "one"}} ;
+lin pot0 d = {s = table {f => d.s ! f}} ;
+lin pot110 = ss "ten" ;
+lin pot111 = ss "eleven" ;
+lin pot1to19 d = {s = d.s ! teen} ;
+lin pot0as1 n = {s = n.s ! unit} ;
+lin pot1 d = {s = d.s ! ten} ;
+lin pot1plus d e = {s = d.s ! ten ++ "-" ++ e.s ! unit} ;
+lin pot1as2 n = n ;
+lin pot2 d = {s = d.s ! unit ++ "hundred"} ;
+lin pot2plus d e = {s = d.s ! unit ++ "hundred" ++ "and" ++ e.s} ;
+lin pot2as3 n = n ;
+lin pot3 n = {s = n.s ++ "thousand"} ;
+lin pot3plus n m = {s = n.s ++ "thousand" ++ m.s} ;
+
--- a/devel/phrases/PizzaDraw.gf
+++ b/devel/phrases/PizzaDraw.gf
@@ -0,0 +1,4 @@
+concrete PizzaDraw of Pizza = {
+
+
+}
--- a/devel/phrases/Travel.gf
+++ b/devel/phrases/Travel.gf
@@ -0,0 +1,54 @@
+abstract Travel = Numeral ** {
+
+cat 
+  Order ;
+cat
+  Output ;
+
+fun
+  confirm : Order -> Number -> Output ;
+
+
+-- the essential phrases from Lone Planet Thai Phrasebook
+
+  order : Phrase -> Order ;
+
+cat 
+  Phrase ;
+  Number ;
+
+fun
+  Hello           : Phrase ;
+  Goodbye         : Phrase ;
+  Please          : Phrase ;
+  ThankYou        : Phrase ;
+  YoureWelcome    : Phrase ;
+  Yes             : Phrase ;
+  No              : Phrase ;
+  ExcuseAttention : Phrase ;
+  ExcuseGetPast   : Phrase ;
+  Sorry           : Phrase ;
+  IUnderstand     : Phrase ;
+  IDontUnderstand : Phrase ;
+  Help            : Phrase ;
+  WhereAreToilets : Phrase ;
+
+  
+  SayNumber : Numeral -> Phrase ;
+
+  One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten : Number ;
+
+
+cat 
+  Product ;
+  Kind ;
+
+fun
+  HowMuchCost : Product -> Order ;
+
+  This : Kind -> Product ;
+
+  Beer  : Kind ;
+  Shirt : Kind ;
+
+}
--- a/devel/phrases/TravelEng.gf
+++ b/devel/phrases/TravelEng.gf
@@ -0,0 +1,86 @@
+--# -path=.:prelude:resource-1.0/thai
+
+concrete TravelEng of Travel = NumeralEng ** open Prelude in {
+
+flags startcat = Order; language = en_US;
+
+lincat
+  Order = { s : Str } ;
+
+printname cat
+  Order = "What would you like to say?" ;
+
+lin
+  order is = { s = is.s } ;
+
+
+
+lincat 
+  Output = { s : Str } ;
+
+lin
+  confirm o t = { s = o.s} ;
+
+flags unlexer=unwords ;
+
+lincat 
+  Phrase = SS ;
+  Number = SS ;
+
+lin
+  Hello           = ss "hello" ;
+  Goodbye         = ss "bye" ;
+  Please          = ss "please" ;
+  ThankYou        = ss "thanks" ;
+  YoureWelcome    = ss ["you are welcome"] ;
+  Yes             = ss "yes" ;
+  No              = ss "no" ;
+  ExcuseAttention = ss ["excuse me"] ;
+  ExcuseGetPast   = ss ["excuse me"] ;
+  Sorry           = ss "sorry" ;
+  IUnderstand     = ss ["I understand"] ;
+  IDontUnderstand = ss ["I do not understand"] ;
+  Help            = ss "help" ;
+  WhereAreToilets = ss ["where are the toilets"] ;
+
+  
+  SayNumber n = n ;
+
+  One = ss "one" ; 
+  Two = ss "two" ; 
+  Three = ss "three" ; 
+  Four = ss "four" ; 
+  Five = ss "five" ; 
+  Six = ss "six" ; 
+  Seven = ss "seven" ; 
+  Eight = ss "eight" ; 
+  Nine = ss "nine" ; 
+  Ten = ss "ten" ;
+
+lincat
+  Product = {s : Str} ;
+  Kind = {s : Str} ;
+
+printname cat
+  Product = "what product do you mean?" ;
+  Kind = "what kind of product do you mean?" ;
+
+lin
+  HowMuchCost p = {s = ["how much does"] ++ 
+    variants {
+    p.s ;
+    -- no kind given
+    "this" ;
+    -- no product given at all
+    "it"
+    } ++ 
+    "cost"} ;
+
+  This k = {s = "this" ++ k.s} ;
+
+  Beer = {s = "beer"} ;
+  Shirt = {s = "shirt"} ;
+
+
+
+}
--- a/devel/phrases/TravelTha.gf
+++ b/devel/phrases/TravelTha.gf
@@ -0,0 +1,80 @@
+--# -path=.:prelude:resource-1.0/thai
+
+concrete TravelTha of Travel = NumeralTha ** open Prelude, StringsTha in {
+
+flags startcat = Order; language = en_US; coding=utf8 ;
+
+lincat
+  Order = { s : Str } ;
+
+printname cat
+  Order = "What would you like to say?" ;
+
+lin
+  order is = { s = is.s } ;
+
+
+
+lincat 
+  Output = { s : Str } ;
+
+lin
+  confirm o t = { s = o.s } ;
+
+
+
+
+flags unlexer=concat ; 
+
+lincat 
+  Phrase = SS ;
+  Number = SS ;
+
+lin
+  Hello           = ss (sawat_s ++ dii_s) ;
+  Goodbye         = ss (laa_s ++ koon_s) ;
+  Please          = ss (khoo_s) ;
+  ThankYou        = ss (khoop_s ++ khun_s) ;
+  YoureWelcome    = ss (yin_s ++ dii_s) ;
+  Yes             = ss (chay_s) ;
+  No              = ss (may_s) ;
+  ExcuseAttention = ss (khoo_s ++ thoot_s) ;
+  ExcuseGetPast   = ss (khoo_s ++ aphai_s) ;
+  Sorry           = ss (khoo_s ++ thoot_s) ;
+  IUnderstand     = ss (phom_s ++ khow_s ++ jai_s) ;
+  IDontUnderstand = ss (phom_s ++ may_s ++ khow_s ++ jai_s) ;
+  Help            = ss (chuay_s ++ duay_s) ;
+  WhereAreToilets = ss (hoog_s ++ nam_s ++ yuu_s ++ thii_s ++ nai_s) ;
+
+  
+  SayNumber n = n ;
+
+  One = ss (nvg_s) ; 
+  Two = ss (soog_s) ; 
+  Three = ss (saam_s) ; 
+  Four = ss (sii_s) ; 
+  Five = ss (haa_s) ; 
+  Six = ss (hok_s) ; 
+  Seven = ss (cet_s) ; 
+  Eight = ss (peet_s) ; 
+  Nine = ss (kaaw_s) ; 
+  Ten = ss (sip_s) ;
+
+lincat
+  Product = {s : Str} ;
+  Kind = {s : Str} ;
+
+printname cat
+  Product = "what product do you mean?" ;
+  Kind = "what kind of product do you mean?" ;
+
+lin
+  HowMuchCost p = ss (p.s ++ thao_s ++ rai_s) ;
+
+  This k = ss (k.s ++ nii_s) ;
+
+  Beer = ss biar_s ;
+  Shirt = ss (seua_s ++ cheut_s) ;
+
+
+}
--- a/devel/phrases/TravelThaiP.gf
+++ b/devel/phrases/TravelThaiP.gf
@@ -0,0 +1,79 @@
+--# -path=.:prelude:resource-1.0/thai
+
+concrete TravelThaiP of Travel = NumeralThaiP ** open Prelude, StringsTha in {
+
+flags startcat = Order; language = en_US ;
+
+lincat
+  Order = { s : Str } ;
+
+printname cat
+  Order = "What would you like to say?" ;
+
+lin
+  order is = { s = is.s } ;
+
+
+
+lincat 
+  Output = { s : Str } ;
+
+lin
+  confirm o t = { s = o.s } ;
+
+
+
+
+flags unlexer=unwords ; 
+
+lincat 
+  Phrase = SS ;
+  Number = SS ;
+
+lin
+  Hello           = ss ["sah wut dee"] ;
+  Goodbye         = ss ["lah gorn"] ;
+  Please          = ss "kor" ;
+  ThankYou        = ss ["kop koon"] ;
+  YoureWelcome    = ss ["yin dee"] ;
+  Yes             = ss "chai" ;
+  No              = ss "mai" ;
+  ExcuseAttention = ss ["koh tort"] ;
+  ExcuseGetPast   = ss ["koh ahpai"] ;
+  Sorry           = ss ["koh tort"] ;
+  IUnderstand     = ss ["pom kow jai"] ;
+  IDontUnderstand = ss ["pom mai kow jai"] ;
+  Help            = ss ["chew wai dewai"] ;
+  WhereAreToilets = ss ["hong narm yoo tee nai"] ;
+
+  
+  SayNumber n = n ;
+
+  One = ss "neung" ; 
+  Two = ss "song" ;
+  Three = ss "sahm" ;
+  Four = ss "see" ; 
+  Five = ss "hah" ; 
+  Six = ss "hok" ; 
+  Seven = ss "jet" ; 
+  Eight = ss "baat" ; 
+  Nine = ss "gow" ; 
+  Ten = ss "sip" ;
+
+lincat
+  Product = {s : Str} ;
+  Kind = {s : Str} ;
+
+printname cat
+  Product = "what product do you mean?" ;
+  Kind = "what kind of product do you mean?" ;
+
+lin
+  HowMuchCost p = ss (p.s ++ "tao" ++ "rai") ;
+
+  This k = ss (k.s ++ "nee") ;
+
+  Beer = ss "beea" ;
+  Shirt = ss ("seua" ++ "cheut") ;
+
+}
--- a/devel/phrases/flash-controls.js
+++ b/devel/phrases/flash-controls.js
@@ -0,0 +1,18 @@
+function getFlashMovieObject(movieName) {
+  if (window.document[movieName]) {
+      return window.document[movieName];
+  }
+  if (document.embeds && document.embeds[movieName]) {
+      return document.embeds[movieName]; 
+  } else {
+      return document.getElementById(movieName);
+  }
+}
+
+function flashPlay(movieName) {
+  getFlashMovieObject(movieName).Play();
+}
+
+function flashPause(movieName) {
+  getFlashMovieObject(movieName).StopPlay();
+}
--- a/devel/phrases/gflib.js
+++ b/devel/phrases/gflib.js
@@ -0,0 +1,252 @@
+/* Abstract syntax trees */
+function Fun(name) {
+	this.name = name;
+	this.args = copy_arguments(arguments, 1);
+}
+Fun.prototype.print = function () { return this.show(0); } ;
+Fun.prototype.show = function (prec) {
+	if (this.isMeta()) {
+		if (isUndefined(this.type)) {
+			return '?';
+		} else {
+			var s = '?:' + this.type;
+			if (prec > 0) {
+				s = "(" + s + ")" ;
+			}
+			return s;
+		}
+	} else {
+		var s = this.name;
+		var cs = this.args;
+		for (var i in cs) {
+			s += " " + cs[i].show(1);
+		}
+		if (prec > 0 && cs.length > 0) {
+			s = "(" + s + ")" ;
+		}
+		return s;
+	}
+};
+Fun.prototype.getArg = function (i) {
+	return this.args[i];
+};
+Fun.prototype.setArg = function (i,c) {
+	this.args[i] = c;
+};
+Fun.prototype.isMeta = function() {
+	return this.name == '?';
+} ;
+Fun.prototype.isComplete = function() {
+	if (this.isMeta()) {
+		return false;
+	} else {
+		for (var i in tree.args) {
+			if (!tree.args[i].isComplete()) {
+				return false;
+			}
+		}
+		return true;
+	}
+} ;
+
+/* Concrete syntax terms */
+
+function Arr() { this.arr = copy_arguments(arguments, 0); }
+Arr.prototype.tokens = function() { return this.arr[0].tokens(); };
+Arr.prototype.sel = function(i) { return this.arr[i.toIndex()]; };
+
+function Seq() { this.seq = copy_arguments(arguments, 0); }
+Seq.prototype.tokens = function() { 
+	var xs = new Array();
+	for (var i in this.seq) {
+		var ys = this.seq[i].tokens();
+		for (var j in ys) {
+			xs.push(ys[j]);
+		}		
+	}
+	return xs; 
+};
+
+function Variants() { this.variants = copy_arguments(arguments, 0); }
+Variants.prototype.tokens = function() { return this.variants[0].tokens(); };
+
+function Rp(index,value) { this.index = index; this.value = value; }
+Rp.prototype.tokens = function() { return new Array(this.index); };
+Rp.prototype.toIndex = function() { return this.index.toIndex(); };
+
+function Suffix(prefix,suffix) { this.prefix = prefix; this.suffix = suffix; };
+Suffix.prototype.tokens = function() {
+	var xs = this.suffix.tokens();
+	for (var i in xs) {
+		xs[i] = this.prefix + xs[i];
+	}
+	return xs;
+};
+Suffix.prototype.sel = function(i) { return new Suffix(this.prefix, this.suffix.sel(i)); };
+
+function Meta() { }
+Meta.prototype.tokens = function() { return new Array("?"); };
+Meta.prototype.toIndex = function() { return 0; };
+Meta.prototype.sel = function(i) { return this; };
+
+function Str(value) { this.value = value; }
+Str.prototype.tokens = function() { return new Array(this.value); };
+
+function Int(value) { this.value = value; }
+Int.prototype.tokens = function() { return new Array(this.value.toString()); };
+Int.prototype.toIndex = function() { return this.value; };
+
+/* Type annotation */
+
+function Abstract() {
+	this.types = new Array();
+}
+Abstract.prototype.addType = function(fun, args, cat) {
+	this.types[fun] = new Type(args, cat);
+} ;
+Abstract.prototype.annotate = function(tree, type) {
+	if (tree.name == '?') {
+		tree.type = type;
+	} else {
+		var typ = this.types[tree.name];
+		for (var i in tree.args) {
+			this.annotate(tree.args[i], typ.args[i]);
+		}
+	}
+	return tree;
+} ;
+/* Hack to get around the fact that our SISR doesn't build real Fun objects. */
+Abstract.prototype.copyTree = function(x) {
+	var t = new Fun(x.name);
+	if (!isUndefined(x.type)) {
+	  t.type = x.type;
+	}
+	var cs = x.args;
+	if (!isUndefined(cs)) {
+	  for (var i in cs) {
+	    t.setArg(i, this.copyTree(cs[i]));
+	  }
+	}
+	return t;
+} ;
+Abstract.prototype.parseTree = function(str, type) { 
+	return this.annotate(this.parseTree_(str.match(/[\w\']+|\(|\)|\?/g), 0), type); 
+} ;
+Abstract.prototype.parseTree_ = function(tokens, prec) {
+	if (tokens.length == 0 || tokens[0] == ")") { return null; }
+	var t = tokens.shift();
+	if (t == "(") {
+		var tree = this.parseTree_(tokens, 0);
+		tokens.shift();
+		return tree;
+	} else if (t == '?') {
+		return new Fun('?');
+	} else {
+		var tree = new Fun(t);
+		if (prec == 0) {
+			var c, i;
+			for (i = 0; (c = this.parseTree_(tokens, 1)) !== null; i++) {
+				tree.setArg(i,c);
+			}
+		}
+		return tree;
+	}
+} ;
+
+function Type(args, cat) {
+	this.args = args;
+	this.cat = cat;
+}
+
+/* Linearization */
+
+function Concrete(abstr) {
+	this.abstr = abstr;
+	this.rules = new Array();
+}
+Concrete.prototype.rule = function (name, cs) { return this.rules[name](cs); };
+Concrete.prototype.addRule = function (name, f) { this.rules[name] = f; };
+Concrete.prototype.lindef = function (cat, v) { return this.rules["_d"+cat]([new Str(v)]); } ;
+Concrete.prototype.linearize = function (tree) { 
+	return this.unlex(this.linearizeToTerm(tree).tokens());
+};
+Concrete.prototype.linearizeToTerm = function (tree) {
+	if (tree.isMeta()) {
+		if (isUndefined(tree.type)) {
+			return new Meta();
+		} else {
+			return this.lindef(tree.type, tree.name);
+		}
+	} else {
+	        var cs = new Array();
+		for (var i in tree.args) {
+		  cs.push(this.linearizeToTerm(tree.args[i]));
+		}
+		return this.rule(tree.name, cs);
+	}
+};
+Concrete.prototype.unlex = function (ts) {
+	if (ts.length == 0) {
+		return "";
+	}
+
+	var noSpaceAfter = /^[\(\-\[]/;
+	var noSpaceBefore = /^[\.\,\?\!\)\:\;\-\]]/;
+
+	var s = "";
+	for (var i = 0; i < ts.length; i++) {
+		var t = ts[i];
+		var after = i < ts.length-1 ? ts[i+1] : null;
+		s += t;
+		if (after != null && !t.match(noSpaceAfter) 
+				  && !after.match(noSpaceBefore)) {
+			s += " ";
+		}
+	}
+	return s;
+};
+
+
+/* Utilities */
+
+/* from Remedial JavaScript by Douglas Crockford, http://javascript.crockford.com/remedial.html */
+function isString(a) { return typeof a == 'string'; }
+function isArray(a) { return a && typeof a == 'object' && a.constructor == Array; }
+function isUndefined(a) { return typeof a == 'undefined'; }
+function isBoolean(a) { return typeof a == 'boolean'; }
+function isNumber(a) { return typeof a == 'number' && isFinite(a); }
+function isFunction(a) { return typeof a == 'function'; }
+
+function dumpObject (obj) {
+	if (isUndefined(obj)) {
+		return "undefined";
+	} else if (isString(obj)) {
+		return '"' + obj.toString() + '"'; // FIXME: escape
+	} else if (isBoolean(obj) || isNumber(obj)) {
+		return obj.toString();
+	} else if (isArray(obj)) {
+		var x = "[";
+		for (var i in obj) {
+			x += dumpObject(obj[i]);
+			if (i < obj.length-1) {
+				x += ",";
+			}
+		}
+		return x + "]";		
+	} else {
+		var x = "{";
+		for (var y in obj) {
+			x += y + "=" + dumpObject(obj[y]) + ";" ;
+		}
+		return x + "}";
+	}
+}
+
+
+function copy_arguments(args, start) {
+	var arr = new Array();
+	for (var i = 0; i < args.length - start; i++) {
+		arr[i] = args[i + start];
+	}
+	return arr;
+}
--- a/devel/phrases/index.html
+++ b/devel/phrases/index.html
@@ -0,0 +1,79 @@
+<!DOCTYPE html 
+     PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+  <head>
+    <title>English-Thai Phrase Translator</title>
+    <link href="style.css" rel="stylesheet" type="text/css"></link>
+    <script type="text/javascript" src="flash-controls.js"></script>
+  </head>
+
+  <body>
+    <h1>English-Thai Phrase Translator</h1>
+
+    <p>This document describes the 
+      <a href="pizza.xml">GF XHTML+Voice English-Thai Phrase Translator</a>, 
+      a demonstration of
+      <a href="http://www.voicexml.org/specs/multimodal/x+v/12/">XHTML+Voice</a> 
+      dialog system generated from a 
+      <a href="http://www.cs.chalmers.se/~aarne/GF/">Grammatical Framework</a> grammar.
+      For a more detailed explanation of how this generation is done, 
+      see the article <a href="http://www.cs.chalmers.se/~bringert/publ/gf-voicexml/gf-voicexml.pdf">Generating Dialog Systems from Grammars</a>.
+  This demo was built by reusing code and ideas from Björn Bringert's
+  <a href="http://www.cs.chalmers.se/~bringert/xv/pizza/">Pizza Demo</a>.
+    </p>
+
+
+
+    <h2>Try the demo</h2>
+
+    <p>You can <a href="pizza.xml">try the demo</a> if you 
+      have a web browser which can handle 
+      <a href="http://www.voicexml.org/specs/multimodal/x+v/12/">XHTML+Voice</a>
+      and 
+      <a href="http://www.w3.org/Graphics/SVG/">SVG</a>. 
+      Currently this only includes 
+      <a href="http://www.opera.com/download/">Opera</a> for Windows (when voice controlled
+      browsing is enabled). See
+      <a href="http://www.opera.com/support/tutorials/voice/using/">Using Opera with Voice</a>
+      for more information.</p>
+
+   <p>There is a slightly simpler version of the demo which also works
+   on the Opera multimodal browser for the Sharp Zaurus. It will be added here shortly.</p>
+
+
+    <h2>Functionality</h2>
+
+    
+    <h2>References</h2>
+    <ul>
+
+      <li><a href="http://www.cs.chalmers.se/~aarne/GF/">Grammatical Framework</a>.</li>
+
+      <li><a href="http://www.cs.chalmers.se/~bringert/publ/gf-voicexml/gf-voicexml.pdf">Generating Dialog Systems from Grammars</a>, Bj&ouml;rn Bringert, 2007. Submitted to <a href="http://ufal.mff.cuni.cz/acl2007/">ACL 2007</a>.</li>
+
+      <li><a href="http://www.voicexml.org/specs/multimodal/x+v/12/">XHTML+Voice Profile 1.2</a>, VoiceXML Forum.</li>
+
+      <li><a href="http://dev.opera.com/articles/voice/">Voice - Opera Developer Community</a>, Opera Software ASA.</li>
+<li><a href="http://www.w3.org/TR/voicexml20/">Voice Extensible Markup Language (VoiceXML) Version 2.0</a>.</li>
+
+      <li><a href="http://www.w3.org/TR/speech-grammar/">Speech Recognition Grammar Specification (SRGS)</a>, W3C Recommendation. 
+	GF can generate SRGS grammars in both the XML and ABNF forms, and Opera 
+      supports both formats.</li>
+
+      <li><a href="http://www.w3.org/TR/jsgf/">JSpeech Grammar Format (JSGF)</a>, W3C Note. 
+      GF can also generate JSGF grammars, and Opera supports them.</li>
+
+      <li><a href="http://www.w3.org/TR/semantic-interpretation/">Semantic Interpretation for Speech Recognition (SISR) Version 1.0</a>, 
+	W3C Proposed Recommendation.
+	The version supported by Opera appears to be 
+	<a href="http://www.w3.org/TR/2003/WD-semantic-interpretation-20030401/">SISR - W3C Working Draft 1 April 2003</a>.</li>
+
+    </ul>
+
+
+    <address><a href="http://www.cs.chalmers.se/~aarne/">Aarne Ranta</a>,
+      <a href="mailto:bringert@cs.chalmers.se">aarne@cs.chalmers.se</a>.</address>
+
+  </body>
+</html>
--- a/devel/phrases/order-simple.js
+++ b/devel/phrases/order-simple.js
@@ -0,0 +1,49 @@
+var currentOrder = new Fun("?");
+var talkText;
+
+
+function say(text) {
+	talkText = text;
+	activateForm("talker");
+}
+
+function newOrder() {
+	currentOrder = new Fun("?");
+
+	document.getElementById("top_abs").value = "";
+	document.getElementById("top_img").value = "";
+
+	document.getElementById("ordertext").value = "";
+
+	return getOrder();
+}
+
+function getOrder() {
+	activateForm("getorder");
+	return true;
+}
+
+
+function done(input) {
+	currentOrder = Pizza.copyTree(input, "Order");
+	document.getElementById("top_abs").value = currentOrder.print();
+
+	sayOrder();
+}
+
+function sayOrder() {
+	var eng = PizzaEng.linearize(currentOrder);
+	document.getElementById("ordertext").value = eng;
+	say("You have ordered " + eng);	
+}
+
+
+
+/* XHTML+Voice Utilities */
+
+function activateForm(formid) {
+	var form = document.getElementById(formid);
+	var e = document.createEvent("UIEvents");
+	e.initEvent("DOMActivate","true","true");
+	form.dispatchEvent(e); 
+}
--- a/devel/phrases/order.js
+++ b/devel/phrases/order.js
@@ -0,0 +1,70 @@
+var svgNS = "http://www.w3.org/2000/svg";
+
+var currentOrder = new Fun("?");
+
+var talkText;
+
+function say(text) {
+	talkText = text;
+	activateForm("talker");
+}
+
+function newOrder() {
+	currentOrder = new Fun("?");
+
+	document.getElementById("in_abs").value = "";
+
+	setText(document.getElementById("ordertext"), "");
+	setText(document.getElementById("ordertextf"), "");
+	setText(document.getElementById("ordertextt"), "");
+
+	return getOrder();
+}
+
+function getOrder() {
+	activateForm("getorder");
+	return true;
+}
+
+function done(input) {
+	currentOrder = Travel.copyTree(input);
+	document.getElementById("in_abs").value = currentOrder.print();
+	
+	sayOrder();
+}
+
+function sayOrder() {
+	var output = currentOrder;
+        var eng = TravelEng.linearize(output);
+	setText(document.getElementById("ordertext"), eng);
+	
+        var fin = TravelTha.linearize(output).replace(/ /g,"");
+	setText(document.getElementById("ordertextf"), fin);	
+        var tha = TravelThaiP.linearize(output);
+	setText(document.getElementById("ordertextt"), tha);
+	say(tha);	
+}
+
+
+
+/* XHTML+Voice Utilities */
+
+function activateForm(formid) {
+	var form = document.getElementById(formid);
+	var e = document.createEvent("UIEvents");
+	e.initEvent("DOMActivate","true","true");
+	form.dispatchEvent(e); 
+}
+
+/* DOM utilities */
+
+function removeChildren(node) {
+	while (node.hasChildNodes()) {
+		node.removeChild(node.firstChild);
+	}
+  }
+
+function setText(node, text) {
+	removeChildren(node);
+	node.appendChild(document.createTextNode(text));
+}
--- a/devel/phrases/pizza-movie-large.html
+++ b/devel/phrases/pizza-movie-large.html
@@ -0,0 +1,39 @@
+<!DOCTYPE html 
+     PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+    <title>Pizza Demo - GF XHTML+Voice</title>
+    <link href="style.css" rel="stylesheet" type="text/css"></link>
+    <script type="text/javascript" src="flash-controls.js"></script>
+</head>
+<body>
+
+<h1>Pizza Demo - GF XHTML+Voice</h1>
+
+<p>This is a demo of a dialog system built with GF and XHTML+Voice.
+There is <a href="index.html">more information about this demo here</a>.</p>
+
+
+<form class="flashControls">
+<p>
+<input type="button" onclick="flashPlay('pizzaSmall')" value="Play"/>
+<input type="button" onclick="flashPause('pizzaSmall')" value="Pause"/>
+</p>
+</form>
+
+<p>
+<object id="pizzaLarge" classid="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000" width="762" height="578"
+ codebase="http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0">
+ <param name="movie" value="pizza-movie-large.swf" />
+ <param name="play" value="false" />
+ <param name="loop" value="false" />
+ <param name="quality" value="autohigh" />
+<embed id="pizzaLarge" name="pizzaLarge" src="pizza-movie-large.swf" width="762" height="578" play="false"
+ loop="false" quality="autohigh" type="application/x-shockwave-flash"
+ pluginspage="http://www.macromedia.com/go/getflashplayer">
+</embed></object>
+</p>
+
+</body>
+</html>
--- a/devel/phrases/pizza-simple.html
+++ b/devel/phrases/pizza-simple.html
@@ -0,0 +1,62 @@
+<?xml version="1.0"?>
+<!DOCTYPE html PUBLIC "-//VoiceXML Forum//DTD XHTML+Voice 1.2//EN" "http://www.voicexml.org/specs/multimodal/x+v/12/dtd/xhtml+voice12.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"
+    xmlns:vxml="http://www.w3.org/2001/vxml" 
+    xmlns:ev="http://www.w3.org/2001/xml-events"
+    xmlns:xv="http://www.voicexml.org/2002/xhtml+voice"
+    xml:lang="en-US">
+
+<head>
+<title>Order a Pizza</title>
+<script type="text/javascript" src="gflib.js"></script>
+<script type="text/javascript" src="pizza-simple.js"></script>
+<script type="text/javascript" src="order-simple.js"></script>
+
+  <vxml:form id="talker">
+<vxml:block>
+<vxml:value expr="talkText"/>
+    </vxml:block>
+  </vxml:form>
+
+<vxml:form id="getorder">
+<vxml:var name="dummy" />
+<vxml:subdialog name="sub" src="Pizza.vxml#Order_cat">
+<vxml:param name="old" expr="currentOrder" />
+<vxml:filled>
+<vxml:assign name="dummy" expr="done(sub.term)"/>
+</vxml:filled>
+</vxml:subdialog>
+</vxml:form>
+
+</head>
+
+<body>
+
+<p><button  onclick="newOrder()">I want to say a phrase</button></p>
+
+<div class="box">
+<form>
+<input type="text" id="ordertext" size="100" style="width:100%" />
+</form>
+</div>
+<div class="box">
+<form>
+<input type="text" id="ordertextf" size="100" style="width:100%" />
+</form>
+<form>
+<input type="text" id="ordertextt" size="100" style="width:100%" />
+</form>
+</div>
+
+<div class="box">
+<form>
+<p>
+Current order state<br />
+<input type="text" id="top_img" size="70" /><br />
+<textarea id="top_abs" rows="4" cols="52"></textarea>
+</p>
+</form>
+</div>
+
+</body>
+</html>
--- a/devel/phrases/pizza.xml
+++ b/devel/phrases/pizza.xml
@@ -0,0 +1,73 @@
+<!DOCTYPE html PUBLIC "-//VoiceXML Forum//DTD XHTML+Voice 1.2//EN" "http://www.voicexml.org/specs/multimodal/x+v/12/dtd/xhtml+voice12.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"
+      xmlns:ev="http://www.w3.org/2001/xml-events"
+      xmlns:xv="http://www.voicexml.org/2002/xhtml+voice"
+      xmlns:vxml="http://www.w3.org/2001/vxml">
+
+  <head>
+    <title>Say Phrases in Thai</title>
+    <meta http-equiv="content-type" content="text/xml; charset=utf-8" />
+
+    <link href="style.css" rel="stylesheet" type="text/css"></link>
+
+    <script type="text/javascript" src="gflib.js"></script>
+    <script type="text/javascript" src="Travel.js"></script>
+    <script type="text/javascript" src="order.js"></script>
+    
+    <vxml:form id="talker">
+      <vxml:block>
+	<vxml:value expr="talkText"/>
+      </vxml:block>
+    </vxml:form>
+
+    <vxml:form id="getorder">
+      <vxml:var name="dummy" />
+      <vxml:subdialog name="sub" src="TravelEng.vxml#Order_cat">
+	<vxml:param name="old" expr="currentOrder" />
+	<vxml:filled>
+	  <vxml:assign name="dummy" expr="done(sub.term)"/>
+	</vxml:filled>
+      </vxml:subdialog>
+    </vxml:form>
+
+  </head>
+
+  <body>
+
+    <div><img src="images/logo.png" width="246" height="92" /></div>
+
+    <div><p>This demo requires an XHTML+Voice browser. 
+	<a href="index.html">More information about this demo</a>.</p></div>
+
+    <p><button onclick="newOrder()">I want to say my order</button></p>
+
+    <div class="box">
+
+      <p id="ordertext"></p>
+      <p id="ordertextf"></p>
+      <p id="ordertextt"></p>
+
+      <p><object id="order" data="images/order.svg" width="700" height="200"></object></p>
+
+    </div>
+
+
+    <div class="box">
+      <form>
+	  <textarea id="in_abs" rows="4" cols="52"></textarea>
+      	  <textarea id="out_abs" rows="4" cols="52"></textarea>
+      </form>
+    </div>
+  
+    <!-- SVG "sprites" -->
+
+    <object id="pizza" data="images/pizza.svg" width="0" height="0"></object>
+    <object id="ham" data="images/ham.svg" width="0" height="0"></object>
+    <object id="cheese" data="images/cheese.svg" width="0" height="0"></object>
+    <object id="pepperoni" data="images/pepperoni.svg" width="0" height="0"></object>
+    <object id="anchovies" data="images/anchovies.svg" width="0" height="0"></object>
+    <object id="beer" data="images/beer.svg" width="0" height="0"></object>
+    <object id="coke" data="images/coke.svg" width="0" height="0"></object>
+
+  </body>
+</html>
--- a/devel/phrases/travel.xml
+++ b/devel/phrases/travel.xml
@@ -0,0 +1,73 @@
+<!DOCTYPE html PUBLIC "-//VoiceXML Forum//DTD XHTML+Voice 1.2//EN" "http://www.voicexml.org/specs/multimodal/x+v/12/dtd/xhtml+voice12.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"
+      xmlns:ev="http://www.w3.org/2001/xml-events"
+      xmlns:xv="http://www.voicexml.org/2002/xhtml+voice"
+      xmlns:vxml="http://www.w3.org/2001/vxml">
+
+  <head>
+    <title>Say Phrases in Thai</title>
+    <meta http-equiv="content-type" content="text/xml; charset=utf-8" />
+
+    <link href="style.css" rel="stylesheet" type="text/css"></link>
+
+    <script type="text/javascript" src="gflib.js"></script>
+    <script type="text/javascript" src="Travel.js"></script>
+    <script type="text/javascript" src="order.js"></script>
+    
+    <vxml:form id="talker">
+      <vxml:block>
+	<vxml:value expr="talkText"/>
+      </vxml:block>
+    </vxml:form>
+
+    <vxml:form id="getorder">
+      <vxml:var name="dummy" />
+      <vxml:subdialog name="sub" src="TravelEng.vxml#Order_cat">
+	<vxml:param name="old" expr="currentOrder" />
+	<vxml:filled>
+	  <vxml:assign name="dummy" expr="done(sub.term)"/>
+	</vxml:filled>
+      </vxml:subdialog>
+    </vxml:form>
+
+  </head>
+
+  <body>
+
+    <div><font size="+5">ภาษาไทยแปลว่าอะไร</font></div>
+
+    <div><p>This demo requires an XHTML+Voice browser. 
+	<a href="index.html">More information about this demo</a>.</p></div>
+
+    <p><button onclick="newOrder()">Push here to say a phrase</button></p>
+
+    <div class="box">
+
+      <p id="ordertext"></p>
+<font size="+3">
+      <p id="ordertextf"></p>
+      <p id="ordertextt"></p>
+</font>
+      <p><object id="order" data="images/order.svg" width="700" height="200"></object></p>
+
+    </div>
+
+
+    <div class="box">
+      <form>
+	  <textarea id="in_abs" rows="4" cols="52"></textarea>
+      </form>
+    </div>
+  
+    <!-- SVG "sprites" -->
+
+    <object id="pizza" data="images/pizza.svg" width="0" height="0"></object>
+    <object id="ham" data="images/ham.svg" width="0" height="0"></object>
+    <object id="cheese" data="images/cheese.svg" width="0" height="0"></object>
+    <object id="pepperoni" data="images/pepperoni.svg" width="0" height="0"></object>
+    <object id="anchovies" data="images/anchovies.svg" width="0" height="0"></object>
+    <object id="beer" data="images/beer.svg" width="0" height="0"></object>
+    <object id="coke" data="images/coke.svg" width="0" height="0"></object>
+
+  </body>
+</html>
--- a/src/GF/Text/Thai.hs
+++ b/src/GF/Text/Thai.hs
@@ -11,7 +11,9 @@

 -- AR 27/12/2006. Execute test2 to see the transliteration table.

-module GF.Text.Thai (mkThai,mkThaiWord,mkThaiPron,thaiFile,thaiPronFile) where
+module GF.Text.Thai (
+  mkThai,mkThaiWord,mkThaiPron,mkThaiFake,thaiFile,thaiPronFile,thaiFakeFile
+  ) where

 import qualified Data.Map as Map
 import Data.Char
@@ -26,6 +28,7 @@ import Debug.Trace
 mkThai :: String -> String
 mkThai = concat . map mkThaiWord . words
 mkThaiPron = unwords . map mkPronSyllable . words
+mkThaiFake = unwords . map (fakeEnglish . mkPronSyllable) . words


 type ThaiChar = Char
@@ -78,7 +81,7 @@ 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' -  " ++
+  "p3 m  y  r  -  l  -  w  s- s. s  h  l' O  h' -  " ++
  "a. a  a: a+ i  i: v  v: u  u: -  -  -  -  -  -  " ++
  "e  e' o: a% a& L  R  S  T1 T2 T3 T4 K  -  -  -  " ++
  "N0 N1 N2 N3 N4 N5 N6 N7 N8 N9 -  -  -  -  -  -  "
@@ -91,6 +94,42 @@ allThaiCodes = [0x0e00 .. 0x0e7f]
 -- heuristic pronunciation of codes
 ---------------------

+-- fake English for TTS, a la Teach Yourself Thai
+
+fakeEnglish :: String -> String
+fakeEnglish s = case s of
+  'a':'a':cs -> "ah"  ++ fakeEnglish cs
+  'a':'y':cs -> "ai"  ++ fakeEnglish cs
+  'a'    :cs -> "ah"  ++ fakeEnglish cs
+  'c':'h':cs -> "ch"  ++ fakeEnglish cs
+  'c'    :cs -> "j"   ++ fakeEnglish cs
+  'e':'e':cs -> "aih" ++ fakeEnglish cs
+  'g'    :cs -> "ng"  ++ fakeEnglish cs
+  'i':'i':cs -> "ee"  ++ fakeEnglish cs
+  'k':'h':cs -> "k"   ++ fakeEnglish cs
+  'k'    :cs -> "g"   ++ fakeEnglish cs
+  'O':'O':cs -> "or"  ++ fakeEnglish cs
+  'O'    :cs -> "or"  ++ fakeEnglish cs
+  'o':'o':cs -> "or"  ++ fakeEnglish cs
+  'p':'h':cs -> "p"   ++ fakeEnglish cs
+  'p'    :cs -> "b"   ++ fakeEnglish cs
+  't':'h':cs -> "t"   ++ fakeEnglish cs
+  't'    :cs -> "d"   ++ fakeEnglish cs
+  'u':'u':cs -> "oo"  ++ fakeEnglish cs
+  'u'    :cs -> "oo"  ++ fakeEnglish cs
+  'v':'v':cs -> "eu"  ++ fakeEnglish cs
+  'v'    :cs -> "eu"  ++ fakeEnglish cs
+  '\228':'\228':cs -> "air" ++ fakeEnglish cs
+  '\228'    :cs -> "a"   ++ fakeEnglish cs
+  '\246':'\246':cs -> "er"  ++ fakeEnglish cs
+  '\246'    :cs -> "er"  ++ fakeEnglish cs
+  c:cs | isTone c -> fakeEnglish cs
+  c:cs -> c : fakeEnglish cs
+  _ -> s
+ where
+   isTone = flip elem "'`^~"
+
+
 -- this works for one syllable

 mkPronSyllable s = case fst $ pronAndOrth s of
@@ -124,17 +163,17 @@ pronSyllable s =
    ([0x0e40],[0x0e35],_,[0x0e22],_,_) -> "ia" -- e-i:y
    ([0x0e40],[0x0e2d,0x0e35],_,_,_,_) -> "va" -- e-i:O
    ([0x0e40],[0x0e30,0x0e35],_,[0x0e22],_,_) -> "ia" -- e-i:ya.
-    ([0x0e40],[0x0e30,0x0e2d],_,_,_,_) -> "ö"  -- e-Oa.
+    ([0x0e40],[0x0e30,0x0e2d],_,_,_,_) -> "\246"  -- e-Oa.
    ([0x0e40],[0x0e30,0x0e32],_,_,_,_) -> "O"  -- e-a:a. -- open o 
-    ([0x0e40],[0x0e2d],_,_,_,_) -> "öö"        -- e-O
-    ([0x0e40],[0x0e34],_,_,_,_) -> "öö"        -- e-i
+    ([0x0e40],[0x0e2d],_,_,_,_) -> "\246\246"        -- e-O
+    ([0x0e40],[0x0e34],_,_,_,_) -> "\246\246"        -- e-i
    ([0x0e40],[0x0e30],_,_,_,_) -> "e"         -- e-a.
    ([0x0e40],[0x0e32],_,_,_,_) -> "aw"        -- e-a:
-    ([0x0e40],[],[],[0x0e22],_,_) -> "ööy"     -- e-y
+    ([0x0e40],[],[],[0x0e22],_,_) -> "\246\246y"     -- e-y
    ([0x0e40],[],[],_,True,_) -> "e"

-    ([0x0e41],[0x0e30],_,_,_,_) -> "ä"         -- ä-a.
-    ([0x0e41],[],[],_,True,_)   -> "ä"
+    ([0x0e41],[0x0e30],_,_,_,_) -> "\228"         -- ä-a.
+    ([0x0e41],[],[],_,True,_)   -> "\228"

    ([0x0e42],[0x0e30],_,_,_,_) -> "o"         -- o:-a.

@@ -245,6 +284,12 @@ thaiPronFile f mo = do
  let put = maybe putStr writeFile mo
  put $ encodeUTF8 $ thaiPronStrings s

+thaiFakeFile :: FilePath -> Maybe FilePath -> IO ()
+thaiFakeFile f mo = do
+  s <- readFile f
+  let put = maybe putStr writeFile mo
+  put $ encodeUTF8 $ (convStrings mkThaiFake) s
+
 finalThai c = maybe "" return (Map.lookup c thaiFinalMap)
 thaiFinalMap = Map.fromList $ zip allThaiCodes finals

@@ -303,7 +348,7 @@ pronThai s = case s of
    | p==':'      -> c:[c]
    | elem p "%&" -> c:"y"
    | p=='+'      -> c:"m"
-    | s == "e'"   -> "ää"
+    | s == "e'"   -> "\228\228"
    | otherwise   -> [c]
  "O"             -> "O"
  "e"             -> "ee"