home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib21a.dsk / AUGUST.1984 / SYNTHESIZER.bas < prev   
BASIC Source File  |  2023-02-26  |  13KB  |  276 lines
  1. 10  REM  **********8.30.84**********
  2. 20  REM  *       SYNTHESIZER       *
  3. 30  REM  * BY JAMES R. GESCHWENDER *
  4. 40  REM  *   COPYRIGHT (C) 1984    *
  5. 50  REM  *   BY MICROSPARC, INC.   *
  6. 60  REM  *   LINCOLN, MA. 01773    *
  7. 70  REM  ***************************
  8. 80  REM  INITIALIZATION ** PRODOS USERS SEE LINE 1860
  9. 90  IF  PEEK(104) = 64  THEN 120
  10. 100  POKE 103,1: POKE 104,64: POKE 16384,0
  11. 110  PRINT  CHR$(4);"RUN SYNTHESIZER"
  12. 120  LOMEM: 37376
  13. 130  DIM Q(14),Y(6),M$(2),I$(2):D$ =  CHR$(4)
  14. 140  PRINT D$;"BLOAD SOUND.READER"
  15. 150  REM  DATA FOR MUSICAL NOTES
  16. 160  FOR N = 0 TO 14: READ Q(N): NEXT : DATA 73,77,86,96,108,116,128,144,152,171,192,213,230,254,0
  17. 170  REM  DATA FOR SCALE LINES
  18. 180  FOR N = 0 TO 6: READ Y(N): NEXT : DATA 48,54,65,77,89,107,128
  19. 190  REM  DATA FOR SHAPE TABLE
  20. 200  FOR N = 912 TO 924: READ A: POKE N,A: NEXT : POKE 232,144: POKE 233,3: DATA 2,0,6,0,8,0,4,0,172,30,7,32,0
  21. 210 Z = 12.5:M = 1:I = 1:PITCH = 125:SNUM = 1:NUM = 1:STADD = 25600: TEXT : HOME : SCALE= 1: ROT= 0
  22. 220 M$(1) = "SOUND SYNTHESIS":M$(2) = "MUSIC SYNTHESIS"
  23. 230 I$(1) = "KEYBOARD ENTRY ":I$(2) = "PADDLE ENTRY   "
  24. 240  HTAB 11: PRINT "SOUND SYNTHESIZER": VTAB 22: PRINT "** COPYRIGHT 1984 BY MICROSPARC, INC. **"
  25. 250  VTAB 10: HTAB 7: PRINT "1) LOAD EXISTING SOUND TABLE"
  26. 260  HTAB 7: PRINT "2) BEGIN NEW SOUND TABLE"
  27. 270  HTAB 7: PRINT "3) INSTRUCTIONS ";
  28. 280  GET A$:X =  VAL(A$): IF X <1  OR X >3  THEN 250
  29. 290  HOME : ON X GOTO 1820,300,1930
  30. 300  PRINT "ENTER NAME FOR NEW SOUND TABLE.": INPUT NAME$: ONERR  GOTO 2650
  31. 310  IF  VAL(NAME$) >0  OR  LEN(NAME$) >15  THEN  PRINT "ILLEGAL FILE NAME. TRY AGAIN": GOTO 300
  32. 320  PRINT D$"BSAVE";NAME$;",A";STADD;",L1": POKE 216,0
  33. 330  REM  CLEAR FOR NEXT SOUND
  34. 340  HGR : HCOLOR= 3: HPLOT 0,0 TO 279,0 TO 279,159 TO 0,159 TO 0,0
  35. 350  GOSUB 1560:TNUM = 1
  36. 360  FOR N = 0 TO 255: POKE STADD +SNUM *256 -256 +N,0: NEXT : REM IF ERROR, SEE LINE 1860
  37. 370  HOME : VTAB 21: PRINT "RETURN FOR MENU";
  38. 380  HTAB 25: INVERSE : PRINT "SOUND NUMBER ";SNUM: NORMAL 
  39. 390  IF I = 1  THEN  PRINT "KEYS YUI FOR UP, BNM FOR DOWN, S FOR DOT";: GOTO 410
  40. 400  PRINT "PADDLE AND BUTTON TO SET PITCH"
  41. 410  PRINT "SPACE BAR FOR PAUSE";
  42. 420  HTAB 26: PRINT "ESC FOR SHIFT"
  43. 430  PRINT "KEYS 0-9 AND ARROW KEYS TO PLACE CURSOR";
  44. 440  REM  MAIN SOUND MAKING LOOP
  45. 450  IF I = 1  THEN 580
  46. 460  REM  PADDLE ENTRY
  47. 470  IF M = 1  THEN 510
  48. 480 N =  INT(( PDL(1) +21.23)/21.24):PITCH = Q(N)
  49. 490  HCOLOR= (N <1): HPLOT 10,Y(0) TO 269,Y(0)
  50. 500  HCOLOR= (N <3): HPLOT 10,Y(1) TO 269,Y(1): GOTO 520
  51. 510 PITCH =  PDL(1) +1: IF PITCH >255  THEN PITCH = 255
  52. 520 CX = Z +TNUM:CY = Z +PITCH/2
  53. 530  XDRAW 2 AT CX,CY: HCOLOR= 0
  54. 540 X =  PEEK( -16384): IF X >127  THEN  POKE  -16368,0: GOTO 890
  55. 550 X =  PEEK( -16286): IF X >127  THEN 620
  56. 560  XDRAW 2 AT CX,CY: GOTO 470
  57. 570  REM  KEYBOARD ENTRY
  58. 580 CX = Z +TNUM:CY = Z +PITCH/2: XDRAW 2 AT CX,CY
  59. 590 X =  PEEK( -16384): IF X >127  THEN  POKE  -16368,0: GOTO 720
  60. 600  GOTO 590
  61. 610  REM  PROCESS BUTTON PRESS
  62. 620  XDRAW 2 AT CX,CY
  63. 630 A = STADD +SNUM *256 +TNUM -256
  64. 640  HPLOT CX, PEEK(A)/2 +Z
  65. 650  POKE A,PITCH: POKE A -TNUM,TNUM
  66. 660 TNUM = TNUM +1 -(TNUM >254)
  67. 670  XDRAW 1 AT CX,CY
  68. 680  IF  PEEK( -16286) <128  OR I = 1  THEN 450
  69. 690  GOTO 680
  70. 700  REM  PROCESS KEY PRESS
  71. 710  REM  KEYBOARD ENTRY
  72. 720  IF X <193  THEN 890
  73. 730  IF X = 211  THEN 620
  74. 740  XDRAW 2 AT CX,CY
  75. 750 X =  -50 *(X = 217) -10 *(X = 213) -2 *(X = 201) +50 *(X = 194) +10 *(X = 206) +2 *(X = 205)
  76. 760  IF M = 2  THEN 800
  77. 770 PITCH = PITCH +X: IF PITCH <1  THEN PITCH = 1
  78. 780  IF PITCH >255  THEN PITCH = 255
  79. 790  GOTO 450
  80. 800  FOR N = 0 TO 13: IF PITCH >Q(N)  THEN  NEXT 
  81. 810 X =  SGN(X) * INT( ABS(X) ^.4)
  82. 820 N = N +X: IF N <0  THEN N = 0
  83. 830  IF N >13  THEN N = 13
  84. 840 PITCH = Q(N)
  85. 850  HCOLOR= (N <1): HPLOT 10,Y(0) TO 269,Y(0)
  86. 860  HCOLOR= (N <3): HPLOT 10,Y(1) TO 269,Y(1)
  87. 870  HCOLOR= 0: GOTO 450
  88. 880  REM  PADDLE AND KEYBOARD ENTRY
  89. 890  XDRAW 2 AT CX,CY
  90. 900 X = X -128: IF X = 21  THEN 990
  91. 910  IF X = 32  THEN 970
  92. 920  IF X >47  AND X <58  THEN 1020
  93. 930  IF X = 8  THEN 1030
  94. 940  IF X = 27  THEN  GOSUB 1610: GOSUB 1300
  95. 950  IF X = 13  THEN 1060
  96. 960  GOTO 450
  97. 970 A = STADD +SNUM *256 -256 +TNUM
  98. 980  HPLOT CX, PEEK(A)/2 +Z: POKE A,0
  99. 990  POKE STADD +SNUM *256 -256,TNUM
  100. 1000 TNUM = TNUM +1 -(TNUM >254)
  101. 1010  GOTO 450
  102. 1020 X = X -49 +10 *(X = 48):TNUM =  INT(X *28.3): GOTO 990
  103. 1030  IF TNUM <2  THEN 450
  104. 1040 TNUM = TNUM -2: GOTO 990
  105. 1050  REM  MAIN MENU
  106. 1060  HCOLOR= 3: HPLOT CX,4 TO CX,9: HPLOT CX,142 TO CX,147
  107. 1070  HOME : VTAB 21: PRINT "  1) TEST SOUND";: HTAB 21: PRINT "5) DELETE SOUND"
  108. 1080  PRINT "  2) SAVE SOUND";: HTAB 21: PRINT "6) CHANGE MODES"
  109. 1090  PRINT "  3) ADD TO SOUND";: HTAB 21: PRINT "7) QUIT"
  110. 1100  PRINT "  4) DISPLAY PREVIOUSLY CREATED SOUND ";: GET A$
  111. 1110 X =  VAL(A$): IF X <1  OR X >7  THEN 1060
  112. 1120  ON X GOSUB 1150,1230,1300,1330,1450,1480,1580
  113. 1130  GOTO 1060
  114. 1140  REM  SOUND TEST
  115. 1150  HOME : VTAB 21: HTAB 7: PRINT "**TEST SOUND**"
  116. 1160  INPUT "OVERALL PITCH (1-9)? ";P: IF P <1  OR P >9  THEN 1160
  117. 1170  INPUT "NUMBER OF REPETITIONS (1-255)? ";R: IF R <1  OR R >255  THEN 1170
  118. 1180  INPUT "LENGTH OF EACH TONE (1-255)? ";L: IF L <1  OR L >255  THEN 1180
  119. 1190  PRINT "CALL 768,"SNUM","P","R","L: CALL 768,SNUM,P,R,L
  120. 1200  PRINT "   <<PRESS RETURN FOR MENU>> ";: GET A$: IF  ASC(A$) = 13  THEN  RETURN 
  121. 1210  GOTO 1150
  122. 1220  REM  SAVE SOUND
  123. 1230  HOME : VTAB 21: PRINT "VERIFY SAVE (Y/N)? ";: GET A$: IF A$ < >"Y"  THEN  RETURN 
  124. 1240  HOME : VTAB 21: PRINT "   **SAVING SOUND TABLE**": PRINT "TABLE NAME -  ";NAME$
  125. 1250 A = ( PEEK(STADD +NUM *256 -256) = 0)
  126. 1260 X = 256 *(NUM -A):NUM = NUM +1 -A
  127. 1270  PRINT D$;"BSAVE ";NAME$;",A";STADD;",L";X
  128. 1280  POP : GOTO 1870
  129. 1290  REM  ADD TO SOUND
  130. 1300  HCOLOR= 0: HPLOT CX,4 TO CX,9: HPLOT CX,142 TO CX,147
  131. 1310  POP : GOTO 370
  132. 1320  REM  DISPLAY PREVIOUS SOUND
  133. 1330  IF NUM <2  THEN  RETURN 
  134. 1340  HOME : VTAB 21: PRINT "DISPLAY WHICH SOUND NUMBER (1-"NUM;: INPUT ")? ";A$
  135. 1350 X =  VAL(A$): IF X <1  OR X >NUM  THEN 1340
  136. 1360  HPLOT 13,11 TO 267,11: HCOLOR= 0: HPLOT Z,1 TO Z,158
  137. 1370 SNUM = X:TNUM =  PEEK(STADD +SNUM *256 -256)
  138. 1380  FOR N = 1 TO 255
  139. 1390 CX = Z +N:Q =  PEEK(STADD +SNUM *256 -256 +N):CY = Z +Q/2
  140. 1400  HPLOT CX,1 TO CX,158: IF Q >0  THEN  XDRAW 1 AT CX,CY
  141. 1410  NEXT 
  142. 1420  IF M = 2  THEN  GOSUB 1560
  143. 1430 CX = Z +TNUM: HCOLOR= 3: HPLOT CX,4 TO CX,9: HPLOT CX,142 TO CX,147: RETURN 
  144. 1440  REM  DELETE SOUND
  145. 1450  HOME : VTAB 21: PRINT "VERIFY DELETE (Y/N)? ";: GET A$: IF A$ < >"Y"  THEN  RETURN 
  146. 1460  POP : GOTO 340
  147. 1470  REM  CHANGE MODES
  148. 1480  HOME : VTAB 21: INVERSE : PRINT " CURRENT MODE  ": PRINT M$(M): PRINT I$(I): NORMAL 
  149. 1490  VTAB 22: HTAB 18: PRINT "1) CHANGE SOUND MODE"
  150. 1500  HTAB 18: PRINT "2) CHANGE ENTRY MODE"
  151. 1510  HTAB 12: PRINT "<<RETURN FOR MENU>> ";: GET A$
  152. 1520 X =  ASC(A$): IF X = 13  THEN  RETURN 
  153. 1530  IF X = 49  THEN M = 2 -(M = 2): GOSUB 1560: GOTO 1480
  154. 1540  IF X = 50  THEN I = 2 -(I = 2): GOTO 1480
  155. 1550  GOTO 1480
  156. 1560  HCOLOR= M -1: FOR N = 2 *M -2 TO 6: HPLOT 10,Y(N) TO 269,Y(N): NEXT : RETURN 
  157. 1570  REM  QUIT
  158. 1580  HOME : VTAB 21: PRINT "VERIFY QUIT (Y/N)? ";: GET A$: IF A$ < >"Y"  THEN  RETURN 
  159. 1590  TEXT : HOME : END 
  160. 1600  REM  SHIFT DISPLAY
  161. 1610  HCOLOR= 3: HPLOT CX,4 TO CX,9: HPLOT CX,142 TO CX,147
  162. 1620  HOME : VTAB 21: PRINT "WITH THIS FEATURE YOU MAY SHIFT ALL OF"
  163. 1630  PRINT "THE DOTS THAT ARE TO THE RIGHT OF THE": PRINT "CURSOR."
  164. 1640  PRINT "SHIFT LEFT OR RIGHT (L OR R)? ";: GET A$: PRINT A$
  165. 1650  IF A$ = "R"  THEN A$ = "RIGHT":X = 1: GOTO 1680
  166. 1660  IF A$ < >"L"  THEN 1610
  167. 1670 A$ = "LEFT":X =  -1
  168. 1680  PRINT "SHIFT HOW FAR "A$" (0-9)? ";: GET A$: PRINT A$;
  169. 1690  PRINT : PRINT : INVERSE : HTAB 16: PRINT "SHIFTING";: NORMAL 
  170. 1700 X = X * VAL(A$): ON  SGN(X) +2 GOTO 1710,1800,1730
  171. 1710  IF  -X > = TNUM  THEN X = 1 -TNUM
  172. 1720  FOR N = TNUM TO 255: GOTO 1750
  173. 1730  IF X +TNUM >255  THEN  RETURN 
  174. 1740  FOR N = 255 -X TO TNUM  STEP  -1
  175. 1750 Q = STADD +256 *SNUM -256 +N: POKE Q +X, PEEK(Q): NEXT 
  176. 1760  IF X >0  THEN  FOR N = TNUM TO TNUM +X: POKE STADD +SNUM *256 -256 +N,0: NEXT : GOTO 1780
  177. 1770  FOR N = 255 +X TO 255: POKE STADD +SNUM *256 -256 +N,0: NEXT 
  178. 1780  POKE STADD +SNUM *256 -256,TNUM +X:X = SNUM
  179. 1790  GOSUB 1360
  180. 1800  RETURN 
  181. 1810  REM  LOAD SAVED SOUND TABLE
  182. 1820  PRINT "ENTER NAME OF EXISTING SOUND TABLE."
  183. 1830  PRINT "TYPE 'CAT' FOR A CATALOG": ONERR  GOTO 2660
  184. 1840  INPUT NAME$: IF NAME$ = "CAT"  THEN 1900
  185. 1850  PRINT D$;"BLOAD";NAME$;",A";STADD: POKE 216,0
  186. 1860 NUM =  PEEK(48858) +1: REM FOR PRODOS, CHANGE THE PEEK ADDRESS TO 48858
  187. 1870  HOME : VTAB 21: PRINT "FILE "NAME$" CURRENTLY"
  188. 1880  PRINT "CONTAINS "NUM -1" SOUNDS."
  189. 1890 SNUM = NUM: GOTO 340
  190. 1900  PRINT D$;"CATALOG"
  191. 1910  GOTO 1820
  192. 1920  REM  INSTRUCTIONS
  193. 1930  HOME : HTAB 14: PRINT "INSTRUCTIONS"
  194. 1940  VTAB 7: PRINT "THIS PROGRAM HAS TWO SOUND MAKING MODES."
  195. 1950  PRINT "THE FIRST IS FOR MAKING SOUND EFFECTS OF";
  196. 1960  PRINT "ALL VARIETIES, AND THE SECOND IS FOR"
  197. 1970  PRINT "SYNTHESIZING MUSIC."
  198. 1980  PRINT : PRINT "TO USE MODE ONE YOU SIMPLY LAY OUT THE"
  199. 1990  PRINT "DESIRED SOUND ON THE HI-RES DISPLAY"
  200. 2000  PRINT "USING A PADDLE CONTROLLER OR JOYSTICK"
  201. 2010  PRINT "AND THE KEYBOARD, OR THE KEYBOARD ONLY."
  202. 2020  PRINT "THE TOP OF THE SCREEN REPRESENTS HIGH"
  203. 2030  PRINT "PITCH, AND THE BOTTOM REPRESENTS LOW"
  204. 2040  PRINT "PITCH."
  205. 2050  FOR N = 1 TO 255
  206. 2060 Q = (N <127) *(125 -60 * SIN(N *.05))
  207. 2070  POKE STADD +N,Q: NEXT 
  208. 2080  GOSUB 2610: PRINT "AN EXAMPLE MIGHT LOOK LIKE THIS."
  209. 2090  HGR : HCOLOR= 3: HPLOT 0,0 TO 279,0 TO 279,159 TO 0,159 TO 0,0
  210. 2100 X = 1:M = 1: POKE STADD,126: GOSUB 1360
  211. 2110  VTAB 21: PRINT "WHEN YOU WISH TO HEAR THE SOUND, GO TO"
  212. 2120  PRINT "THE MENU, AND USE THE 'TEST' OPTION.": GOSUB 2610
  213. 2130  PRINT "YOU CONTROL THE OVERALL PITCH,"
  214. 2140  PRINT "THE NUMBER OF REPETITIONS,"
  215. 2150  PRINT "AND THE LENGTH OF EACH NOTE.": GOSUB 2610
  216. 2160  PRINT "SO, WITH THE SOUND PATTERN ABOVE, THIS,": CALL 768,1,1,1,30
  217. 2170  PRINT "AND THIS,": CALL 768,1,2,10,1
  218. 2180  PRINT "AND THIS, ";: CALL 768,1,9,3,3
  219. 2190  PRINT "ARE POSSIBLE.": GOSUB 2610
  220. 2200  PRINT "IF YOU ARE NOT SATISFIED WITH THE SOUND,";
  221. 2210  PRINT "USE THE 'ADD TO SOUND' OPTION.": GOSUB 2610
  222. 2220  PRINT "YOU MAY MOVE THE CURSOR HORIZONTALLY"
  223. 2230  PRINT "LEFT OR RIGHT WITH THE ARROW KEYS, AS"
  224. 2240  PRINT "WELL AS WITH THE NUMBER KEYS (0-9).": GOSUB 2610
  225. 2250  PRINT "YOU MAY WRITE OVER AN INCORRECT SECTION"
  226. 2260  PRINT "WITH DIFFERENT TONE DOTS, OR ERASE A"
  227. 2270  PRINT "SECTION BY SPACING OVER IT.": GOSUB 2610
  228. 2280 TNUM = 30:CX = Z +126:CY = 60
  229. 2290  PRINT "YOU MAY ALSO SHIFT THE RIGHT HAND"
  230. 2300  PRINT "PORTION OF THE SCREEN LEFT OR RIGHT."
  231. 2310  PRINT "PLACE THE CURSOR HERE FOR INSTANCE, AND"
  232. 2320  PRINT "PRESS ESC TO TRY IT.  <<PRESS ESC>> ";
  233. 2330  HCOLOR= 0: HPLOT CX,4 TO CX,9: HPLOT CX,142 TO CX,147:CX = Z +TNUM: XDRAW 2 AT CX,CY
  234. 2340  GET A$: IF  ASC(A$) < >27  THEN 2340
  235. 2350  XDRAW 2 AT CX,CY: GOSUB 1610
  236. 2360  HOME : VTAB 21: IF X = 0  THEN  PRINT "PLEASE TRY AGAIN WITH A NON-ZERO SHIFT.": GOSUB 2610: GOTO 2320
  237. 2370  PRINT "NOTE THAT THE SOUND READER READS ONLY UP";
  238. 2380  PRINT "TO THE 'END OF SOUND' SLASHES.": CALL 768,1,2,3,70
  239. 2390  GOSUB 2610: PRINT "SO PLACE THE CURSOR AT THE END OF THE"
  240. 2400  PRINT "SOUND BEFORE TESTING.": GOSUB 2610
  241. 2410  PRINT "MODE TWO SETS UP A MUSICAL SCALE WHICH"
  242. 2420  PRINT "ALLOWS YOU TO TRANSCRIBE DIRECTLY FROM"
  243. 2430  PRINT "SHEET MUSIC, TO A FORMAT LIKE THIS."
  244. 2440 Q = 1: FOR N = 0 TO 8
  245. 2450  READ X,A: DATA 7,9,5,11,3,14,14,1,5,9,6,8,5,9,7,7,14,60
  246. 2460  FOR TNUM = Q TO Q +A: POKE STADD +TNUM,Q(X)
  247. 2470  NEXT TNUM:Q = TNUM
  248. 2480  NEXT N
  249. 2490  POKE STADD,79:X = 1:M = 2: GOSUB 1360
  250. 2500  GOSUB 2610: PRINT "NOTE THAT HIGH NOTES PLAY FASTER SO THAT";
  251. 2510  PRINT "THE NOTE LINE MUST BE LONGER FOR EQUAL"
  252. 2520  PRINT "DURATION.": CALL 768,1,4,1,12
  253. 2530  GOSUB 2610: CALL 768,1,1,1,25: TEXT : VTAB 7
  254. 2540  PRINT "WHEN YOU ARE SATISFIED WITH THE SOUND,"
  255. 2550  PRINT "RECORD THE CALL COMMAND DISPLAYED, AND"
  256. 2560  PRINT "SAVE THE SOUND.  TO USE THE SOUND IN AN"
  257. 2570  PRINT "APPLESOFT PROGRAM, BLOAD THE SOUND FILE"
  258. 2580  PRINT "AND THE SOUND READER PROGRAM, AND USE"
  259. 2590  PRINT "THE CALL COMMAND TO EXECUTE THE SOUND."
  260. 2600  GOSUB 2610: RESTORE : GOTO 160
  261. 2610  VTAB 24: HTAB 9: PRINT "<<RETURN TO CONTINUE>> ";
  262. 2620  GET A$: IF  ASC(A$) < >13  THEN 2610
  263. 2630  HOME : VTAB 21: RETURN 
  264. 2640  REM  DISK ERROR TRAP
  265. 2650 EL = 1: GOTO 2670: REM  ENTRY POINT FOR DISK WRITE
  266. 2660 EL = 2: REM  ENTRY POINT FOR DISK READ
  267. 2670 ER =  PEEK(222)
  268. 2680  IF ER = 4  THEN  PRINT "DISK WRITE PROTECTED": GOTO 2760
  269. 2690  IF ER = 6  THEN  PRINT "FILE NOT FOUND": GOTO 2760
  270. 2700  IF ER = 8  THEN  PRINT "DISK I/O ERROR": GOTO 2760
  271. 2710  IF ER = 9  THEN  PRINT "DISK FULL": GOTO 2760
  272. 2720  IF ER = 10  THEN  PRINT "FILE LOCKED": GOTO 2760
  273. 2730  IF ER = 11  THEN  PRINT "ILLEGAL FILE NAME": GOTO 2760
  274. 2740  IF ER = 13  THEN  PRINT "FILE TYPE MISMATCH": GOTO 2760
  275. 2750  PRINT "ERROR #";ER"IN LINE "; PEEK(218) + PEEK(219) *256
  276. 2760  ON EL GOTO 300,1820