home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 2 / FreeSoftwareCollection2pd199x-jp.img / pcmfact / pcmf.bas < prev    next >
BASIC Source File  |  1990-06-14  |  11KB  |  311 lines
  1. 1000 '
  2. 1010 '  The PCM Amplifier 
  3. 1020 '                    by  J
  4. 1030 '
  5. 1040 '
  6. 1050 *INIT
  7. 1060    CLEAR ,,512,310000,1024: LOADM "pcmcalc.rex",0
  8. 1070    SCREEN@ 0: WIDTH 80,25:COLOR 0,7,7,4:CLS
  9. 1080    DIM LOADDATA%(50000),SAVEDATA%(50000),CUTSAVE%(50000)
  10. 1090    DIM CMDNAMES$(6),CMD_P(6,2),CMD_EN(6,3),PARAM_EN(4,3),PARAM(4)
  11. 1100  '  
  12. 1110  '  
  13. 1120  PARAM_NUM=4:   CMD_NUM=6    :CUT_FLAG=0
  14. 1130  '
  15. 1140  '  
  16. 1150  YESNO$="[yes=左クリック no=右クリック]"
  17. 1160  ON ERROR GOTO *ERROR
  18. 1170  '
  19. 1180  '
  20. 1190  RESTORE *COLOR
  21. 1200    FOR I=0 TO 15
  22. 1210      READ LOC0,LOC1,LOC2:PALETTE I,[LOC0,LOC1,LOC2]
  23. 1220    NEXT I
  24. 1230  '
  25. 1240  RESTORE *CMDNAMES
  26. 1250    FOR I=1 TO CMD_NUM
  27. 1260      READ  CMDNAMES$(I),CMD_P(I,0),CMD_P(I,1)
  28. 1270      READ  CMD_EN(I,0),CMD_EN(I,1),CMD_EN(I,2),CMD_EN(I,3)
  29. 1280    NEXT I
  30. 1290  '
  31. 1300  RESTORE *PARAM_TB
  32. 1310    FOR I=1 TO PARAM_NUM
  33. 1320      READ PARAM(I),PARAM_EN(I,0),PARAM_EN(I,1)
  34. 1330      READ          PARAM_EN(I,2),PARAM_EN(I,3)
  35. 1340    NEXT I
  36. 1350  '
  37. 1360  MOUSE 0:MOUSE 1,20,20,1
  38. 1370 '
  39. 1380 ':::::::::::::::::::::::::::::::::::::::: Main Routine :::::::
  40. 1390 GOSUB *MAIN_MENU
  41. 1400 *MAIN_LOOP
  42. 1410    GOSUB *GET_MOUSE  :IF ARG0=1 THEN *MAIN_LOOP
  43. 1420    GOSUB *GET_CMD_POSI
  44. 1430    IF  CMD_IND=CMD_NUM THEN *QUIT
  45. 1440    IF  CMD_IND=0       THEN *MN_SKIP
  46. 1450    CMD_SW=5:  GOSUB *WRITE_CMD
  47. 1460    ON CMD_IND GOSUB *INPUT_PCM,*OUTPUT_PCM,*PLAY1,*ON_WORK,*PLAY2
  48. 1470    CMD_SW=4:  GOSUB *WRITE_CMD:  GOTO *MAIN_LOOP
  49. 1480  *MN_SKIP
  50. 1490    GOSUB *GET_ED_POSI
  51. 1500    IF CMD_IND<>0 THEN GOSUB *GET_PARAM
  52. 1510 GOTO *MAIN_LOOP
  53. 1520 '
  54. 1530   *QUIT
  55. 1540     TMSG$="終了します．"+YESNO$
  56. 1550     GOSUB *WRITE_TMSG
  57. 1560     GOSUB *GET_MOUSE
  58. 1570       IF ARG0=1 THEN GOSUB *ERASE_TMSG:RETURN 
  59. 1580     TMSG$="   Good Luck and Good Bye " : GOSUB *WRITE_TMSG
  60. 1590     MOUSE 5
  61. 1600 END
  62. 1610 ':::::::::::::::::::::::::::::::::::: End Main ::::::::::::::::::::
  63. 1620 '
  64. 1630 *MAIN_MENU
  65. 1640   CLS:LINE(1,1)-(638,478),PSET,%1,BF,%14
  66. 1650   CONNECT(60,340)-(60,20)-(240,120)-(240,20)-(410,120)-(410,20)-(600,120)-(600,340)-(60,340),%0,PSET,F,%13
  67. 1660   CONNECT(495,65)-(495,30)-(535,30)-(535,87),%0,PSET,F,%13
  68. 1670   LINE (70,200)-(230,320),PSET,%0,BF,%2
  69. 1680   LINE(250,200)-(410,320),PSET,%0,BF,%2
  70. 1690   LINE(430,200)-(590,320),PSET,%0,BF,%2
  71. 1700   SYMBOL (160,350) ," PCM factory ",3,3,%5,,,3
  72. 1710   LINE  (50,350)-(160,410),PSET,%0,BF,%2
  73. 1720   LINE (480,350)-(590,410),PSET,%0,BF,%2
  74. 1730   LINE  (20,365)- (50,410),PSET,%0,BF,%2
  75. 1740   LINE (590,365)-(620,410),PSET,%0,BF,%2
  76. 1750   CIRCLE  (40,410),10,%0,,,,F,PSET,%2
  77. 1760   CIRCLE (140,410),10,%0,,,,F,PSET,%2
  78. 1770   CIRCLE (500,410),10,%0,,,,F,PSET,%2
  79. 1780   CIRCLE (600,410),10,%0,,,,F,PSET,%2
  80. 1790   SYMBOL (130,230),"Level"     ,1,1,%5,,,3
  81. 1800   SYMBOL (130,250),"   Adjust" ,1,1,%5,,,3
  82. 1810   SYMBOL (310,230),"Low Pass"  ,1,1,%5,,,3
  83. 1820   SYMBOL (310,250),"    Filter",1,1,%5,,,3
  84. 1830   SYMBOL (500,230),"Noise"     ,1,1,%5,,,3
  85. 1840   SYMBOL (500,250),"   Gate"   ,1,1,%5,,,3
  86. 1850   SYMBOL ( 80,315),"0    50   100%",1,1,%5,1,,64
  87. 1860   SYMBOL (260,315),"0    50   100%",1,1,%5,1,,64
  88. 1870   SYMBOL (440,315),"0    50   100%",1,1,%5,1,,64 
  89. 1880   SYMBOL (485,272),"0   50   100%",1,1,%5, ,,64 
  90. 1890   GOSUB *WRITE_ALL_PARAM
  91. 1900   CMD_SW=4:GOSUB *WRITE_ALL_CMD
  92. 1910   GOSUB *ERASE_TMSG
  93. 1920 RETURN
  94. 1930 '
  95. 1940 '
  96. 1950 *PLAY1
  97. 1960   PCMPLAY LOADDATA%
  98. 1970 RETURN
  99. 1980 '
  100. 1990 *PLAY2
  101. 2000   PCMPLAY SAVEDATA%
  102. 2010 RETURN
  103. 2020 '   
  104. 2030 *ON_WORK
  105. 2040   LEVEL&=0:P1&=64*PARAM(3)/100:P2&=PARAM(4)*192
  106. 2050   CALLM &HC9,VARPTR(LOADDATA%(0)),100000,VARPTR(SAVEDATA%(0))
  107. 2060   CALLM &H3D,VARPTR(SAVEDATA%(16)),COUNT&,VARPTR(LEVEL&)
  108. 2070   IF LEVEL&=0 THEN RETURN
  109. 2080   VOL=127/LEVEL&
  110. 2090   INT_VOL&=INT(VOL*256*PARAM(1)/100)
  111. 2100   CALLM &H0,VARPTR(SAVEDATA%(16)),COUNT&,INT_VOL&
  112. 2110  '   
  113. 2120   P3&=INT(.44!*(100-PARAM(2)+1))
  114. 2130  '
  115. 2140   CALLM &HE4,VARPTR(SAVEDATA%(16)),COUNT&,P3&
  116. 2150   CALLM &H76,VARPTR(SAVEDATA%(16)),COUNT&,P1&,P2&
  117. 2160 RETURN
  118. 2170 '
  119. 2180 *REC
  120. 2190   TMSG$="録音します,準備ができたら左クリックしてください."
  121. 2200   GOSUB *WRITE_TMSG
  122. 2210   GOSUB *GET_MOUSE  :IF ARG0=1 THEN NA$="illegal": RETURN
  123. 2220   NA$="Record"
  124. 2230   TMSG$="Recording" :GOSUB *WRITE_TMSG 
  125. 2240   PCMREC LOADDATA%,19200
  126. 2250   TMSG$="終了しました."
  127. 2260   GOSUB *WRITE_TMSG
  128. 2270  RETURN
  129. 2280 '
  130. 2290 '
  131. 2300 *INPUT_PCM
  132. 2310  TMSG$=" 原料を指定してください [Input File Name] ":GOSUB *WRITE_TMSG
  133. 2320   LOCATE 46,23:LINE INPUT FULLNAME$:CLS 4
  134. 2330   IF FULLNAME$="" THEN *IP_SKIP
  135. 2340   IF FULLNAME$="RECORD" OR FULLNAME$="record" THEN GOSUB *REC:GOTO *IP_SKIP
  136. 2350   LOC0=INSTR(FULLNAME$,".")
  137. 2360   IF LOC0<>0 THEN FULLNAME$=LEFT$(FULLNAME$,LOC0)+"SND" ELSE FULLNAME$=FULLNAME$+".SND"
  138. 2370   ERASE LOADDATA%:DIM LOADDATA%(50000)
  139. 2380   LOAD@ FULLNAME$,LOADDATA%
  140. 2390   NA$=FULLNAME$:GOSUB *PASS_BREAK
  141. 2400   *IP_SKIP
  142. 2410   LINE(68,356)-(150,380),PSET,%0,BF,%2
  143. 2420   SYMBOL(70,360),NA$,1,1,%15,,,1
  144. 2430   LINE(488,356)-(570,380),PSET,%0,BF,%2
  145. 2440   SYMBOL(490,360),NA$,1,1,%15,,,1
  146. 2450   CALLM  &HC9,VARPTR(LOADDATA%(0)),100000,VARPTR(SAVEDATA%(0))
  147. 2460   COUNT&=PEEK(VARPTR(LOADDATA%(6)),4)
  148. 2470   GOSUB *ERASE_TMSG
  149. 2480  RETURN
  150. 2490 '
  151. 2500 '
  152. 2510 *OUTPUT_PCM
  153. 2520   CUT_FLAG=0
  154. 2530   TMSG$=" 出荷先を指定してください [Input File Name] ":GOSUB *WRITE_TMSG
  155. 2540   LOCATE 46,23:LINE INPUT SAVENAME$:CLS 4
  156. 2550   IF SAVENAME$="" AND FULLNAME$="" THEN TMSG$="指定が無効です":GOTO *OP_SKIP
  157. 2560   IF SAVENAME$="" THEN SAVENAME$=FULLNAME$
  158. 2570   LOC0=INSTR(SAVENAME$,",")
  159. 2580   IF LOC0<>0 THEN A$=MID$(SAVENAME$,LOC0+1,1):SAVENAME$=LEFT$(SAVENAME$,LOC0-1)
  160. 2590   IF A$="C" OR A$="c" THEN CUT_FLAG=1 
  161. 2600   LOC0=INSTR(SAVENAME$,".")
  162. 2610   IF LOC0<>0 THEN SAVENAME$=LEFT$(SAVENAME$,LOC0)+"SND" ELSE SAVENAME$=SAVENAME$+".SND"
  163. 2620   IF CUT_FLAG=0 THEN SAVE@ SAVENAME$,SAVEDATA% ELSE GOSUB *CUT_SAVE
  164. 2630   TMSG$=""
  165. 2640   *OP_SKIP
  166. 2650   GOSUB *WRITE_TMSG
  167. 2660   FOR I=1 TO 1000:NEXT I:GOSUB *ERASE_TMSG
  168. 2670 RETURN
  169. 2680 '
  170. 2690 *CUT_SAVE
  171. 2700   P3&=0
  172. 2710   CALLM &H196,VARPTR(SAVEDATA%(16)),COUNT&,VARPTR(P3&)
  173. 2720   IF P3&<>0 THEN *CS1
  174. 2730   TMSG$="デ－タは全てゼロクリアされていますのでセ－ブしても意味はありません"
  175. 2740   GOSUB *WRITE_TMSG:FOR I=1 TO 10000:NEXT I
  176. 2750   RETURN
  177. 2760   *CS1:
  178. 2770   ERASE CUTSAVE%:DIM  CUTSAVE%(INT(P3&/2+17))
  179. 2780   CALLM &HC9,VARPTR(SAVEDATA%(0)),P3&+32,VARPTR(CUTSAVE%(0))
  180. 2790   POKE VARPTR(CUTSAVE%(6)),P3&,4:POKE VARPTR(CUTSAVE%(8)),0,4
  181. 2800   SAVE@ SAVENAME$,CUTSAVE%
  182. 2810   RETURN
  183. 2820 '
  184. 2830 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  185. 2840 '
  186. 2850 '
  187. 2860 *GET_MOUSE            '**/ RET. IS  arg0,arg1,arg2 is botten,X,Y    
  188. 2870   IF MOUSE (2,0) THEN ARG0=0::GOTO *M_ON
  189. 2880   IF MOUSE (2,1) THEN ARG0=1: GOTO *M_ON
  190. 2890     GOTO *GET_MOUSE
  191. 2900   *M_ON
  192. 2910   IF MOUSE(2,ARG0) THEN *M_ON
  193. 2920   ARG1=MOUSE(4,ARG0):ARG2=MOUSE(5,ARG0)
  194. 2930 RETURN
  195. 2940 '
  196. 2950 *GET_CMD_POSI 
  197. 2960   CMD_IND=0
  198. 2970   FOR I=1 TO CMD_NUM
  199. 2980     IF NOT(ARG1>CMD_EN(I,0) AND ARG1< CMD_EN(I,1)) GOTO *GET_CMD_LOOP
  200. 2990     IF ARG2>CMD_EN(I,2) AND ARG2<CMD_EN(I,3) THEN CMD_IND=I:RETURN
  201. 3000   *GET_CMD_LOOP
  202. 3010   NEXT I
  203. 3020 CMD_IND=0
  204. 3030 RETURN
  205. 3040 '
  206. 3050 *GET_ED_POSI
  207. 3060   CMD_IND=0
  208. 3070   FOR I=1 TO PARAM_NUM
  209. 3080    IF NOT(ARG1>PARAM_EN(I,0) AND ARG1< PARAM_EN(I,1)) GOTO *GET_CMD_LOOP
  210. 3090    IF ARG2>PARAM_EN(I,2) AND ARG2<PARAM_EN(I,3) THEN CMD_IND=I:RETURN
  211. 3100   *GET_CMD_LOOP
  212. 3110   NEXT I
  213. 3120 CMD_IND=0
  214. 3130 RETURN
  215. 3140 '
  216. 3150 *GET_PARAM
  217. 3160   IF CMD_IND=4 PARAM(4)=ARG1-PARAM_EN(4,0):GOTO *GP_SKIP
  218. 3170   PARAM(CMD_IND)=PARAM_EN(CMD_IND,3)-ARG2
  219. 3180   *GP_SKIP
  220. 3190   IF PARAM(CMD_IND)>95 THEN PARAM(CMD_IND)=100
  221. 3200   IF PARAM(CMD_IND)<3  THEN PARAM(CMD_IND)=0
  222. 3210   GOSUB *WRITE_PARAM
  223. 3220 RETURN
  224. 3230 '
  225. 3240 '
  226. 3250 *WRITE_ALL_CMD         '**/ (cmd_sw is color)   
  227. 3260   FOR CMD_IND=1 TO CMD_NUM
  228. 3270     GOSUB *WRITE_CMD
  229. 3280   NEXT CMD_IND
  230. 3290 RETURN
  231. 3300 '
  232. 3310 *WRITE_CMD             '**/ (cmd_ind is index, cmd_sw is color)
  233. 3320   LINE(CMD_EN(CMD_IND,0),CMD_EN(CMD_IND,2))-(CMD_EN(CMD_IND,1),CMD_EN(CMD_IND,3)),PSET,%0,BF,%2
  234. 3330   SYMBOL(CMD_P(CMD_IND,0),CMD_P(CMD_IND,1)),CMDNAMES$(CMD_IND),1,1,%CMD_SW,,,1
  235. 3340 RETURN
  236. 3350 '
  237. 3360 '
  238. 3370 *WRITE_ALL_PARAM 
  239. 3380   FOR I=1 TO PARAM_NUM
  240. 3390     GOSUB *WRITE_PARAM
  241. 3400   NEXT I
  242. 3410 RETURN 
  243. 3420 '
  244. 3430 *WRITE_PARAM         '**/ (arg. is I)
  245. 3440   LINE(PARAM_EN(I,0),PARAM_EN(I,2))-(PARAM_EN(I,1),PARAM_EN(I,3)),PSET,%0,BF,%15
  246. 3450   IF I=4 THEN LINE(PARAM_EN(I,0),PARAM_EN(I,2))-(PARAM_EN(I,0)+PARAM(I),PARAM_EN(I,3)),PSET,%0,BF,%4:RETURN
  247. 3460   LINE(PARAM_EN(I,0),PARAM_EN(I,3))-(PARAM_EN(I,1),PARAM_EN(I,3)-PARAM(I)),PSET,%0,BF,%4
  248. 3470 RETURN 
  249. 3480 '
  250. 3490 *WRITE_TMSG
  251. 3500  LINE(6,430)-(633,458),PSET,%0,BF,%15
  252. 3510  SYMBOL (17,437),TMSG$,1,1,%0,,,1
  253. 3520  RETURN
  254. 3530 '
  255. 3540 *ERASE_TMSG
  256. 3550  LINE(6,430)-(633,458),PSET,%0,BF,%15
  257. 3560  RETURN
  258. 3570 '
  259. 3580 '
  260. 3590 *PASS_BREAK
  261. 3600   LOC1=LEN(FULLNAME$):LOC0=0
  262. 3610   IF MID$(FULLNAME$,2,1)=":" THEN NA$=MID$ (FULLNAME$,3)
  263. 3620   FOR I=1 TO LOC1
  264. 3630     IF MID$ (NA$,I,1) = "\" THEN LOC0=I
  265. 3640   NEXT I
  266. 3650   NA$=MID$(NA$,LOC0+1)
  267. 3660   LOC0=INSTR(NA$,".")
  268. 3670   IF LOC0 <>0 THEN NA$=LEFT$(NA$,LOC0-1)
  269. 3680 RETURN
  270. 3690 '
  271. 3700 '
  272. 3710 '
  273. 3720 *CMDNAMES
  274. 3730  DATA "原料"    , 70,390, 65,105,388,408
  275. 3740  DATA "出荷"    ,530,390,525,565,388,408
  276. 3750  DATA "原料検査",120,152,100,200,150,170
  277. 3760  DATA " 製造"   ,300,152,280,380,150,170
  278. 3770  DATA "製品検査",480,152,460,560,150,170
  279. 3780  DATA "倒産"    , 10, 20,  5, 45, 18, 38       
  280. 3790 *PARAM_TB
  281. 3800  DATA 80,100,120,210,310
  282. 3810  DATA 80,280,300,210,310
  283. 3820  DATA 20,460,480,210,310
  284. 3830  DATA 80,485,585,290,310
  285. 3840 *COLOR
  286. 3850  DATA   0,  0,  0,  0,  0,128,200,200,200,200,200,200 
  287. 3860  DATA 128,  0,  0,128,  0,128,128,128,  0,128,128,128  
  288. 3870  DATA  64, 64, 64,  0,  0,255,  0,255,  0,  0,255,255
  289. 3880  DATA 255,  0,  0,255,  0,255,255,  0,  0,255,255,255
  290. 3890  '
  291. 3900  *ERROR
  292. 3910  IF ERR=64 THEN *ERROR1 
  293. 3920  IF ERR=53 THEN *ERROR2 
  294. 3930  GOTO *ERROR3
  295. 3940  *ERROR1
  296. 3950    TMSG$="すでにファイルがあります,オ－バ－ライトしますか"+YESNO$
  297. 3960    GOSUB *WRITE_TMSG
  298. 3970    GOSUB *GET_MOUSE
  299. 3980    IF ARG0=1 THEN RESUME NEXT ELSE KILL SAVENAME$:RESUME
  300. 3990  *ERROR2
  301. 4000    TMSG$="入出力装置に異常が発生したそうです。ファイル名を調べてください"
  302. 4010    GOSUB *WRITE_TMSG:GOSUB *GET_MOUSE
  303. 4020    NA$="":FULLNAME$=""
  304. 4030    RESUME NEXT
  305. 4040  *ERROR3:TMSG$="Error No. "+STR$(ERR)+" in "+STR$(ERL)+" マウスをクリックしてください"
  306. 4050  GOSUB *WRITE_TMSG: GOSUB *GET_MOUSE: GOSUB *ERASE_TMSG
  307. 4060 RESUME NEXT
  308. 4070 '
  309. 4080 '
  310. 4090 ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  311.