home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 3 / FreeSoftwareCollection3pd199x-jp.img / oh_fm / teuchi / synth.bas < prev    next >
BASIC Source File  |  1980-01-02  |  12KB  |  228 lines

  1. 10000 SCREEN @0:VIEW(0,0)-(639,479):CLS:CONSOLE 22,3:CLEAR ,,512,700000,10000:DIM PCM_SND%((32+64*1024)/2-1),PCM%(256),PCMS%(255),ENV%(256),ENVS%(255),BTNX1%(15),BTNY1%(15),BTNX2%(15),BTNY2%(15),C1%(512*256),C2%(256*256),SI%(255),PARAM&(4)
  2. 10010 ADDR&=VARPTR(PCM_SND%(0)):FOR I&=0 TO 31:POKE ADDR&+I&,0,1:NEXT
  3. 10020 POKE ADDR&+8,RND*10000,4
  4. 10030 POKE ADDR&+12,64*1024,4
  5. 10040 POKE ADDR&+24,&H75A,2
  6. 10050 POKE ADDR&+28,60,1
  7. 10060 ON ERROR GOTO *ERROR:CALC&=0:LOADM "synth.rex",0
  8. 10070 FOR I%=0 TO 255:SI%(I%)=INT((SIN(2*3.14159!/256*I%)/2+.5!)*2^14):NEXT
  9. 10080 RESTORE 10100
  10. 10090 FOR I%=0 TO 15:READ G%,R%,B%:PALETTE I%,[G%,R%,B%]:NEXT
  11. 10100 DATA   0,  0,  0
  12. 10110 DATA 130,130,130
  13. 10120 DATA 150,150,150
  14. 10130 DATA 100,100,100
  15. 10140 DATA 180,180,180
  16. 10150 DATA 210,210,220
  17. 10160 DATA 180,180,200
  18. 10170 DATA 210,210,240
  19. 10180 DATA   0,  0,  0
  20. 10190 DATA   0,  0,  0
  21. 10200 DATA   0,  0,  0
  22. 10210 DATA   0,  0,  0
  23. 10220 DATA   0,  0,  0
  24. 10230 DATA  50,255, 50
  25. 10240 DATA 255,155,200
  26. 10250 DATA 255,255,255
  27. 10260 LINE(0,32)-(639,417),PSET,%2,BF
  28. 10270 LINE(0,0)-(639,31),PSET,%3,BF
  29. 10280 LINE(0,418)-(639,479),PSET,%3,BF
  30. 10290 SYMBOL(150,5),"手書き入力シンセサイザ V1.1 L10",1.3!,1,%15,,PSET,13
  31. 10300 WINDOW(0,32)-(639,417):VIEW (0,32)-(639,417)
  32. 10310 FOR I%=-300 TO 639 STEP 8:LINE(I%,32)-(I%+194,417),PSET,%1:NEXT
  33. 10320 FOR I%=0 TO 800 STEP 8:LINE(0,I%)-(639,I%-320),PSET,%1:NEXT
  34. 10330 WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479)
  35. 10340 LINE(63+4,61+4)-(320+4,318+4),PSET,%0,BF
  36. 10350 LINE(63,61)-(320,318),PSET,%0,B
  37. 10360 LINE(369+4,61+4)-(626+4,190+4),PSET,%0,BF
  38. 10370 LINE(369,61)-(626,190),PSET,%0,B
  39. 10380 FOR X%=0 TO 255
  40. 10390   PCMS%(X%)=127*SIN(2*3.14159!/256*X%):PCM%(X%)=PCMS%(X%)
  41. 10400   C%=X% MOD 8:C%=C% \ 4
  42. 10410   LINE(64+X%,62)-(64+X%,317),PSET,%C%+4
  43. 10420   LINE(64+X%,62+128-PCMS%(X%))-(64+X%,62+128),PSET,%C%+6
  44. 10430 NEXT:PCM%(256)=PCM%(0)
  45. 10440 FOR X%=0 TO 255
  46. 10450   ENVS%(X%)=127/256*(255-X%):ENV%(X%)=ENVS%(X%)
  47. 10460   C%=X% MOD 8:C%=C% \ 4
  48. 10470   LINE(370+X%,62)-(370+X%,189),PSET,%C%+4
  49. 10480   LINE(370+X%,62+127-ENVS%(X%))-(370+X%,189),PSET,%C%+6
  50. 10490 NEXT:ENV%(256)=ENVS%(255)
  51. 10500 FOR X&=0 TO 255:GET@A(64+X&,62)-(64+X&,62+255),C1%,X&*512:NEXT
  52. 10510 FOR X&=0 TO 255:GET@A(370+X&,62)-(370+X&,62+127),C2%,X&*256:NEXT
  53. 10520 X%=160:Y%=40:A$="基本波形":C%=15:GOSUB *SYM
  54. 10530 X%=420:Y%=40:A$="エンベロープ・パターン":C%=15:GOSUB *SYM
  55. 10540 DIX%(0)=350:DIY%(0)=250:DIVOL%(0)=0:DI%=0:GOSUB *DISP_DIAL
  56. 10550 DIX%(1)=350:DIY%(1)=290:DIVOL%(1)=0:DI%=1:GOSUB *DISP_DIAL
  57. 10560 DIX%(2)=350:DIY%(2)=350:DIVOL%(2)=0:DI%=2:GOSUB *DISP_DIAL
  58. 10570 DIX%(3)=350:DIY%(3)=390:DIVOL%(3)=0:DI%=3:GOSUB *DISP_DIAL
  59. 10580 X%=450:Y%=230:A$="トレモロ":C%=15:GOSUB *SYM
  60. 10590 X%=440:Y%=330:A$="ビブラート":C%=15:GOSUB *SYM
  61. 10600 X%=350:Y%=230:A$="周期":C%=15:GOSUB *SYM
  62. 10610 X%=590:Y%=230:A$="→長":C%=15:GOSUB *SYM
  63. 10620 X%=350:Y%=270:A$="大きさ":C%=15:GOSUB *SYM
  64. 10630 X%=590:Y%=270:A$="→大":C%=15:GOSUB *SYM
  65. 10640 X%=350:Y%=330:A$="周期":C%=15:GOSUB *SYM
  66. 10650 X%=590:Y%=330:A$="→長":C%=15:GOSUB *SYM
  67. 10660 X%=350:Y%=370:A$="大きさ":C%=15:GOSUB *SYM
  68. 10670 X%=590:Y%=370:A$="→大":C%=15:GOSUB *SYM
  69. 10680 X%=50:Y%=340:C%=15:A$="PCMデータを保存する":GOSUB *SYM2
  70. 10690 X%=50:Y%=365:C%=15:A$="PCMデータを計算する":GOSUB *SYM2
  71. 10700 X%=50:Y%=390:C%=15:A$=" PCM音源を鳴らす ":GOSUB *SYM2
  72. 10710 X%=270:Y%=330:C%=15:A$="クリア":GOSUB *SYM2
  73. 10720 X%=580:Y%=200:C%=15:A$="クリア":GOSUB *SYM2
  74. 10730 X%=590:Y%=5:C%=15:A$="終了":GOSUB *SYM2
  75. 10740 FOR X%=0 TO 255
  76. 10750   LINE(X%+370,62+127-ENV%(X%))-(X%+370,62+127-ENV%(X%+1)),PSET,%13
  77. 10760 NEXT
  78. 10770 FOR X%=0 TO 255
  79. 10780   LINE(X%+64,62+128-PCM%(X%))-(X%+64,62+128-PCM%(X%+1)),PSET,%13
  80. 10790 NEXT
  81. 10800 RESTORE 10810:READ I%:FOR X%=1 TO I%:READ BTNX1%(X%),BTNY1%(X%),BTNX2%(X%),BTNY2%(X%):NEXT
  82. 10810 DATA 12
  83. 10820 DATA 64,62,319,317 'PCM
  84. 10830 DATA 370,62,625,189 'ENV
  85. 10840 DATA 358,250,613,265 'V0
  86. 10850 DATA 358,290,613,305 'V1
  87. 10860 DATA 358,350,613,365 'V2
  88. 10870 DATA 358,390,613,405 'V3
  89. 10880 DATA 270,330,317,345 'PCM CL
  90. 10890 DATA 580,200,627,215 'ENV CL
  91. 10900 DATA 50,340,225,355 'CMD1
  92. 10910 DATA 50,365,225,380 'CMD2
  93. 10920 DATA 50,390,225,405 'CMD3
  94. 10930 DATA 590,5,621,20 'exit
  95. 10940 MOUSE 0:MOUSE 3,0,8:MOUSE 3,1,8:MOUSE 1,320,240,1
  96. 10950 MX%=MOUSE(0):MY%=MOUSE(1):M0%=MOUSE(2,0):M1%=MOUSE(2,1)
  97. 10960 IF MX%>=BTNX1%(1) AND MY%>=BTNY1%(1) AND MX%<=BTNX2%(1) AND MY%<=BTNY2%(1) THEN IF M0%=0 AND M1%=0 THEN MOUSE 4,0,0,639,479:GOTO 10980 ELSE MOUSE 3,0,32:MOUSE 4,BTNX1%(1),BTNY1%(1),BTNX2%(1),BTNY2%(1):GOTO 10990
  98. 10970 IF MX%>=BTNX1%(2) AND MY%>=BTNY1%(2) AND MX%<=BTNX2%(2) AND MY%<=BTNY2%(2) THEN IF M0%=0 AND M1%=0 THEN MOUSE 4,0,0,639,479:GOTO 10980 ELSE MOUSE 3,0,32:MOUSE 4,BTNX1%(2),BTNY1%(2),BTNX2%(2),BTNY2%(2):GOTO 10990
  99. 10980 MOUSE 3,0,8:M0%=MOUSE(2,0):M1%=MOUSE(2,1)
  100. 10990 WHILE (M0%=0) AND (M1%=0)
  101. 11000   MX%=MOUSE(0):MY%=MOUSE(1):M0%=MOUSE(2,0):M1%=MOUSE(2,1)
  102. 11010   IF MX%>=BTNX1%(1) AND MY%>=BTNY1%(1) AND MX%<=BTNX2%(1) AND MY%<=BTNY2%(1) THEN IF M0%=0 AND M1%=0 THEN MOUSE 4,0,0,639,479:GOTO 11030 ELSE MOUSE 3,0,32:MOUSE 4,BTNX1%(1),BTNY1%(1),BTNX2%(1),BTNY2%(1):GOTO 11040
  103. 11020   IF MX%>=BTNX1%(2) AND MY%>=BTNY1%(2) AND MX%<=BTNX2%(2) AND MY%<=BTNY2%(2) THEN IF M0%=0 AND M1%=0 THEN MOUSE 4,0,0,639,479:GOTO 11030 ELSE MOUSE 3,0,32:MOUSE 4,BTNX1%(2),BTNY1%(2),BTNX2%(2),BTNY2%(2):GOTO 11040
  104. 11030   MOUSE 3,0,8
  105. 11040 WEND:MX%=MOUSE(0):MY%=MOUSE(1)
  106. 11050 FOR I%=1 TO 12
  107. 11060   IF MX%>=BTNX1%(I%) AND MY%>=BTNY1%(I%) AND MX%<=BTNX2%(I%) AND MY%<=BTNY2%(I%) THEN BTN%=I%:I%=99:GOTO 11070
  108. 11070 NEXT:IF I%<90 THEN GOTO 10990
  109. 11080 ON BTN% GOTO 11100,11340,11580,11590,11600,11610,11620,11690,11760,11830,11920,11980
  110. 11090 GOTO 10950
  111. 11100 IF MOUSE(2,1)=-1 THEN GOTO 11180
  112. 11110 X%=MX%-BTNX1%(1):PCM%(X%)=BTNY1%(1)+128-MY%:PCM%(256)=PCM%(0)
  113. 11120 PUT@A(64+X%,62)-(64+X%,62+255),C1%,PSET,,,,X%*512
  114. 11130 LINE(X%+64,62+128-PCM%(X%))-(X%+64,62+128-PCM%(X%+1)),PSET,%13
  115. 11140 IF X%=0 THEN X%=255 ELSE X%=X%-1
  116. 11150 PUT@A(64+X%,62)-(64+X%,62+255),C1%,PSET,,,,X%*512
  117. 11160 LINE(X%+64,62+128-PCM%(X%))-(X%+64,62+128-PCM%(X%+1)),PSET,%13
  118. 11170 GOTO 10950
  119. 11180 WHILE MOUSE(2,1)=-1 
  120. 11190   MX2%=MOUSE(0):MY2%=MOUSE(1)
  121. 11200   LINE(MX%,MY%)-(MX2%,MY2%),XOR
  122. 11210   LINE(MX%,MY%)-(MX2%,MY2%),XOR
  123. 11220 WEND:MX2%=MOUSE(0):MY2%=MOUSE(1)
  124. 11230 IF MX2%=MX% THEN GOTO 11110
  125. 11240 IF MX%>MX2% THEN SWAP MX%,MX2%:SWAP MY%,MY2%
  126. 11250 X2%=MX2%-MX%:Y1%=BTNY1%(1)+128-MY%:Y2%=BTNY1%(1)+128-MY2%
  127. 11260 FOR I%=MX% TO MX2%:PCM%(I%-BTNX1%(1))=(Y2%*(I%-MX%)+Y1%*(MX2%-I%))/X2%
  128. 11270   PCM%(256)=PCM%(0):X%=I%-64
  129. 11280   PUT@A(I%,62)-(I%,62+255),C1%,PSET,,,,X%*512
  130. 11290   LINE(I%,62+128-PCM%(X%))-(I%,62+128-PCM%(X%+1)),PSET,%13
  131. 11300   IF X%=0 THEN X%=255 ELSE X%=X%-1
  132. 11310   PUT@A(64+X%,62)-(64+X%,62+255),C1%,PSET,,,,X%*512
  133. 11320   LINE(X%+64,62+128-PCM%(X%))-(X%+64,62+128-PCM%(X%+1)),PSET,%13
  134. 11330 NEXT:GOTO 10950
  135. 11340 IF MOUSE(2,1)=-1 THEN GOTO 11420
  136. 11350 X%=MX%-BTNX1%(2):ENV%(X%)=BTNY1%(2)+127-MY%:ENV%(256)=ENV%(255)
  137. 11360 PUT@A(370+X%,62)-(370+X%,62+127),C2%,PSET,,,,X%*256
  138. 11370 LINE(X%+370,62+127-ENV%(X%))-(X%+370,62+127-ENV%(X%+1)),PSET,%13
  139. 11380 IF X%=0 THEN X%=255 ELSE X%=X%-1
  140. 11390 PUT@A(370+X%,62)-(370+X%,62+127),C2%,PSET,,,,X%*256
  141. 11400 LINE(X%+370,62+127-ENV%(X%))-(X%+370,62+127-ENV%(X%+1)),PSET,%13
  142. 11410 GOTO 10950
  143. 11420 WHILE MOUSE(2,1)=-1 
  144. 11430   MX2%=MOUSE(0):MY2%=MOUSE(1)
  145. 11440   LINE(MX%,MY%)-(MX2%,MY2%),XOR
  146. 11450   LINE(MX%,MY%)-(MX2%,MY2%),XOR
  147. 11460 WEND:MX2%=MOUSE(0):MY2%=MOUSE(1)
  148. 11470 IF MX2%=MX% THEN GOTO 11110
  149. 11480 IF MX%>MX2% THEN SWAP MX%,MX2%:SWAP MY%,MY2%
  150. 11490 X2%=MX2%-MX%:Y1%=BTNY1%(2)+127-MY%:Y2%=BTNY1%(2)+127-MY2%
  151. 11500 FOR I%=MX% TO MX2%:ENV%(I%-BTNX1%(2))=(Y2%*(I%-MX%)+Y1%*(MX2%-I%))/X2%
  152. 11510   ENV%(256)=ENV%(255):X%=I%-370
  153. 11520   PUT@A(I%,62)-(I%,62+127),C2%,PSET,,,,X%*256
  154. 11530   LINE(I%,62+127-ENV%(X%))-(I%,62+127-ENV%(X%+1)),PSET,%13
  155. 11540   IF X%=0 THEN X%=255 ELSE X%=X%-1
  156. 11550   PUT@A(370+X%,62)-(370+X%,62+127),C2%,PSET,,,,X%*256
  157. 11560   LINE(X%+370,62+127-ENV%(X%))-(X%+370,62+127-ENV%(X%+1)),PSET,%13
  158. 11570 NEXT:GOTO 10950
  159. 11580 DIVOL%(0)=MX%-BTNX1%(3):DI%=0:GOSUB *DISP2_DIAL:GOTO 10950
  160. 11590 DIVOL%(1)=MX%-BTNX1%(4):DI%=1:GOSUB *DISP2_DIAL:GOTO 10950
  161. 11600 DIVOL%(2)=MX%-BTNX1%(5):DI%=2:GOSUB *DISP2_DIAL:GOTO 10950
  162. 11610 DIVOL%(3)=MX%-BTNX1%(6):DI%=3:GOSUB *DISP2_DIAL:GOTO 10950
  163. 11620 MOUSE 1,,,0:X%=270:Y%=330:C%=14:A$="クリア":GOSUB *SYM2
  164. 11630 PCM%(256)=PCMS%(255)
  165. 11640 FOR X%=0 TO 255:PCM%(X%)=PCMS%(X%):NEXT
  166. 11650 FOR X%=0 TO 255
  167. 11660   PUT@A(64+X%,62)-(64+X%,62+255),C1%,PSET,,,,X%*512
  168. 11670   LINE(X%+64,62+128-PCM%(X%))-(X%+64,62+128-PCM%(X%+1)),PSET,%13
  169. 11680 NEXT:X%=270:Y%=330:C%=15:A$="クリア":GOSUB *SYM2:MOUSE 1,,,1:GOTO 10950
  170. 11690 MOUSE 1,,,0:X%=580:Y%=200:C%=14:A$="クリア":GOSUB *SYM2
  171. 11700 ENV%(256)=ENVS%(255)
  172. 11710 FOR X%=0 TO 255:ENV%(X%)=ENVS%(X%):NEXT
  173. 11720 FOR X%=0 TO 255
  174. 11730   PUT@A(370+X%,62)-(370+X%,62+127),C2%,PSET,,,,X%*256
  175. 11740   LINE(X%+370,62+127-ENV%(X%))-(X%+370,62+127-ENV%(X%+1)),PSET,%13
  176. 11750 NEXT:X%=580:Y%=200:C%=15:A$="クリア":GOSUB *SYM2:MOUSE 1,,,1:GOTO 10950
  177. 11760 X%=50:Y%=340:C%=14:A$="PCMデータを保存する":GOSUB *SYM2
  178. 11770 PRINT"PCMデータを保存します。ファイルネームを入力してください。"
  179. 11780 INPUT"FILE NAME < ",A$
  180. 11790 IF A$="" THEN GOTO 11820
  181. 11800 IF INSTR(A$,".SND")=0 OR INSTR(A$,".snd") THEN A$=A$+".snd"
  182. 11810 SAVE@ A$,PCM_SND%
  183. 11820 X%=50:Y%=340:C%=15:A$="PCMデータを保存する":GOSUB *SYM2:GOTO 10950
  184. 11830 X%=50:Y%=365:C%=14:A$="PCMデータを計算する":GOSUB *SYM2
  185. 11840 PARAM&(0)=277.2!/19600*2^32
  186. 11850 PARAM&(1)=277.2!/19600*2^32*(255-DIVOL%(0))/256/10
  187. 11860 PARAM&(2)=DIVOL%(1)*256
  188. 11870 PARAM&(3)=277.2!/19600*2^32*(255-DIVOL%(2))/256/10
  189. 11880 PARAM&(4)=DIVOL%(3)*256
  190. 11890 CALLM CALC&,VARPTR(PARAM&(0)),VARPTR(PCM_SND%(0)),VARPTR(PCM%(0)),VARPTR(ENV%(0)),VARPTR(SI%(0))
  191. 11900 VOICE SET PCM_SND%
  192. 11910 X%=50:Y%=365:C%=15:A$="PCMデータを計算する":GOSUB *SYM2:GOTO 10950
  193. 11920 X%=50:Y%=390:C%=14:A$=" PCM音源を鳴らす ":GOSUB *SYM2
  194. 11930 PRINT"MMLを入力してください。"
  195. 11940 INPUT"MML < ",A$
  196. 11950 PART 0,6
  197. 11960 PLAY A$
  198. 11970 X%=50:Y%=390:C%=15:A$=" PCM音源を鳴らす ":GOSUB *SYM2:GOTO 10950
  199. 11980 X%=590:Y%=5:C%=13:A$="終了":GOSUB *SYM2:END
  200. 11990 GOTO 11990
  201. 12000 *SYM
  202. 12010 SYMBOL(X%,Y%),A$,1,1,%C%,,PSET,5:RETURN
  203. 12020 *SYM2
  204. 12030 SYMBOL(X%,Y%),A$,1,1,%C%,,PSET,5
  205. 12040 LINE(X%-1,Y%-1)-(X%+2+LEN(A$)*8,Y%+18),PSET,%0,B
  206. 12050 LINE(X%-2,Y%-2)-(X%+3+LEN(A$)*8,Y%+19),PSET,%0,B
  207. 12060 LINE(X%-2,Y%-2)-(X%+1+LEN(A$)*8,Y%+17),PSET,%C%,B
  208. 12070 LINE(X%-3,Y%-3)-(X%+2+LEN(A$)*8,Y%+18),PSET,%C%,B:RETURN
  209. 12080 *DISP_DIAL
  210. 12090 LINE(DIX%(DI%)-2+4,DIY%(DI%)-2+4)-(DIX%(DI%)+272+4,DIY%(DI%)+17+4),PSET,%0,BF
  211. 12100 LINE(DIX%(DI%)-2,DIY%(DI%)-2)-(DIX%(DI%)+272,DIY%(DI%)+17),PSET,%0,B
  212. 12110 LINE(DIX%(DI%)-1,DIY%(DI%)-1)-(DIX%(DI%)+271,DIY%(DI%)+16),PSET,%5,BF:GOSUB *DISP2_DIAL:RETURN
  213. 12120 *DISP2_DIAL
  214. 12130 LINE(DIX%(DI%)-1,DIY%(DI%)-1)-(DIX%(DI%)+271,DIY%(DI%)+16),PSET,%5,BF
  215. 12140 LINE(DIX%(DI%)+DIVOL%(DI%),DIY%(DI%))-(DIX%(DI%)+DIVOL%(DI%)+15,DIY%(DI%)+15),PSET,%6,BF:RETURN
  216. 12150 *ERROR
  217. 12160 IF ERR=53 THEN A$="Device I/O error":GOTO *ERROR1
  218. 12170 IF ERR=55 THEN A$="Bad file descriptor":GOTO *ERROR1
  219. 12180 IF ERR=63 THEN A$="File not found":GOTO *ERROR1
  220. 12190 IF ERR=67 THEN A$="Disk full":GOTO *ERROR1
  221. 12200 IF ERR=72 THEN A$="Drive not ready":GOTO *ERROR1
  222. 12210 IF ERR=73 THEN A$="Disk write protected":GOTO *ERROR1
  223. 12220 A$="ERROR = "+STR$(ERR)+" in "+STR$(ERL)
  224. 12230 *ERROR1
  225. 12240 PRINT A$;"  何かキーを押してください。":A$=INPUT$(1)
  226. 12250 IF ERL=11810 THEN RESUME NEXT
  227. 12260 RESUME NEXT
  228.