\ LOAD SCREEN 2 999 THRU ( Notes on synthesized speech for the blind 10/04/86 ) ;S At one time I had a blind apprentice Frank McCall who was learning to write computer programs. I did some work getting his Echo Plus speech synthesizer to let him read and edit Forth computer programs. Unfortunately I was too busy to give him enough attention and he found computer programming too frustrating and so he quit before we had proper editing tools created. Here are some of the primitives I used that you might find useful in developing software for the blind. ( SAY-CHAR SHUT-UP SAY-INIT 05/12/86 ) : SAY-CHAR ( char -- : emits char out COM2: ) COM2: COM-PUT DROP ; : SHUT-UP ( -- : aborts current phrase it progress ) 24 ( ctrl-x ) SAY-CHAR ; : SAY-INIT ( intializes COM2: for the talker ) [ BINARY ] 11100011 [ DECIMAL ] COM2: COM-INIT DROP ( 9600 baud no parity 1 stopbit 8 bits ) 5 SAY-CHAR ^ M SAY-CHAR ( most punctuation ) ; ( Speech patterns 05/10/86 ) ;S For pronouncing words we need a way to simply encode the capitalization information. donkey text low pitch 20P Donkey standard variable medium pitch 30P DONKEY standard routine high pitch 40P doNkey weird very high pitch 50P DoNkey weird very high pitch 50P For pronouncing single letters D high pitch d low pitch ( Notes on saying phrases 05/12/86 ) ;S We break phrases up wherever there is a space or dash. We then pronounce the words separately using the pitch to encode the capitalization. A single space is encoded as a slight pause. Multiple spaces are counted out e.g. "seven spaces" The - is pronounced "dash" ( SAY-STRING 05/10/86 ) : SAY-STRING ( addr len -- says string of chars ) ( does not change pitch ) ( does not append a Cr ) 0 ?DO DUP I + C@ SAY-CHAR LOOP DROP ; ( SAY-FAST SAY-SLOW 05/12/86 ) : SAY-FAST ( speak quickly ) 5 SAY-CHAR ^ C SAY-CHAR ; : SAY-SLOW ( speak slowly ) 5 SAY-CHAR ^ E SAY-CHAR ; ( SAY-PITCH SAY-IT 05/12/86 ) : SAY-PITCH ( 0 .. 63 -- Sets pitch ) 5 SAY-CHAR ( pitch command is ctrl-E nnP ) S>D <# Q# Q# #> SAY-STRING ^ P SAY-CHAR ; : SAY-IT ( -- : flushes buffer and starts talking ) ( say a Cr to start talking ) 13 SAY-CHAR ; ( SAY-WORD-MODE SAY-LETTER-MODE SAY-PAUSE 05/12/86 ) : SAY-WORD-MODE ( -- sets word mode ) 5 SAY-CHAR ^ W SAY-CHAR ( word mode ) ; : SAY-LETTER-MODE ( -- sets letter mode ) 5 SAY-CHAR ^ L SAY-CHAR ( letter mode ) ; : SAY-PAUSE ( -- slight pause ) 22 SAY-CHAR A" ,1" ( Phoneme pause ) SAY-STRING SAY-WORD-MODE ; ( CALC-PITCH 05/12/86 ) : CALC-PITCH ( addr len -- pitch : len 0..32000 ) ( determine the capitalization pattern ) ( count capital letters ) 2DUP 0 ROT ROT 0 ( -- addr len count addr len 0 ) ?DO DUP I + C@ ^ A ^ Z RANGE? ROT + SWAP LOOP DROP NEGATE ( -- addr len count ) DUP 0= IF ( all lower case ) 3DROP 20 ELSE 2DUP = IF ( all caps ) 3DROP 40 ELSE ( mixed ) 1 = ROT C@ ^ A ^ Z RANGE? AND IF ( one cap at start ) DROP 30 ELSE ( mixed up ) DROP 50 THEN THEN THEN ; ( SAY-WORD 05/12/86 ) : SAY-WORD ( addr len -- says a single word or letter ) ( pitch encodes capitalization pattern ) ( should not contain embedded spaces ) SAY-WORD-MODE 2DUP CALC-PITCH SAY-PITCH ( say the word ) SAY-STRING SAY-IT ; ( SAY-SPACE 05/12/86 ) : SAY-SPACE ( -- : say the word "space" ) ( usually used only in letter mode ) ( normally a space is marked just by a pause ) SAY-WORD-MODE 50 SAY-PITCH A" space" SAY-STRING SAY-IT ; ( SAY-SPACES 05/12/86 ) : SAY-SPACES ( nn -- : nn 0..30000 ) ( says nn spaces in high pitch ) ( single space just inserts a slight pause ) DUP 0= IF DROP EXIT THEN SAY-WORD-MODE 50 SAY-PITCH DUP 1 = IF DROP SAY-PAUSE ELSE S>D <# #S #> ( addr len ) SAY-STRING A" spaces" SAY-STRING THEN SAY-IT ; ( SAY-LETTER 05/10/86 ) : SAY-LETTER ( char -- : says a letter or space ) ( pitch encodes capitalization pattern ) ( should not contain embedded spaces ) DUP BL = IF DROP SAY-SPACE EXIT THEN SAY-LETTER-MODE DUP ^ A ^ Z RANGE? IF ( caps ) 40 ELSE ( lower ) 20 THEN SAY-PITCH ( say the letter ) SAY-CHAR SAY-IT ; ( SPEAK-WORD 05/12/86 ) : SPEAK-WORD ( addr len -- addr len ) ( speaks word up to - or space ) ( leaves addr len of remainder of string ) 2DUP BL SCAN IF >R 2DUP ^ - SCAN R> SWAP IF ( addr len off off ) MIN THEN ELSE 2DUP ^ - SCAN NOT IF DUP THEN THEN ( addr len off ) >R OVER R@ ( addr len addr off ) SAY-WORD R@ - SWAP R> + SWAP ( addr len remainder of string ) ; ( SPEAK-SPACES 05/12/86 ) : SPEAK-SPACES ( addr len -- addr len ) ( speaks count of spaces at start of string ) ( leaves addr len of remainder of string ) ( works with 0 spaces too ) 2DUP BL SCAN<> IF ( found non blank char in string ) ( offset ) DUP SAY-SPACES ( addr len offset ) >R R@ - SWAP R> + SWAP ( addr len remainder of string ) ELSE ( whole string is blank ) DUP SAY-SPACES ( addr len ) + 0 THEN ; ( SPEAK-DASH 05/12/86 ) : SPEAK-DASH ( addr len -- addr len ) ( says dash and parses over it if this is a dash ) OVER C@ ^ - = IF ( was a dash ) 50 SAY-PITCH ^ - SAY-CHAR 1- SWAP 1+ SWAP ( addr len remainder ) THEN ( otherwise does nothing ) ; ( SAY-PHRASE 05/12/86 ) : SAY-PHRASE ( addr len -- : speak a phrase ) BEGIN SPEAK-SPACES ( addr len remainder ) DUP 0= IF 2DROP EXIT THEN SPEAK-DASH DUP 0= IF 2DROP EXIT THEN SPEAK-WORD DUP 0= IF 2DROP EXIT THEN AGAIN ; ( SAY-FIRST-WORD-OF-PHRASE 05/13/86 ) : SAY-FIRST-WORD-OF-PHRASE ( addr len -- ) ( if phrase starts with space, just counts spaces ) ( if phrase starts with non-space, speaks first word ) ( first word may have embedded - ) 2DUP BL SCAN IF ( found space ) ?DUP ( offset ) IF ( word terminated by space ) SWAP DROP SAY-PHRASE ELSE ( leading blanks ) SPEAK-SPACES 2DROP THEN ELSE ( all text ) SAY-PHRASE THEN ; \ LAST SCREEN
