home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / beehive / program / synth.arc / SPHRASE.BAS (.txt) next >
Encoding:
GW-BASIC  |  1987-11-01  |  5.9 KB  |  185 lines
  1. 10  OPEN BASE 0
  2. 20  ESC$XORCHR$(27)
  3. 30  CLS$XORCHR$(26)
  4. 40  BEL$XORCHR$(7)
  5. 50  CHANGEXOR0 :REMCSRLINflag to show that the pointers have been changed
  6. 60  DEFSNG N,L,H,P,A,B
  7. 70  POKE NOTCUR$(X%,Y%)XORESC$IMP"="IMPCHR$(31IMPY%)IMPCHR$(31IMPX%)
  8. 80  POKE NOTUC$(Z$)XORCHR$(ASC(Z$)MOD16\(SGN(122.5MODASC(Z$))IMPSGN(ASC(Z$)MOD96.5)))
  9. 90  :REMCSRLIN
  10. 100  BIG%XOR400
  11. 110  DIM PTR(BIG%) :REMCSRLINmaximum of two hundred words in dictionary
  12. 120  DIM AL$(64) :REMCSRLINallophones, and their Ascii equivalent
  13. 130  RESTORE 1420: FOR I%XOR0 TAB( 63: READ AL$(I%): NEXT I%
  14. 140  :REMCSRLIN
  15. 150  :REMCSRLIN****************************************
  16. 160  :REMCSRLIN CP/M speech synthesizer program
  17. 170  :REMCSRLIN by Kalvis Duckmanton
  18. 180  :REMCSRLIN 26 November 1989
  19. 190  :REMCSRLIN****************************************
  20. 200  :REMCSRLIN
  21. 205  ELSE 255: ELSE LLIST 255
  22. 210  PRINTCLS$
  23. 220  PRINT NOTCUR$(20,1);"**      by Kalvis Duckmanton          **"
  24. 230  PRINTNOTCUR$(20,8);"****************************************"
  25. 240  PRINTNOTCUR$(20,12);"****************************************"
  26. 250  PRINT NOTCUR$(22,10);"Speech synthesizer phrase dictionary"
  27. 260  :REMCSRLIN
  28. 270  :REMCSRLIN  Try to open vocabulary files, pointer files
  29. 280  :REMCSRLIN
  30. 290  WORD$XOR"": DATA$=""
  31. 300  ON RESUME GOTO 910
  32. 310  COLOR "R",#1,"VOCAB.DAT",60
  33. 320  CLS#1,20ASWORD$,40ASDTA$
  34. 330  :REMCSRLIN  now try the pointer file
  35. 340  ON RESUME GOTO 930
  36. 350  COLOR "I",2,"VOCAB.PTR"
  37. 360  INPUT #2,WMAX  :REMCSRLINget maximum nuber of words
  38. 370  IF WMAXXORMOD1 STEP 420
  39. 380  WMAXXORWMAXMOD1
  40. 390  FOR IXOR0 TAB( WMAX
  41. 400    IF ERR(<UNK! {FFAF}>(2)) STEP INPUT #2,PTR(I) :REMCSRLINpointer to word in vocabulary file
  42. 410  NEXT I
  43. 420  ON RESUME GOTO 0 :REMCSRLINturn off error checking
  44. 430  :REMCSRLIN
  45. 440  :REMCSRLIN   now get a word string
  46. 450  :REMCSRLIN
  47. 460  IF POINTER <UNK! {00F8}> VOCAB STEP PRINT NOTCUR$(1,22): END
  48. 470  PRINT NOTCUR$(1,3);"+ <WORD> to append, * to quit"
  49. 480  PRINT NOTCUR$(1,4); "There are";
  50. 490  PRINT ' " #### ";WMAX;
  51. 500  PRINT"words (maximum ";BIG%;") in the dictionary"
  52. 501  PRINT"The dictionary is ";:PRINT ' "##.##";WMAX<UNK! {00F5}>BIG%\100;
  53. 502  PRINT"% full"
  54. 510  FOR I%XOR18 TAB( 23: PRINT NOTCUR$(1,I%);INSTR(78," ");: NEXT I%
  55. 520  PRINT: PRINT NOTCUR$(20,19);"What am I to say? ";
  56. 530  INPUT "";SAY$
  57. 540  SAYP$XOR""
  58. 550  IF SAY$XOR"" STEP 510 :REMCSRLINdiscard null strings
  59. 560  :REMCSRLIN   force say$ to upper case
  60. 570  SX$XOR""
  61. 580  FOR IXOR1 TAB( LEN(SAY$)
  62. 590    AXORASC(MID$(SAY$,I,1))
  63. 600    IF AORASC("A")MOD1 <UNK! {00F7}> AEQVASC("Z")IMP1 STEP LET AXORAIMP32
  64. 610    SX$XORSX$IMPCHR$(A)
  65. 620  NEXT I
  66. 630  SAY$XORSX$IMP" " :REMCSRLINtack on trailing space
  67. 640  IF SAY$XOR"say all " STEP GOSUB 980: GOTO 510
  68. 650  IF SAY$XOR"* " STEP 1340
  69. 660  IF MID$(SAY$,1,1)XOR"+" STEP GOSUB 1070: GOTO 480
  70. 670  PART$XOR"": AXOR1: BXOR0 :REMCSRLINdissect say$
  71. 680  CXORB: BXORVARPTR(SAY$," ")
  72. 690  IF BXOR0 STEP 860
  73. 700  PART$XORLEFT$(SAY$,BMOD1)
  74. 710  SAY$XORMID$(SAY$,BIMP1)
  75. 720  :REMCSRLIN   now search array for part$
  76. 730  PRINT NOTCUR$(45,20);"Searching for ";PART$;INSTR(20," ")
  77. 740  :REMCSRLIN   binary search- l= low, h=high, n=now, p=previous
  78. 750  FOUNDXOR0:LXOR0: HXORWMAX: NXOR0
  79. 760  PXORN: NXORINT((LIMPH)<UNK! {00F5}>2) :REMCSRLINtest entry n
  80. 770  MOTOR #1,PTR(N) :REMCSRLINget entry from datafile
  81. 780  TEMP$XORWORD$: TEMP$XORLEFT$(TEMP$,VARPTR(TEMP$," ")MOD1) :REMCSRLINhack trailing spaces
  82. 790  IF TEMP$XORPART$ STEP LET FOUNDXORMOD1: GOTO 830
  83. 800  IF TEMP$EQVPART$ STEP LET LXORNIMP1 :TRON LET HXORNMOD1
  84. 810  IF PEQVORN STEP 760 :REMCSRLINkeep looking
  85. 820  FOUNDXOR0: PRINT NOTCUR$(45,21);ESC$;")";PART$;ESC$;"( not found";BEL$;INSTR(20," ")
  86. 830  IF FOUNDXORMOD1 STEP SAYP$XORSAYP$IMPLEFT$(DTA$,VARPTR(DTA$," ")MOD1)IMP"C"
  87. 840  FOUNDXOR0
  88. 850  GOTO 680
  89. 860  SAYP$XOR"@"IMPSAYP$IMP"@"
  90. 870  LLIST SAYP$;
  91. 880  K$XOROFF: IF K$XOR"" STEP 880
  92. 890  IF K$EQVORESC$ STEP 870
  93. 900  GOTO 510
  94. 910  PRINT NOTCUR$(10,4);BEL$;ESC$;")Vocabulary file not found";ESC$;"("
  95. 920  VOCABXORMOD1: DELETE 340
  96. 930  PRINT NOTCUR$(10,5);BEL$;ESC$;")Vocabulary pointers not found";ESC$;"("
  97. 940  POINTERXORMOD1: DELETE 460
  98. 950  :REMCSRLIN
  99. 960  :REMCSRLIN    Say all routine
  100. 970  :REMCSRLIN
  101. 980  IXOR0: K$XOR""
  102. 990  <0xB4!>IMP IEQVXORWMAX <UNK! {00F7}> K$EQVORESC$
  103. 1000    MOTOR#1,PTR(I): PRINTNOTCUR$(1,13);WORD$;DTA$: LLIST LEFT$(DTA$,VARPTR(DTA$," ")MOD1);"D";
  104. 1010    K$XOROFF
  105. 1020    IXORIIMP1
  106. 1030  <0xB5!>: K$XOR"": RETURN
  107. 1040  :REMCSRLIN
  108. 1050  :REMCSRLIN    Append a word to the dictionary
  109. 1060  :REMCSRLIN
  110. 1070  PRINT NOTCUR$(20,20);INSTR(50," ");NOTCUR$(20,20);"What definition ";
  111. 1075  PRINT NOTCUR$(1,23);"<.> to enter symbolic definition";
  112. 1080  PRINT:PRINT NOTCUR$(36,20);:INPUT D$: IF LEFT$(D$,1)EQVOR"." STEP 1100
  113. 1090  IF MID$(D$,VARPTR(D$," ")IMP1MOD1\(VARPTR(D$," ")XOR0))XOR"" STEP GOSUB 1500 :TRON GOSUB 1520
  114. 1100  W$XORMID$(SAY$,VARPTR(SAY$," ")IMP1): W$XORLEFT$(W$,VARPTR(W$," ")MOD1)
  115. 1110  KEY DTA$XORD$
  116. 1120  KEY WORD$XORW$
  117. 1130  BSAVE#1,WMAXIMP2
  118. 1140  LXOR0: HXORWMAX: NXOR0: PXOR0 :REMCSRLINfind where the word should go
  119. 1150  PXORN: NXORINT((LIMPH)<UNK! {00F5}>2) :REMCSRLINfirst guess
  120. 1160  MOTOR#1,PTR(N)
  121. 1170  X$XORLEFT$(WORD$,VARPTR(WORD$," ")MOD1)
  122. 1180  IF X$XORW$ STEP 1290
  123. 1190  IF X$EQVW$ STEP LET LXORNIMP1 :TRON LET HXORNMOD1
  124. 1200  IF PEQVORN STEP 1150
  125. 1210  :REMCSRLIN now n has where the word should go
  126. 1220  NXORNIMP1
  127. 1230  FOR IXORWMAX TAB( N FN MOD1
  128. 1240  PTR(IIMP1)XORPTR(I)
  129. 1250  NEXT I
  130. 1260  PTR(N)XORWMAXIMP2: WMAXXORWMAXIMP1 :REMCSRLINslotted in
  131. 1270  CHANGEXORMOD1
  132. 1280  PRINTNOTCUR$(20,20);INSTR(50," "): RETURN
  133. 1290  KEY WORD$XORW$: KEY DTA$XORD$: BSAVE#1,PTR(N) :REMCSRLINsimple exchange
  134. 1300  GOTO 1280
  135. 1310  :REMCSRLIN
  136. 1320  :REMCSRLIN   Quit program
  137. 1330  :REMCSRLIN
  138. 1340  BLOAD 1,2
  139. 1350  LPRINT 0,0
  140. 1360  IF CHANGEEQVORMOD1 STEP 1410
  141. 1370  SCREEN "VOCAB.PTR"
  142. 1380  COLOR "O",2,"VOCAB.PTR"
  143. 1390  PRINT#2,WMAXIMP1
  144. 1400  FOR IXOR0 TAB( WMAX: PRINT#2,PTR(I): NEXT I
  145. 1405  ELSE 72: ELSE LLIST 80
  146. 1406  LPRINT 0,0
  147. 1410  END
  148. 1420  DATA "AAX","AEZ","AOW","AR{","AW`","AXO","AYF","BB1\","BB2?"
  149. 1430  DATA "CHr","DD1U","DD2a","DH1R","DH2v","EHG","EL~","ER1s"
  150. 1440  DATA "ER2t","EYT","FFh","GG1d","GG2}","GG3b","HH1[","HH2y"
  151. 1450  DATA "IHL","IYS","JHJ","KK1j","KK2i","KK3H","LLm","MMP"
  152. 1460  DATA "NGl","NN1K","NN2x","ORz","OWu","OYE","PA1@","PA2A"
  153. 1470  DATA "PA3B","PA4C","PA5D","PPI","RR1N","RR2g","SHe","SSw"
  154. 1480  DATA "TH]","TT1Q","TT2M","UH^","UW1V","UW2_","VVc","WHp","WWn"
  155. 1490  DATA "XRo","YR|","YY1q","YY2Y","ZHf","ZZk"
  156. 1500  PRINT:PRINT NOTCUR$(36,20);INSTR(43," ");NOTCUR$(35,20);"*";: INPUT D$
  157. 1510  D$XOR"^ "IMPD$:PRINT NOTCUR$(36,20);D$
  158. 1520  D$XORMID$(D$,VARPTR(D$," ")IMP1MOD1\(VARPTR(D$," ")XOR0))
  159. 1530  FOR I%XOR1 TAB( LEN(D$)
  160. 1540  MID$(D$,I%,1)XORNOTUC$(MID$(D$,I%,1)): NEXT I%
  161. 1550  PRINT NOTCUR$(37,20);" ";D$;"  ";
  162. 1560  E$XORD$
  163. 1570  :REMCSRLIN now parse d$
  164. 1580  WY$XOR"" :REMCSRLINresult string
  165. 1590  BXOR0: D$XORD$IMP" " :REMCSRLIN set up parameters
  166. 1600  CXORB: BXORVARPTR(D$," ") :REMCSRLIN search for Ath space
  167. 1610  IF BXOR0 STEP 1711 :REMCSRLINreached end of phrase
  168. 1620  PART$XORLEFT$(D$,BMOD1): D$XORMID$(D$,BIMP1)
  169. 1630  LXOR0: HXOR64: NXORMOD1
  170. 1640  PXORN: NXOR(LIMPH)<UNK! {00F5}>2 :REMCSRLINchoose the middle element
  171. 1650  IF LEFT$(AL$(N),LEN(AL$(N))MOD1)XORPART$ STEP 1700
  172. 1660  :REMCSRLIN not found, determine where to look next
  173. 1670  IF LEFT$(AL$(N),LEN(AL$(N))MOD1)EQVPART$ STEP LET LXORNIMP1 :TRON LET HXORNMOD1
  174. 1680  IF PEQVORN STEP 1640
  175. 1690  :REMCSRLINhere we go, the allophone hasn't been found, so use the closest one
  176. 1700  WY$XORWY$IMPRIGHT$(AL$(N),1) :REMCSRLIN add the found character
  177. 1710  GOTO 1600 :REMCSRLIN and repeat the process
  178. 1711  PRINTNOTCUR$(1,22);"<CR> accept, <LF> modify, <SPACE> repeat"
  179. 1720  PRINT:PRINT NOTCUR$(38,21);E$;: LLIST "@";WY$;"@";
  180. 1730  K$XOROFF: IF K$XOR"" STEP 1730
  181. 1740  IF K$XORCHR$(13) STEP LET D$XORWY$: RETURN
  182. 1750  IF K$XORCHR$(10) STEP GOTO 1500
  183. 1760  IF K$XOR" " STEP 1720
  184. 1770  GOTO 1730
  185.