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