60 Or Less Pasted Sentences At-Once Text To Speech Reader

[SierraKen]

Using B+'s and Steve's text-to-speech code, I added it with Steve's text pasting code and now we got a text-to-speech reader that reads almost any text that you can paste. There is a 60 sentence, or so, limit, because I didn't want people to accidentally copy a whole book and have it read all at once. There really isn't a way to stop the speech either because it uses Windows Power Shell, besides turning your computer off. This is probably a Windows-only app. I tested it with about 58 sentences from the Bible and it worked fine. I did run into a small problem that I fixed, which was that it stopped working altogether when it saw a quotation mark. So before it runs, I have it scan all of the text and delete anything before or after the text and number ASCII code numbers. Between the numbers and text there's a couple of punctuation marks and a few I added like the question mark, period, and comma, and a couple others. I haven't tried every possibility but it should work OK. Feel free to play around with it. Thank you to B+ and Steve (SMCNeil) for their very hard work. Hopefully people can make use of this app. Have fun!

Code: QB64: [Select]

1. 'Thanks to B+ for the audio code and Steve (SMCNeil) for the paste code!
2. _ControlChr Off
3. _Title "Text Reader"
4. Screen _NewImage(800, 600, 32)
5. start:
6. Print "CTRL-V to paste text and then press Enter to read through your speakers (Around a 60 sentence limit at a time.): "
7. ExtendedInput information$
8. Print
9. Dim t(3000) As String
10. For x = 1 To Len(information$)
11.     If Asc(Mid$(information$, x, x)) < 40 Or Asc(Mid$(information$, x, x)) > 122 Then Mid$(information$, x, x) = " "
12. Next x
13. t(i) = information$
14. If Len(information$) > 10000 Then Print: Print "Too much text to read at once. Try again with less.": GoTo start:
15. Print
16. Print t(i)
17. speak t(i)
18. Print: Print
19. Print "Again (Y/N)";
20. Do
21.     ag$ = InKey$
22.     If ag$ = "Y" Or ag$ = "y" Then Cls: GoTo start:
23.     If ag$ = "N" Or ag$ = "n" Then End
24. Loop
25.  
26. Sub speak (message As String)
27.     Shell _Hide "Powershell -Command " + Chr$(34) + "Add-Type -AssemblyName System.Speech; (New-Object System.Speech.Synthesis.SpeechSynthesizer).Speak('" + message + "');" + Chr$(34)
28. End Sub
29.  
30. Sub ExtendedInput (out$)
31.     PCopy 0, 1
32.     A = _AutoDisplay: X = Pos(0): Y = CsrLin
33.     CP = 0: OldCP = 0 'Cursor Position
34.     _KeyClear
35.     Do
36.         PCopy 1, 0
37.         If _KeyDown(100307) Or _KeyDown(100308) Then AltDown = -1 Else AltDown = 0
38.         k = _KeyHit
39.         If AltDown Then
40.             Select Case k 'ignore all keypresses except ALT-number presses
41.                 Case 48 TO 57: AltWasDown = -1: alt$ = alt$ + Chr$(k)
42.             End Select
43.         Else
44.             Select Case k 'without alt, add any keypresses to our input
45.                 Case 8
46.                     oldin$ = in$
47.                     If CP > 0 Then OldCP = CP: CP = CP - 1
48.                     in$ = Left$(in$, CP) + Mid$(in$, CP + 2) 'backspace to erase input
49.                 Case 9
50.                     oldin$ = in$
51.                     in$ = Left$(in$, CP) + Space$(4) + Mid$(in$, CP + 1) 'four spaces for any TAB entered
52.                     OldCP = CP
53.                     CP = CP + 4
54.                 Case 32 TO 128
55.                     If _KeyDown(100305) Or _KeyDown(100306) Then
56.                         If k = 118 Or k = 86 Then
57.                             oldin$ = in$
58.                             in$ = Left$(in$, CP) + _Clipboard$ + Mid$(in$, CP + 1) 'ctrl-v paste
59.                             'CTRL-V leaves cursor in position before the paste, without moving it after.
60.                             'Feel free to modify that behavior here, if you want it to move to after the paste.
61.                             'CP = CP + LEN(_CLIPBOARD$)
62.                         End If
63.                         If k = 122 Or k = 90 Then Swap in$, oldin$: Swap OldCP, CP 'ctrl-z undo
64.                     Else
65.                         oldin$ = in$
66.                         in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
67.                         OldCP = CP
68.                         CP = CP + 1
69.                     End If
70.                 Case 18176 'Home
71.                     CP = 0
72.                 Case 20224 'End
73.                     CP = Len(in$)
74.                 Case 21248 'Delete
75.                     oldin$ = in$
76.                     in$ = Left$(in$, CP) + Mid$(in$, CP + 2)
77.                 Case 19200 'Left
78.                     CP = CP - 1
79.                     If CP < 0 Then CP = 0
80.                 Case 19712 'Right
81.                     CP = CP + 1
82.                     If CP > Len(in$) Then CP = Len(in$)
83.             End Select
84.         End If
85.         alt$ = Right$(alt$, 3)
86.         If AltWasDown = -1 And AltDown = 0 Then
87.             v = Val(alt$)
88.             If v >= 0 And v <= 255 Then in$ = in$ + Chr$(v)
89.             alt$ = "": AltWasDown = 0
90.         End If
91.         blink = (blink + 1) Mod 30
92.         Locate Y, X
93.         Print Left$(in$, CP);
94.         If blink \ 15 Then Print " "; Else Print "_";
95.         Print Mid$(in$, CP + 1)
96.  
97.         _Display
98.         _Limit 30
99.     Loop Until k = 13
100.  
101.     PCopy 1, 0
102.     Locate Y, X: Print in$
103.     out$ = in$
104.     If A Then _AutoDisplay
105. End Sub
106.  
107.  

[SierraKen]

By the way, I just guessed on the DIM. I don't know if I needed so much of the 3000, but I figured the memory needed to come from somewhere. Since I don't know the SUBs, I wouldn't know what they mean though. So I just guessed. It might just need 100 for all I know.

[SMcNeill]

I'm fairy certain that you can pause or stop the text to speech engine anytime you want, without having to turn the power off.  It's just a call to System.Speech.Synthesis.Stop (Pause), if I remember correctly.

[bplus]

Hey @SierraKen

That is a great combo of Steve's code helpers.

I think Steve made his code filter out the quotes you mentioned Plus you can use different voices, so hey maybe take a script for a play, modify it to call different voices including a narrator to fill in the scenes with words. see this: https://qb64forum.alephc.xyz/index.php?topic=4598.msg140073#msg140073

That would also keep speeches shorter and the user could press escape in between lines if they want to quit.

[SierraKen]

I tried for 2 hours last night to add the Stop and Pause codes but nothing seemed to work. So I either have the codes wrong or doing something wrong. I deleted what I made but what I tried was making a separate SUB for the close code and putting the command to the SUB right after the command to play the audio. It seemed like it just wouldn't get to that other SUB command. Just now I tried a different way with still no luck. It seems like the way BASIC goes from one thing to another, it doesn't flow away from the audio text when it plays, it stays there until it's done. Unless I have the wrong code. I looked online for codes last night but couldn't really find anything besides C language stuff in which I am not familiar with. Can anyone give me any ideas? Feel free to fix this also if you have the time and want to. Thanks. 

Code: QB64: [Select]

1. 'Thanks to B+ for the audio code and Steve (SMCNeill) for the paste code!
2. _ControlChr Off
3. _Title "Text Reader"
4. Screen _NewImage(800, 600, 32)
5. start:
6. Print "CTRL-V to paste text and then press Enter to read through your speakers (Around a 60 sentence limit at a time.): "
7. ExtendedInput information$
8. Print
9. Dim t(3000) As String
10. For x = 1 To Len(information$)
11.     If Asc(Mid$(information$, x, x)) < 40 Or Asc(Mid$(information$, x, x)) > 122 Then Mid$(information$, x, x) = " "
12. Next x
13. t(i) = information$
14. ll = Len(information$)
15. If ll > 10000 Then Print: Print "Too much text to read at once. Try again with less.": GoTo start:
16. Print
17. Print t(i)
18.  
19. speak t(i)
20. Do
21.     a$ = InKey$
22.     If a$ <> "" Then closing t(i)
23.     Locate 1, 1
24.     Print "TEST"
25. Loop While a$ <> ""
26.  
27. again:
28. Print: Print
29. Print "Again (Y/N)";
30. Do
31.     ag$ = InKey$
32.     If ag$ = "Y" Or ag$ = "y" Then Cls: GoTo start:
33.     If ag$ = "N" Or ag$ = "n" Then End
34. Loop
35.  
36. Sub speak (message As String)
37.     Shell _Hide "Powershell -Command " + Chr$(34) + "Add-Type -AssemblyName System.Speech; (New-Object System.Speech.Synthesis.SpeechSynthesizer).Speak('" + message + "');" + Chr$(34)
38. End Sub
39.  
40. Sub closing (message As String)
41.     Locate 1, 1: Print "12345"
42.     Shell _Hide "Powershell -Command " + Chr$(34) + "Add-Type -AssemblyName System.Speech; (New-Object System.Speech.Synthesis.Stop)('" + message + "');" + Chr$(34)
43. End Sub
44.  
45. Sub ExtendedInput (out$)
46.     PCopy 0, 1
47.     A = _AutoDisplay: X = Pos(0): Y = CsrLin
48.     CP = 0: OldCP = 0 'Cursor Position
49.     _KeyClear
50.     Do
51.         PCopy 1, 0
52.         If _KeyDown(100307) Or _KeyDown(100308) Then AltDown = -1 Else AltDown = 0
53.         k = _KeyHit
54.         If AltDown Then
55.             Select Case k 'ignore all keypresses except ALT-number presses
56.                 Case 48 TO 57: AltWasDown = -1: alt$ = alt$ + Chr$(k)
57.             End Select
58.         Else
59.             Select Case k 'without alt, add any keypresses to our input
60.                 Case 8
61.                     oldin$ = in$
62.                     If CP > 0 Then OldCP = CP: CP = CP - 1
63.                     in$ = Left$(in$, CP) + Mid$(in$, CP + 2) 'backspace to erase input
64.                 Case 9
65.                     oldin$ = in$
66.                     in$ = Left$(in$, CP) + Space$(4) + Mid$(in$, CP + 1) 'four spaces for any TAB entered
67.                     OldCP = CP
68.                     CP = CP + 4
69.                 Case 32 TO 128
70.                     If _KeyDown(100305) Or _KeyDown(100306) Then
71.                         If k = 118 Or k = 86 Then
72.                             oldin$ = in$
73.                             in$ = Left$(in$, CP) + _Clipboard$ + Mid$(in$, CP + 1) 'ctrl-v paste
74.                             'CTRL-V leaves cursor in position before the paste, without moving it after.
75.                             'Feel free to modify that behavior here, if you want it to move to after the paste.
76.                             'CP = CP + LEN(_CLIPBOARD$)
77.                         End If
78.                         If k = 122 Or k = 90 Then Swap in$, oldin$: Swap OldCP, CP 'ctrl-z undo
79.                     Else
80.                         oldin$ = in$
81.                         in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
82.                         OldCP = CP
83.                         CP = CP + 1
84.                     End If
85.                 Case 18176 'Home
86.                     CP = 0
87.                 Case 20224 'End
88.                     CP = Len(in$)
89.                 Case 21248 'Delete
90.                     oldin$ = in$
91.                     in$ = Left$(in$, CP) + Mid$(in$, CP + 2)
92.                 Case 19200 'Left
93.                     CP = CP - 1
94.                     If CP < 0 Then CP = 0
95.                 Case 19712 'Right
96.                     CP = CP + 1
97.                     If CP > Len(in$) Then CP = Len(in$)
98.             End Select
99.         End If
100.         alt$ = Right$(alt$, 3)
101.         If AltWasDown = -1 And AltDown = 0 Then
102.             v = Val(alt$)
103.             If v >= 0 And v <= 255 Then in$ = in$ + Chr$(v)
104.             alt$ = "": AltWasDown = 0
105.         End If
106.         blink = (blink + 1) Mod 30
107.         Locate Y, X
108.         Print Left$(in$, CP);
109.         If blink \ 15 Then Print " "; Else Print "_";
110.         Print Mid$(in$, CP + 1)
111.  
112.         _Display
113.         _Limit 30
114.     Loop Until k = 13
115.  
116.     PCopy 1, 0
117.     Locate Y, X: Print in$
118.     out$ = in$
119.     If A Then _AutoDisplay
120. End Sub
121.  
122.  

[SMcNeill]

First thing you'd have to change is the SHELL _HIDE statements.  As they exist, program execution waits until the SHELL call is completed before moving on.

You'd need a SHELL _DONTWAIT to let execution run in the background and not stop program flow.

Second thing you'd probably want is to swap your powershell routine to assign a return variable to store the handle of your sound process.  From just the line reading "New Object System.Speech...." to "$VariableName = New Object System.Speech....".  Reference everything via that variable from that point on.  (See my latest version for an example.)

Now that you have a variable to hold the process, and you're no lnger waiting for your SHELL call to terminate before continuing program execution, you should be able to SHELL _DONTWAIT and:

$VariableName.Pause

and

$VariableName.Resume

[bplus]

Well I overhauled the code to see what kind of line delimiter was used for lines / sentences.

Knowing this I split the glob of text into lines and read each line individually, and then looked to see if user pressed escape to quit the reading, still might get an extra line read but not the whole long blurb.

I have commented most of crucial steps to say what I was doing and I used Steve's Speak version that already had characters removed and easy enough to add to the remove$ string new ones you find.

Code: QB64: [Select]

1. Option _Explicit ' no typos please!
2.  
3. ' b+ modification of Ken code, replace with Steve's Speak sub because Steve's Speak sub removes stumbling characters.
4.  
5. _Title "Text Reader"
6. Screen _NewImage(800, 600, 32)
7.  
8. Dim information$, nl$, sentence$, again$   ' nl$ is common variable name for Next Line signal with Control Char.
9. Dim As Long textIndex, nSentences
10.  
11. start:
12. Print "CTRL-V to paste text and then press Enter to read through your speakers: "
13. ExtendedInput information$
14.  
15.  
16. ' Kem here we figure out what separtes lines in big copy/paste to input 3 choices
17. ' now figure out if information has line delimiters either Chr$(10) or Chr$(13) or both?
18. If InStr(information$, Chr$(10)) Then nl$ = Chr$(10) ' lines from typical WP
19. If InStr(information$, Chr$(13)) Then nl$ = Chr$(13) ' rarer
20. If InStr(information$, Chr$(13) + Chr$(10)) Then nl$ = Chr$(13) + Chr$(10) ' lines from bas source
21.  
22. ' test with copy of first 2 lines here! nl$ = Chr$(13) + Chr$(10 for Basic IDE
23. 'Print Len(nl$), Asc(nl$, 1)
24. 'End
25.  
26. ' Ken now we know how to split that massive input into single lines
27. ReDim text(1 To 1) As String ' set up dynamice array with REDIM instead on DIM
28.  
29. 'now we can split out all the lines in info to single lines
30. Split information$, nl$, text() ' splits to an array of text strings, single sentences usually
31.  
32. ' Now that we have out sentences, we will read them one at a time until we finish or the user says Enough!
33. ' How many sentences do we have?
34. nSentences = UBound(text)
35.  
36. ' going through the sentences, press escape to exit th eread
37. For textIndex = 1 To nSentences
38.     sentence$ = text(textIndex)
39.     speak sentence$, 0, 1
40.     If _KeyHit = 27 Then Exit For ' if user pressed the escape key then bug out
41. Next
42.  
43. 'go again?
44. _KeyClear ' for some reason regualar input is not working????
45. Input "Would you like to do another reading, y for yes "; again$
46. If again$ = "y" Then GoTo start
47.  
48.  
49.  
50. Sub speak (text As String, Speaker As Integer, Speed)
51.     Dim message As String, remove$, out$
52.     Dim As Long i, j
53.     message = text
54.     'some symbols and such can't be used with Powershell like this, as they're command symbols
55.     'we need to strip them out of our text.  (Like apostrophes!)
56.     remove$ = "'" + Chr$(34) 'add to remove$ here, if more symbols need to be removed as future testing showcases problems
57.     For j = 1 To Len(remove$)
58.         Do
59.             i = InStr(message, Mid$(remove$, j, 1))
60.             If i Then message = Left$(message, i - 1) + Mid$(message, i + 1)
61.         Loop Until i = 0
62.     Next
63.     out$ = "Powershell -Command " + Chr$(34)
64.     out$ = out$ + "Add-Type -AssemblyName System.Speech; "
65.     out$ = out$ + "$Speech = New-Object System.Speech.Synthesis.SpeechSynthesizer; "
66.     If Speaker = 0 Then out$ = out$ + "$Speech.SelectVoice('Microsoft David Desktop'); "
67.     If Speaker = 1 Then out$ = out$ + "$Speech.SelectVoice('Microsoft Zira Desktop'); "
68.     If Speed Then out$ = out$ + "$Speech.Rate =" + Str$(Speed) + "; "
69.     out$ = out$ + "$Speech.Speak('" + message + "');" + Chr$(34)
70.     Shell _Hide out$
71. End Sub
72.  
73. Sub ExtendedInput (out$)
74.     Dim alt$, oldIn$, in$
75.     Dim As Long A, X, Y, CP, OldCP, AltDown, k, AltWasDown, v, blink
76.     PCopy 0, 1
77.     A = _AutoDisplay: X = Pos(0): Y = CsrLin
78.     CP = 0: OldCP = 0 'Cursor Position
79.     _KeyClear
80.     Do
81.         PCopy 1, 0
82.         If _KeyDown(100307) Or _KeyDown(100308) Then AltDown = -1 Else AltDown = 0
83.         k = _KeyHit
84.         If AltDown Then
85.             Select Case k 'ignore all keypresses except ALT-number presses
86.                 Case 48 TO 57: AltWasDown = -1: alt$ = alt$ + Chr$(k)
87.             End Select
88.         Else
89.             Select Case k 'without alt, add any keypresses to our input
90.                 Case 8
91.                     oldIn$ = in$
92.                     If CP > 0 Then OldCP = CP: CP = CP - 1
93.                     in$ = Left$(in$, CP) + Mid$(in$, CP + 2) 'backspace to erase input
94.                 Case 9
95.                     oldIn$ = in$
96.                     in$ = Left$(in$, CP) + Space$(4) + Mid$(in$, CP + 1) 'four spaces for any TAB entered
97.                     OldCP = CP
98.                     CP = CP + 4
99.                 Case 32 TO 128
100.                     If _KeyDown(100305) Or _KeyDown(100306) Then
101.                         If k = 118 Or k = 86 Then
102.                             oldIn$ = in$
103.                             in$ = Left$(in$, CP) + _Clipboard$ + Mid$(in$, CP + 1) 'ctrl-v paste
104.                             'CTRL-V leaves cursor in position before the paste, without moving it after.
105.                             'Feel free to modify that behavior here, if you want it to move to after the paste.
106.                             'CP = CP + LEN(_CLIPBOARD$)
107.                         End If
108.                         If k = 122 Or k = 90 Then Swap in$, oldIn$: Swap OldCP, CP 'ctrl-z undo
109.                     Else
110.                         oldIn$ = in$
111.                         in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
112.                         OldCP = CP
113.                         CP = CP + 1
114.                     End If
115.                 Case 18176 'Home
116.                     CP = 0
117.                 Case 20224 'End
118.                     CP = Len(in$)
119.                 Case 21248 'Delete
120.                     oldIn$ = in$
121.                     in$ = Left$(in$, CP) + Mid$(in$, CP + 2)
122.                 Case 19200 'Left
123.                     CP = CP - 1
124.                     If CP < 0 Then CP = 0
125.                 Case 19712 'Right
126.                     CP = CP + 1
127.                     If CP > Len(in$) Then CP = Len(in$)
128.             End Select
129.         End If
130.         alt$ = Right$(alt$, 3)
131.         If AltWasDown = -1 And AltDown = 0 Then
132.             v = Val(alt$)
133.             If v >= 0 And v <= 255 Then in$ = in$ + Chr$(v)
134.             alt$ = "": AltWasDown = 0
135.         End If
136.         blink = (blink + 1) Mod 30
137.         Locate Y, X
138.         Print Left$(in$, CP);
139.         If blink \ 15 Then Print " "; Else Print "_";
140.         Print Mid$(in$, CP + 1)
141.  
142.         _Display
143.         _Limit 30
144.     Loop Until k = 13
145.  
146.     PCopy 1, 0
147.     Locate Y, X: Print in$
148.     out$ = in$
149.     If A Then _AutoDisplay
150. End Sub
151.  
152. Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
153.     Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
154.     curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
155.     dpos = InStr(curpos, SplitMeString, delim)
156.     Do Until dpos = 0
157.         loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
158.         arrpos = arrpos + 1
159.         If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
160.         curpos = dpos + LD
161.         dpos = InStr(curpos, SplitMeString, delim)
162.     Loop
163.     loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
164.     ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
165. End Sub
166.  
167.  
168.  

No limit to amount of lines you want to copy / paste in except memory.

[SierraKen]

WOW I sorta see what you did there B+. You broke up the text to different lines and used a KeyHit command to stop it between lines. Perfect!!! I don't know anything about ReDim and a couple other things you did there, but I am really happy you fixed it! Thank you! Amazing that it has no limit either, besides memory limitations. This app can be used with books, articles, websites, whatever you need to be read to and can copy text from.
Thanks also to Steve, I tried your ways again today but for some reason the Stop and Pause commands just won't work for me. I will try to remember the _DONTWAIT command though, that is very important.