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