tools/sapi_voice.vbs

   1 '***************************************************************************
   2 '             __________               __   ___.
   3 '   Open      \______   \ ____   ____ |  | _\_ |__   _______  ___
   4 '   Source     |       _//  _ \_/ ___\|  |/ /| __ \ /  _ \  \/  /
   5 '   Jukebox    |    |   (  <_> )  \___|    < | \_\ (  <_> > <  <
   6 '   Firmware   |____|_  /\____/ \___  >__|_ \|___  /\____/__/\_ \
   7 '                     \/            \/     \/    \/            \/
   8 ' $Id$
   9 '
  10 ' Copyright (C) 2007 Steve Bavin, Jens Arnold, Mesar Hameed
  11 '
  12 ' All files in this archive are subject to the GNU General Public License.
  13 ' See the file COPYING in the source tree root for full license agreement.
  14 '
  15 ' This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
  16 ' KIND, either express or implied.
  17 '
  18 '***************************************************************************
  19
  20 Option Explicit
  21
  22 Const SSFMCreateForWrite = 3
  23
  24 ' Audio formats for SAPI5 filestream object
  25 Const SPSF_8kHz16BitMono  = 6
  26 Const SPSF_11kHz16BitMono = 10
  27 Const SPSF_12kHz16BitMono = 14
  28 Const SPSF_16kHz16BitMono = 18
  29 Const SPSF_22kHz16BitMono = 22
  30 Const SPSF_24kHz16BitMono = 26
  31 Const SPSF_32kHz16BitMono = 30
  32 Const SPSF_44kHz16BitMono = 34
  33 Const SPSF_48kHz16BitMono = 38
  34
  35 Dim oShell, oArgs, oEnv
  36 Dim bVerbose, bSAPI4, bList
  37 Dim sLanguage, sVoice, sSpeed
  38
  39 Dim oSpVoice, oSpFS ' SAPI5 voice and filestream
  40 Dim oTTS, nMode ' SAPI4 TTS object, mode selector
  41 Dim oVoice ' for traversing the list of voices
  42 Dim nLangID, sSelectString
  43
  44 Dim aLine, aData    ' used in command reading
  45
  46 On Error Resume Next
  47
  48 Set oShell = CreateObject("WScript.Shell")
  49 Set oEnv = oShell.Environment("Process")
  50 bVerbose = (oEnv("V") <> "")
  51
  52 Set oArgs = WScript.Arguments.Named
  53 bSAPI4 = oArgs.Exists("sapi4")
  54 bList = oArgs.Exists("listvoices")
  55 sLanguage = oArgs.Item("language")
  56 sVoice = oArgs.Item("voice")
  57 sSpeed = oArgs.Item("speed")
  58
  59
  60 If bSAPI4 Then
  61     ' Create SAPI4 ActiveVoice object
  62     Set oTTS = WScript.CreateObject("ActiveVoice.ActiveVoice", "TTS_")
  63     If Err.Number <> 0 Then
  64         Err.Clear
  65         Set oTTS = WScript.CreateObject("ActiveVoice.ActiveVoice.1", "TTS_")
  66         If Err.Number <> 0 Then
  67             WScript.StdErr.WriteLine "Error - could not get ActiveVoice" _
  68                                      & " object. SAPI 4 not installed?"
  69             WScript.Quit 1
  70         End If
  71     End If
  72     oTTS.Initialized = 1
  73
  74     If bList Then
  75         ' Just list available voices for the selected language
  76         For Each nLangID in LangIDs(sLanguage)
  77             For nMode = 1 To oTTS.CountEngines
  78                 If oTTS.LanguageID(nMode) = nLangID Then
  79                     WScript.StdErr.Write oTTS.ModeName(nMode) & ","
  80                 End If
  81             Next
  82         Next
  83         WScript.StdErr.WriteLine
  84         WScript.Quit 0
  85     End If
  86
  87     ' Select matching voice
  88     For Each nLangID in LangIDs(sLanguage)
  89         sSelectString = "LanguageID=" & nLangID
  90         If sVoice <> "" Then
  91             sSelectString = sSelectString & ";Speaker=" & sVoice _
  92                             & ";ModeName=" & sVoice
  93         End If
  94         nMode = oTTS.Find(sSelectString)
  95         If oTTS.LanguageID(nMode) = nLangID And (sVoice = "" Or _
  96            oTTS.Speaker(nMode) = sVoice Or oTTS.ModeName(nMode) = sVoice) Then
  97             If bVerbose Then WScript.StdErr.WriteLine "Using " & sSelectString
  98             Exit For
  99         Else
 100             sSelectString = ""
 101         End If
 102     Next
 103     If sSelectString = "" Then
 104         WScript.StdErr.WriteLine "Error - found no matching voice for " _
 105                                  & sLanguage & ", " & sVoice
 106         WScript.Quit 1
 107     End If
 108     oTTS.Select nMode
 109
 110     ' Speed selection
 111     If sSpeed <> "" Then oTTS.Speed = sSpeed
 112 Else ' SAPI5
 113     ' Create SAPI5 object
 114     Set oSpVoice = CreateObject("SAPI.SpVoice")
 115     If Err.Number <> 0 Then
 116         WScript.StdErr.WriteLine "Error - could not get SpVoice object." _
 117                                  & " SAPI 5 not installed?"
 118         WScript.Quit 1
 119     End If
 120
 121     If bList Then
 122         ' Just list available voices for the selected language
 123         For Each nLangID in LangIDs(sLanguage)
 124             sSelectString = "Language=" & Hex(nLangID)
 125             For Each oVoice in oSpVoice.GetVoices(sSelectString)
 126                 WScript.StdErr.Write oVoice.GetAttribute("Name") & ","
 127             Next
 128         Next
 129         WScript.StdErr.WriteLine
 130         WScript.Quit 0
 131     End If
 132
 133     ' Select matching voice
 134     For Each nLangID in LangIDs(sLanguage)
 135         sSelectString = "Language=" & Hex(nLangID)
 136         If sVoice <> "" Then
 137             sSelectString = sSelectString & ";Name=" & sVoice
 138         End If
 139         Set oSpVoice.Voice = oSpVoice.GetVoices(sSelectString).Item(0)
 140         If Err.Number = 0 Then
 141             If bVerbose Then WScript.StdErr.WriteLine "Using " & sSelectString
 142             Exit For
 143         Else
 144             sSelectString = ""
 145             Err.Clear
 146         End If
 147     Next
 148     If sSelectString = "" Then
 149         WScript.StdErr.WriteLine "Error - found no matching voice for " _
 150                                  & sLanguage & ", " & sVoice
 151         WScript.Quit 1
 152     End If
 153
 154     ' Speed selection
 155     If sSpeed <> "" Then oSpVoice.Rate = sSpeed
 156
 157     ' Filestream object for output
 158     Set oSpFS = CreateObject("SAPI.SpFileStream")
 159     oSpFS.Format.Type = AudioFormat(oSpVoice.Voice.GetAttribute("Vendor"))
 160 End If
 161
 162 Do
 163     aLine = Split(WScript.StdIn.ReadLine, vbTab, 2)
 164     If Err.Number <> 0 Then
 165         WScript.StdErr.WriteLine "Error " & Err.Number & ": " & Err.Description
 166         WScript.Quit 1
 167     End If
 168     Select Case aLine(0) ' command
 169         Case "QUERY"
 170             Select Case aLine(1)
 171                 Case "VENDOR"
 172                     If bSAPI4 Then
 173                         WScript.StdOut.WriteLine oTTS.MfgName(nMode)
 174                     Else
 175                         WScript.StdOut.WriteLine oSpVoice.Voice.GetAttribute("Vendor")
 176                     End If
 177             End Select
 178         Case "SPEAK"
 179             aData = Split(aLine(1), vbTab, 2)
 180             aData(1) = UTF8decode(aData(1))
 181             If bVerbose Then WScript.StdErr.WriteLine "Saying " & aData(1) _
 182                                                       & " in " & aData(0)
 183             If bSAPI4 Then
 184                 oTTS.FileName = aData(0)
 185                 oTTS.Speak aData(1)
 186                 While oTTS.Speaking
 187                     WScript.Sleep 1
 188                 Wend
 189                 oTTS.FileName = ""
 190             Else
 191                 oSpFS.Open aData(0), SSFMCreateForWrite, false
 192                 Set oSpVoice.AudioOutputStream = oSpFS
 193                 oSpVoice.Speak aData(1)
 194                 oSpFS.Close
 195             End If
 196         Case "EXEC"
 197             If bVerbose Then WScript.StdErr.WriteLine "> " & aLine(1)
 198             oShell.Run aLine(1), 0, true
 199             If Err.Number <> 0 Then
 200                 If Not bVerbose Then
 201                     WScript.StdErr.Write "> " & aLine(1) & ": "
 202                 End If
 203                 If Err.Number = &H80070002 Then ' Actually file not found
 204                     WScript.StdErr.WriteLine "command not found"
 205                 Else
 206                     WScript.StdErr.WriteLine "error " & Err.Number & ":" _
 207                                              & Err.Description
 208                 End If
 209                 WScript.Quit 2
 210             End If
 211         Case "SYNC"
 212             If bVerbose Then WScript.StdErr.WriteLine "Syncing"
 213             WScript.StdOut.WriteLine aLine(1) ' Just echo what was passed
 214         Case "QUIT"
 215             If bVerbose Then WScript.StdErr.WriteLine "Quitting"
 216             WScript.Quit 0
 217     End Select
 218 Loop
 219
 220 ' Subroutines
 221 ' -----------
 222
 223 ' Decode an UTF-8 string into a standard windows unicode string (UTF-16)
 224 Function UTF8decode(ByRef sText)
 225     Dim i, c, nCode, nTail, nTextLen
 226
 227     UTF8decode = ""
 228     nTail = 0
 229     nTextLen = Len(sText)
 230     i = 1
 231     While i <= nTextLen
 232         c = Asc(Mid(sText, i, 1))
 233         i = i + 1
 234         If c <= &h7F Or c >= &hC2 Then ' Start of new character
 235             If c < &h80 Then     ' U-00000000 - U-0000007F, 1 byte
 236                 nCode = c
 237             ElseIf c < &hE0 Then ' U-00000080 - U-000007FF, 2 bytes
 238                 nTail = 1
 239                 nCode = c And &h1F
 240             ElseIf c < &hF0 Then ' U-00000800 - U-0000FFFF, 3 bytes
 241                 nTail = 2
 242                 nCode = c And &h0F
 243             ElseIf c < &hF5 Then ' U-00010000 - U-001FFFFF, 4 bytes
 244                 nTail = 3
 245                 nCode = c And 7
 246             Else                 ' Invalid size
 247                 nCode = &hFFFD
 248             End If
 249
 250             While nTail > 0 And i <= nTextLen
 251                 nTail = nTail - 1
 252                 c = Asc(Mid(sText, i, 1))
 253                 i = i + 1
 254                 If (c And &hC0) = &h80 Then ' Valid continuation char
 255                     nCode = nCode * &h40 + (c And &h3F)
 256                 Else                        ' Invalid continuation char
 257                     nCode = &hFFFD
 258                     i = i - 1
 259                     nTail = 0
 260                 End If
 261             Wend
 262
 263         Else
 264             nCode = &hFFFD
 265         End If
 266         If nCode >= &h10000 Then ' Character outside BMP - use surrogate pair
 267             nCode = nCode - &h10000
 268             c = &hD800 + ((nCode \ &h400) And &h3FF) ' high surrogate
 269             UTF8decode = UTF8decode & ChrW(c)
 270             nCode = &hDC00 + (nCode And &h3FF)       ' low surrogate
 271         End If
 272         UTF8decode = UTF8decode & ChrW(nCode)
 273     Wend
 274 End Function
 275
 276 ' SAPI5 output format selection based on engine
 277 Function AudioFormat(ByRef sVendor)
 278     Select Case sVendor
 279         Case "Microsoft"
 280             AudioFormat = SPSF_22kHz16BitMono
 281         Case "AT&T Labs"
 282             AudioFormat = SPSF_32kHz16BitMono
 283         Case "Loquendo"
 284             AudioFormat = SPSF_16kHz16BitMono
 285         Case "ScanSoft, Inc"
 286             AudioFormat = SPSF_22kHz16BitMono
 287         Case "Voiceware"
 288             AudioFormat = SPSF_16kHz16BitMono
 289         Case Else
 290             AudioFormat = SPSF_22kHz16BitMono
 291             WScript.StdOut.WriteLine "Warning - unknown vendor """ & sVendor _
 292                                      & """ - using default wave format"
 293     End Select
 294 End Function
 295
 296 ' Language mapping rockbox->windows
 297 Function LangIDs(ByRef sLanguage)
 298     Dim aIDs
 299
 300     Select Case sLanguage
 301         Case "afrikaans"
 302             LangIDs = Array(&h436)
 303         Case "bulgarian"
 304             LangIDs = Array(&h402)
 305         Case "catala"
 306             LangIDs = Array(&h403)
 307         Case "chinese-simp"
 308             LangIDs = Array(&h804) ' PRC
 309         Case "chinese-trad"
 310             LangIDs = Array(&h404) ' Taiwan. Perhaps also Hong Kong, Singapore, Macau?
 311         Case "czech"
 312             LangIDs = Array(&h405)
 313         Case "dansk"
 314             LangIDs = Array(&h406)
 315         Case "deutsch"
 316             LangIDs = Array(&h407, &hc07, &h1007, &h1407)
 317             ' Standard, Austrian, Luxembourg, Liechtenstein (Swiss -> wallisertitsch)
 318         Case "eesti"
 319             LangIDs = Array(&h425)
 320         Case "english"
 321             LangIDs = Array( &h809,  &h409,  &hc09, &h1009, &h1409, &h1809, _
 322                             &h1c09, &h2009, &h2409, &h2809, &h2c09, &h3009, _
 323                             &h3409)
 324             ' Britsh, American, Australian, Canadian, New Zealand, Ireland,
 325             ' South Africa, Jamaika, Caribbean, Belize, Trinidad, Zimbabwe,
 326             ' Philippines
 327         Case "espanol"
 328             LangIDs = Array( &h40a,  &hc0a,  &h80a, &h100a, &h140a, &h180a, _
 329                             &h1c0a, &h200a, &h240a, &h280a, &h2c0a, &h300a, _
 330                             &h340a, &h380a, &h3c0a, &h400a, &h440a, &h480a, _
 331                             &h4c0a, &h500a)
 332             ' trad. sort., mordern sort., Mexican, Guatemala, Costa Rica,
 333             ' Panama, Dominican Republic, Venezuela, Colombia, Peru, Argentina,
 334             ' Ecuador, Chile, Uruguay, Paraguay, Bolivia, El Salvador,
 335             ' Honduras, Nicaragua, Puerto Rico
 336         Case "esperanto"
 337             WScript.StdErr.WriteLine "Error: no esperanto support in Windows"
 338             WScript.Quit 1
 339         Case "finnish"
 340             LangIDs = Array(&h40b)
 341         Case "francais"
 342             LangIDs = Array(&h40c, &h80c, &hc0c, &h100c, &h140c, &h180c)
 343             ' Standard, Belgian, Canadian, Swiss, Luxembourg, Monaco
 344         Case "galego"
 345             LangIDs = Array(&h456)
 346         Case "greek"
 347             LangIDs = Array(&h408)
 348         Case "hebrew"
 349             LangIDs = Array(&h40d)
 350         Case "hindi"
 351             LangIDs = Array(&h439)
 352         Case "islenska"
 353             LangIDs = Array(&h40f)
 354         Case "italiano"
 355             LangIDs = Array(&h410, &h810) ' Standard, Swiss
 356         Case "japanese"
 357             LangIDs = Array(&h411)
 358         Case "korean"
 359             LangIDs = Array(&h412)
 360         Case "magyar"
 361             LangIDs = Array(&h40e)
 362         Case "nederlands"
 363             LangIDs = Array(&h413, &h813) ' Standard, Belgian
 364         Case "norsk"
 365             LangIDs = Array(&h414) ' Bokmal
 366         Case "norsk-nynorsk"
 367             LangIDs = Array(&h814)
 368         Case "polski"
 369             LangIDs = Array(&h415)
 370         Case "portugues"
 371             LangIDs = Array(&h816)
 372         Case "portugues-brasileiro"
 373             LangIDs = Array(&h416)
 374         Case "romaneste"
 375             LangIDs = Array(&h418)
 376         Case "russian"
 377             LangIDs = Array(&h419)
 378         Case "slovenscina"
 379             LangIDs = Array(&h424)
 380         Case "srpski"
 381             LangIDs = Array(&hc1a) ' Cyrillic
 382         Case "svenska"
 383             LangIDs = Array(&h41d, &h81d) ' Standard, Finland
 384         Case "tagalog"
 385             LangIDs = Array(&h464) ' Filipino, might not be 100% correct
 386         Case "thai"
 387             LangIDs = Array(&h41e)
 388         Case "turkce"
 389             LangIDs = Array(&h41f)
 390         Case "wallisertitsch"
 391             LangIDs = Array(&h807) ' Swiss German
 392     End Select
 393 End Function
 394
 395