|
|
このプログラムはサウンドカード、スピーカーの性能に依存します
また、スピーカーから音自体が出ていない場合があります
スピーカーの音量にご注意ください
BEEP版
(BEEPコマンド 何Hzまで指定できるのだろう?)
!'簡易可聴域検査
LET SW=1
IF SW=0 THEN
LET XMAX=100 !'低音域
LET XMIN=10
ELSE
LET XMAX=20000 !'高音域
LET XMIN=1000
END IF
DO
LET XMID=INT((XMIN+XMAX)/2) !'2分法
DO
PRINT XMID;"Hz"
BEEP XMID,1000
INPUT PROMPT "聞こえましたか (Yes/No/Retry) ":A$
LOOP WHILE A$="R" OR A$="r"
IF SW=0 THEN
IF A$="Y" OR A$="y" THEN LET XMAX=XMID ELSE LET XMIN=XMID !'低音域
ELSE
IF A$="Y" OR A$="y" THEN LET XMIN=XMID ELSE LET XMAX=XMID !'高音域
END IF
LOOP UNTIL ABS(XMAX-XMIN)<10
PRINT "あなたの可聴域は";XMID;"Hzです"
END
---------------------------------------------------------------------------------------------------------
WAVEファイル版
LET SW=1
IF SW=0 THEN
LET XMAX=100 !'低音域
LET XMIN=10
ELSE
LET XMAX=20000 !'高音域
LET XMIN=1000
END IF
DO
LET XMID=INT((XMIN+XMAX)/2) !'2分法
DO
PRINT XMID;"Hz"
CALL MAKEWAV("TEST.wav",XMID,1)
PLAYSOUND "TEST.wav"
INPUT PROMPT "聞こえましたか (Yes/No/Retry) ":A$
LOOP WHILE A$="R" OR A$="r"
IF SW=0 THEN
IF A$="Y" OR A$="y" THEN LET XMAX=XMID ELSE LET XMIN=XMID !'低音域
ELSE
IF A$="Y" OR A$="y" THEN LET XMIN=XMID ELSE LET XMAX=XMID !'高音域
END IF
LOOP UNTIL ABS(XMAX-XMIN)<20
PRINT "あなたの可聴域は";XMID;"Hzです"
FILE DELETE "TEST.wav"
END
EXTERNAL SUB MAKEWAV(F$,FREQ,SECOND)
LET CHANNEL=1 !'モノラル
LET SAMPLEBIT=16 !'bit数
LET HEADERSIZE=16
LET WAVETYPE=1
LET SAMPLINGFREQ=48000 !'サンプリング周波数
LET SAMPLESIZE=SAMPLEBIT/8*CHANNEL
LET DATARATE = SAMPLESIZE * SAMPLINGFREQ
LET VOL=.7 !'音量
LET LEVEL=2^(SAMPLEBIT-1)*VOL
LET PCMSIZE=INT(DATARATE*SECOND)
LET WAVEFILESIZE=PCMSIZE+36
IF POS(F$,".")=0 THEN LET F$=F$&".wav"
OPEN #1:NAME F$
ERASE #1
PRINT #1:"RIFF";
PRINT #1:MKL$(WAVEFILESIZE);
PRINT #1:"WAVEfmt ";
PRINT #1:MKL$(HEADERSIZE);
PRINT #1:MKI$(WAVETYPE);
PRINT #1:MKI$(CHANNEL);
PRINT #1:MKL$(SAMPLINGFREQ);
PRINT #1:MKL$(DATARATE);
PRINT #1:MKI$(SAMPLESIZE);
PRINT #1:MKI$(SAMPLEBIT);
PRINT #1:"data";
PRINT #1:MKL$(PCMSIZE);
FOR I=0 TO INT(SAMPLINGFREQ*SECOND)-1
PRINT #1:MKI$(INT(LEVEL*SIN(FREQ*I/SAMPLINGFREQ*2*PI)));
NEXT I
CLOSE #1
END SUB
EXTERNAL FUNCTION MKI$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$
IF A<0 THEN LET A=A+65536
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(INT(A/256))
LET MKI$=A$&B$
END FUNCTION
EXTERNAL FUNCTION MKL$(A)
OPTION CHARACTER BYTE
DECLARE STRING A$,B$,C$,D$
IF A<0 THEN LET A=A+2^32
LET A$=CHR$(MOD(A,256))
LET B$=CHR$(MOD(INT(A/256),256))
LET C$=CHR$(MOD(INT(A/65536),256))
LET D$=CHR$(MOD(INT(A/16777216),256))
LET MKL$=A$&B$&C$&D$
END FUNCTION
|
|