オーディオスペクトラム画像

 投稿者：しばっち  投稿日：2018年 5月20日(日)20時13分26秒
  You Tubeを見ているとオーディオスペクトラム動画なるものを見かけることがあります。
これらの動画は専用のソフトや市販ソフトを使って作られているようです。
専用のソフト等には到底及びませんが、十進BASICでオーディオスペクトラム画像を書出します。
ここではGIFアニメではなく動画ファイル(mp4形式)として作成します。(画像サンプルを参照)

その補助ツール(メインツール!?)にffmpegを使用します。
ffmpeg.exeはコマンドラインアプリです。

https://www.ffmpeg.org

FFmpeg Buildsからwindows版 version 4.0 windows 64bit staticをダウンロードしました。


まず、WAVファイルを用意します。
WAVファイルをそのままで保存している方は少ないと思いますので
ないなら変換してWAVファイルを作成します。
想定しているWAVファイルは44.1kHzサンプリング 16bit 2チャンネルです。

この変換にffmpegが使用できます。コマンドプロンプトを起動して

mp3やflac,oggなどの音楽ファイルから

ffmpeg -i sample.mp3 sample.wav
ffmpeg -i sample.mp3 -acodec pcm_s16le -ar 44100 -ac 2 sample.wav (16bit pcm, 44.1kHz, 2channel)

mp4やmpg,flvなどの動画ファイルから

ffmpeg -i sample.flv -vn sample.wav (-vn videoなし)

ffmpeg --help とすると、簡単なヘルプが表示されます。


曲長として 4～5分程度を想定しています。ドライブ残量に気を付けてください。
5分の曲とすると

44100Hz * 16bit/8 * 2ch * 300秒 = 52920000 byte
フレームレートは30fpsを想定しています。300秒 * 30fps =9000枚の画像(jpg)を十進BASICで書き出します。

用意ができたら十進BASICを実行して、WAVファイルを読み込みます。
但し、全てのWAVファイルに対応しているわけではありません。
実行には曲長の数倍の時間がかかります。


出来上がった5桁の連番画像ファイルと音楽ファイルで、mp4ファイルに変換します。
フレームレート30fps ビデオコーデックh264 オーディオコーデックaac を指定します。

ffmpeg -r 30 -i image%05d.jpg -i sample.wav -vcodec h264 -acodec aac sample.mp4
ffmpeg -framerate 30 -i image%05d.jpg -i sample.wav -r 30 -vcodec libx264 -acodec aac sample.mp4

また、設定しだいでmpg,flvやwebmなどが作成できます。

大量に画像を作成しますので動作をテストモードにしています。
変数TESTを書き換えてください。


実際に動画作成してみました。
曲長 237.0989569161秒 画像 7112枚を出力 画像1枚あたり多くて100kB前後 少なくて20kB前後
mp4に変換すると、およそ30MB程のmp4動画ができました。
                                              (チャン! チャン!)

OPTION ARITHMETIC NATIVE
OPTION BASE 0
OPTION CHARACTER BYTE
DIM A$(20)
LET XSIZE=800    !'画像サイズ
LET YSIZE=400
LET FRAMERATE=30 !'動画フレームレート 30fps
LET DISPLAYMODE=0
!'INPUT  PROMPT "DISPLAY MODE (0 - 9)=":DISPLAYMODE
LET TEST=0        !'画像の書出し 0以外にすると画像書出し。
LET SCALE=YSIZE/XSIZE
SET TEXT BACKGROUND "OPAQUE"
FILE GETNAME F$,"WAVファイル|*.WAV"
IF F$="" THEN STOP
FILE SPLITNAME (F$) PATH$, NAME$, EXT$
OPEN #1:NAME F$,ACCESS INPUT !'wavファイル読み込み
FOR I=1 TO 12
   CHARACTER INPUT #1:A$(I)
NEXT I
IF A$(1)&A$(2)&A$(3)&A$(4)<>"RIFF" THEN
   PRINT "WAVファイルではありません"
   CLOSE #1
   STOP
END IF
LET WAVEFILESIZE=CVL(A$(5)&A$(6)&A$(7)&A$(8))
IF A$(9)&A$(10)&A$(11)&A$(12)<>"WAVE" THEN
   PRINT "WAVファイルではありません"
   CLOSE #1
   STOP
END IF
DO
   FOR I=1 TO 4
      CHARACTER INPUT #1:A$(I)
   NEXT I
   SELECT CASE A$(1)&A$(2)&A$(3)&A$(4)
   CASE "fmt "
      FOR I=1 TO 4
         CHARACTER INPUT #1:A$(I)
      NEXT I
      LET HEADERSIZE=CVL(A$(1)&A$(2)&A$(3)&A$(4))
      FOR I=1 TO HEADERSIZE
         CHARACTER INPUT #1:A$(I)
      NEXT I
      LET WAVETYPE=CVI(A$(1)&A$(2))
      IF WAVETYPE<>1 THEN
         PRINT "対応していません"
         CLOSE #1
         STOP
      END IF
      LET CHANNEL=CVI(A$(3)&A$(4))
      LET SAMPLINGFREQ=CVL(A$(5)&A$(6)&A$(7)&A$(8))
      LET DATARATE=CVL(A$(9)&A$(10)&A$(11)&A$(12))
      LET SAMPLESIZE=CVI(A$(13)&A$(14))
      LET SAMPLEBIT=CVI(A$(15)&A$(16))
   CASE "data"
      FOR I=1 TO 4
         CHARACTER INPUT #1:A$(I)
      NEXT I
      LET PCMSIZE=CVL(A$(1)&A$(2)&A$(3)&A$(4))
      LET SECOND=PCMSIZE/DATARATE
      !' LET NUM=INT(SAMPLINGFREQ*SECOND)
      LET NUM=PCMSIZE/SAMPLESIZE
      EXIT DO
   CASE "fact"
      FOR I=1 TO 8
         CHARACTER INPUT #1:A$(I)
      NEXT I
      !' LET SIZE=CVL(A$(1)&A$(2)&A$(3)&A$(4))
      !' LET SAMPLE=CVL(A$(5)&A$(6)&A$(7)&A$(8))
   CASE "LIST"
      FOR I=1 TO 4
         CHARACTER INPUT #1:A$(I)
      NEXT I
      LET SIZE=CVL(A$(1)&A$(2)&A$(3)&A$(4))
      FOR I=1 TO SIZE
         CHARACTER INPUT #1:DMY$ !'空読み
      NEXT I
   CASE ELSE
      PRINT "対応していません"
      CLOSE #1
      STOP
   END SELECT
LOOP
PRINT "ファイルサイズ ";WAVEFILESIZE;"Byte" !' データ表示
PRINT "ＷＡＶＥタイプ ";WAVETYPE
PRINT "チャンネル数 ";CHANNEL;"ch"
PRINT "サンプリング周波数 ";SAMPLINGFREQ;"Hz"
PRINT "データレート ";DATARATE;"Byte"
PRINT "ブロックサイズ ";SAMPLESIZE;"Byte"
PRINT "サンプリングビット ";SAMPLEBIT;"bit"
PRINT "ＰＣＭサイズ ";PCMSIZE;"Byte"
PRINT "データ数 ";PCMSIZE/SAMPLESIZE;INT(SAMPLINGFREQ*SECOND)
PRINT "時間 ";SECOND;"秒"
PRINT "描画モード ";DISPLAYMODE
PRINT "出力画像 ";INT(SECOND*FRAMERATE);"枚"
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
SET COLOR MIX(0) 0,0,0
SET COLOR MIX(1) 0,0,1
SET COLOR MIX(2) 1,0,0
SET COLOR MIX(3) 1,0,1
SET COLOR MIX(4) 0,1,0
SET COLOR MIX(5) 0,1,1
SET COLOR MIX(6) 1,1,0
SET COLOR MIX(7) 1,1,1
SET BITMAP SIZE XSIZE,YSIZE
LET N=INT(SAMPLINGFREQ/FRAMERATE) !'1フレームあたりのポイント数
LET NN=2^INT(LOG2(N)+1) !'FFTポイント数
DIM RMAX(NN),LR(NN),RR(NN),FR(NN),FI(NN)
LET B$="  "
FOR K=0 TO NUM-1
   FOR CH=1 TO CHANNEL
      FOR J=1 TO SAMPLEBIT/8
         CHARACTER INPUT #1:B$(J:J)
      NEXT J
      IF SAMPLEBIT=8 THEN LET DAT=ORD(B$(1:1))-128
      IF SAMPLEBIT=16 THEN LET DAT=CVI(B$)
      LET J=MOD(K,N)
      SELECT CASE CH
      CASE 1
         LET LR(J)=DAT
      CASE 2
         LET RR(J)=DAT
      CASE ELSE
      END SELECT
   NEXT CH
   IF CHANNEL=1 THEN MAT RR=LR !'モノラルならコピー
   IF K>0 AND J=0 THEN !'1フレーム描画 30フレームで1秒分
      LET COUNT=COUNT+1
      SET DRAW MODE HIDDEN !'ちらつき防止
      SELECT CASE DISPLAYMODE !'画面表示
      CASE 0
         CALL DISPLAY0
      CASE 1
         CALL DISPLAY1
      CASE 2
         CALL DISPLAY2
      CASE 3
         CALL DISPLAY3
      CASE 4
         CALL DISPLAY4
      CASE 5
         CALL DISPLAY5
      CASE 6
         CALL DISPLAY6
      CASE 7
         CALL DISPLAY7
      CASE 8
         CALL DISPLAY8
      CASE 9
         CALL DISPLAY9
      END SELECT
      SET DRAW MODE EXPLICIT
      IF TEST<>0 THEN GSAVE PATH$&"image"&RIGHT$("00000"&STR$(COUNT),5)&".jpg" !'画像書出し
   END IF
NEXT K
CLOSE #1
PRINT "ffmpeg -r";FRAMERATE;"-i ";CHR$(34);PATH$;"image%05d.jpg";CHR$(34);" -i ";CHR$(34);F$;CHR$(34);" -vcodec h264 -b:v 1000k -acodec aac -b:a 128k ";CHR$(34);PATH$;NAME$;".mp4";CHR$(34)

SUB DISPLAY1
   CALL GCLEAR
   CALL TIMER(.9,1,0,.05,2,12) !'タイマー
   CALL WAVE(RR,.51,1,.05,.95,5) !'右チャンネル(右)
   CALL WAVE(LR,0,.49,.05,.95,5) !'左チャンネル(左)
END SUB

SUB DISPLAY2
   CALL GCLEAR
   CALL TIMER(.9,1,0,.05,2,12) !'タイマー
   CALL WAVE2(LR,0,1,.6,.9,4) !'左チャンネル(上)
   CALL WAVE2(RR,0,1,.1,.4,4) !'右チャンネル(下)
END SUB

SUB DISPLAY3
   CALL GCLEAR
   CALL TIMER(.9,1,0,.05,2,12)
   CALL FREQ(LR,0,1,.6,.9,5,2) !'左チャンネル(上)
   CALL FREQ(RR,0,1,.1,.4,5,2) !'右チャンネル(下)
END SUB

SUB DISPLAY4
   CALL GCLEAR
   CALL POWER(LR,.05,.48,.05,.95,4,2,8,"MODE2","RIGHT") !'左チャンネル(左)
   CALL POWER(RR,.52,.95,.05,.95,4,2,8,"MODE2","LEFT") !'右チャンネル(右)
END SUB

SUB DISPLAY5
   CALL GCLEAR
   CALL WAVE3(LR,0,1,.6,.9,6,2) !'左チャンネル(上)
   CALL WAVE3(RR,0,1,.1,.4,6,2) !'右チャンネル(下)
END SUB

SUB DISPLAY6
   CALL GCLEAR
   CALL VOLUMEBAR(LR,.1,.9,.7,.8,4,2,"MODE2","LEFT") !'左チャンネル(上)
   CALL VOLUMEBAR(RR,.1,.9,.2,.3,4,2,"MODE2","LEFT") !'右チャンネル(下)
END SUB

SUB DISPLAY7
   CALL GCLEAR
   CALL VOLUMECIRCLE(LR,.05,.45,.1,.9,4,2) !'左チャンネル(左)
   CALL VOLUMECIRCLE(RR,.55,.95,.1,.9,4,2) !'右チャンネル(右)
END SUB

SUB DISPLAY8
   CALL GCLEAR
   CALL XYPLOT(RR,.51,1,.05,.95,7) !'右チャンネル(右)
   CALL XYPLOT(LR,0,.49,.05,.95,7) !'左チャンネル(左)
END SUB

SUB DISPLAY9
   CALL GCLEAR
   CALL POWERDISK(RR,.51,1,.05,.95,5,2,8,"MODE2") !'右チャンネル(右)
   CALL POWERDISK(LR,0,.49,.05,.95,5,2,8,"MODE2") !'左チャンネル(左)
END SUB

SUB DISPLAY0
   CALL GCLEAR
   CALL TIMER(.9,1,0,.04,2,10)
   CALL TIMEBAR(.1,.8,0,.04,3)
   CALL VOLUMEBAR(LR,.02,.49,.05,.08,1,2,"MODE2","LEFT")
   CALL POWER(LR,.02,.49,.1,.5,4,2,8,"MODE2","BOTTOM")
   CALL FREQ(LR,.02,.49,.52,.75,6,2)
   CALL WAVE(LR,.02,.49,.76,.99,5)
   CALL VOLUMEBAR(RR,.51,.98,.05,.08,1,2,"MODE2","LEFT")
   CALL POWER(RR,.51,.98,.1,.5,4,2,8,"MODE2","BOTTOM")
   CALL FREQ(RR,.51,.98,.52,.75,6,2)
   CALL WAVE(RR,.51,.98,.76,.99,5)
END SUB

SUB GCLEAR
   SET VIEWPORT 0,1,0,SCALE
   SET WINDOW 0,1,0,SCALE
   SET AREA COLOR 7
   PLOT AREA:0,0;1,0;1,SCALE;0,SCALE
END SUB

SUB TIMER(XS,XE,YS,YE,COL,HEIGHT)
   SET VIEWPORT XS,XE,YS*SCALE,YE*SCALE !'VIEWPORTの領域を長方形でも 左下(0,0) 右上(1,1)とする
   SET WINDOW XS,XE,YS,YE
   SET TEXT FONT "",HEIGHT
   SET TEXT COLOR COL
   PLOT TEXT ,AT XS,YS:RIGHT$("0"&STR$(INT(COUNT/FRAMERATE/60)),2)&":"&RIGHT$("0"&STR$(MOD(INT(COUNT/FRAMERATE),60)),2)&"."&RIGHT$("0"&STR$(MOD(COUNT,FRAMERATE)),2)
END SUB

SUB TIMEBAR(XS,XE,YS,YE,COL)
   SET VIEWPORT XS,XE,YS*SCALE,YE*SCALE
   LET XS=0
   LET XE=NUM-1
   LET YS=0
   LET YE=1
   SET WINDOW XS,XE,YS,YE
   CALL BOXFULL(XS,YS,XE,YE,0)
   CALL BOXFULL(0,0,K,1,COL)
END SUB

SUB WAVE(RR(),XS,XE,YS,YE,COL) !'波形
   SET VIEWPORT XS,XE,YS*SCALE,YE*SCALE
   LET XS=0
   LET XE=N-1
   LET YS=-2^(SAMPLEBIT-1)
   LET YE=-YS
   SET WINDOW XS,XE,YS,YE
   CALL BOXFULL(XS,YS,XE,YE,0)
   SET LINE COLOR COL
   FOR I=0 TO N-1
      PLOT LINES:I,RR(I);
   NEXT I
END SUB

SUB WAVE2(RR(),XS,XE,YS,YE,COL)
   SET VIEWPORT XS,XE,YS*SCALE,YE*SCALE
   LET XS=0
   LET XE=N-1
   LET YS=-2^(SAMPLEBIT-1)
   LET YE=-YS
   SET WINDOW XS,XE,YS,YE
   CALL BOXFULL(XS,YS,XE,YE,0)
   SET LINE COLOR COL
   FOR I=0 TO N-1
      PLOT LINES:I,-RR(I);I,RR(I)
   NEXT I
END SUB

SUB WAVE3(RR(),XS,XE,YS,YE,COL,MAXCOL)
   SET VIEWPORT XS,XE,YS*SCALE,YE*SCALE
   LET XS=0
   LET XE=N-1
   LET YE=2^(SAMPLEBIT-1)
   LET YS=0
   SET WINDOW XS,XE,YS,YE
   CALL BOXFULL(XS,YS,XE,YE,0)
   IF COUNT=1 OR MOD(COUNT,INT(FRAMERATE/2))=0 THEN !'フレームレートの半分で最大値クリア
      MAT RMAX=ZER
   END IF
   SET LINE COLOR MAXCOL
   FOR I=0 TO N-1
      PLOT LINES:I,0;I,RMAX(I)
   NEXT I
   PLOT LINES
   SET LINE COLOR COL
   FOR I=0 TO N-1
      LET R=ABS(RR(I))
      LET RMAX(I)=MAX(RMAX(I),R)
      PLOT LINES:I,0;I,R
   NEXT I
END SUB

SUB FREQ(RR(),XS,XE,YS,YE,COL,MAXCOL) !'周波数
   SET VIEWPORT XS,XE,YS*SCALE,YE*SCALE
   LET XS=0
   LET XE=NN/2-1
   LET YS=0
   LET YE=20*LOG10(2^(SAMPLEBIT-1))
   SET WINDOW XS,XE,YS,YE
   CALL BOXFULL(XS,YS,XE,YE,0)
   IF COUNT=1 OR MOD(COUNT,INT(FRAMERATE/2))=0 THEN
      MAT RMAX=ZER
   END IF
   FOR I=0 TO NN-1
      LET FR(I)=RR(I)*HANNING(I,NN) !'ハニング窓関数を掛ける
   NEXT I
   MAT FI=ZER
   CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),FR,FI) !'FFT
   SET LINE COLOR COL
   FOR I=0 TO NN/2-1
      LET R=10*LOG10(FR(I)^2+FI(I)^2+1)
      LET RMAX(I)=MAX(RMAX(I),R)
      PLOT LINES:I,R;
   NEXT I
   PLOT LINES
   SET LINE COLOR MAXCOL
   FOR I=0 TO NN/2-1
      PLOT LINES:I,RMAX(I); !'最大値描画
   NEXT I
END SUB

SUB POWER(RR(),XS,XE,YS,YE,COL,MAXCOL,LEV,MODE$,DIRECTION$) !'スペクトル
   SET VIEWPORT XS,XE,YS*SCALE,YE*SCALE
   LET P=10*LOG10(2^(SAMPLEBIT-1))
   SELECT CASE DIRECTION$
   CASE "BOTTOM"
      LET YS=0
      LET YE=P
      LET XE=NN/2-1
      LET XS=0
   CASE "TOP"
      LET YS=P
      LET YE=0
      LET XS=0
      LET XE=NN/2-1
   CASE "LEFT"
      LET XS=0
      LET XE=P
      LET YS=0
      LET YE=NN/2-1
   CASE "RIGHT"
      LET XS=P
      LET XE=0
      LET YS=0
      LET YE=NN/2-1
   END SELECT
   SET WINDOW XS,XE,YS,YE
   CALL BOXFULL(XS,YS,XE,YE,0)
   FOR I=0 TO NN-1
      LET FR(I)=RR(I)*HANNING(I,NN)
   NEXT I
   MAT FI=ZER
   CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),FR,FI)
   LET T=NN/LEV/2
   FOR I=0 TO NN/2-1 STEP T
      LET R=0
      FOR P=0 TO T-1
         LET R=R+10*LOG10(FR(I+P)^2+FI(I+P)^2+1)
      NEXT P
      LET R=R/T !'平均値
      SELECT CASE DIRECTION$
      CASE "TOP","BOTTOM"
         SELECT CASE MODE$
         CASE "MODE1"
            IF R>MAX(YS,YE)/32 THEN
               FOR Y=0 TO R STEP MAX(YS,YE)/32
                  IF Y<MAX(YS,YE)*.8 THEN CALL BOXFULL(I,Y,T*3/4+I,Y+MAX(YS,YE)/32,COL) ELSE CALL BOXFULL(I,Y,T*3/4+I,Y+MAX(YS,YE)/32,MAXCOL)
               NEXT Y
            END IF
         CASE "MODE2"
            IF R>MAX(YS,YE)/16 THEN
               FOR Y=0 TO R STEP MAX(YS,YE)/16
                  IF Y<MAX(YS,YE)*.8 THEN CALL BOXFULL(I,Y,T*3/4+I,Y+MAX(YS,YE)/16*.8,COL) ELSE CALL BOXFULL(I,Y,T*3/4+I,Y+MAX(YS,YE)/16*.8,MAXCOL)
               NEXT Y
            END IF
         END SELECT
      CASE "LEFT","RIGHT"
         SELECT CASE MODE$
         CASE "MODE1"
            IF R>MAX(XS,XE)/32 THEN
               FOR X=0 TO R STEP MAX(XS,XE)/32
                  IF X<MAX(XS,XE)*.8 THEN CALL BOXFULL(X,I,X+MAX(XS,XE)/32,T*3/4+I,COL) ELSE CALL BOXFULL(X,I,X+MAX(XS,XE)/32,T*3/4+I,MAXCOL)
               NEXT X
            END IF
         CASE "MODE2"
            IF R>MAX(XS,XE)/16 THEN
               FOR X=0 TO R STEP MAX(XS,XE)/16
                  IF X<MAX(XS,XE)*.8 THEN CALL BOXFULL(X,I,X+MAX(XS,XE)/16*.8,T*3/4+I,COL) ELSE CALL BOXFULL(X,I,X+MAX(XS,XE)/16*.8,T*3/4+I,MAXCOL)
               NEXT  X
            END IF
         END SELECT
      END SELECT
   NEXT I
END SUB


続く
 		 

Re: オーディオスペクトラム画像

 投稿者：しばっち  投稿日：2018年 5月20日(日)20時15分10秒
  > No.4559[元記事へ]

続き

SUB POWERDISK(RR(),XS,XE,YS,YE,COL,MAXCOL,LEV,MODE$)
   SET VIEWPORT XS,XE,YS*SCALE,YE*SCALE
   LET P=10*LOG10(2^(SAMPLEBIT-1))
   LET YS=-P
   LET YE=P
   LET XE=P
   LET XS=-P
   SET WINDOW XS,XE,YS,YE
   CALL BOXFULL(XS,YS,XE,YE,0)
   FOR I=0 TO NN-1
      LET FR(I)=RR(I)*HANNING(I,NN) !'ハニング窓関数を掛ける
   NEXT I
   MAT FI=ZER
   CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),FR,FI) !'FFT
   LET T=NN/LEV/2
   FOR I=0 TO NN/2-1 STEP T
      LET R=0
      FOR P=0 TO T-1
         LET R=R+10*LOG10(FR(I+P)^2+FI(I+P)^2+1) !'平均値
      NEXT P
      LET R=R/2/T
      LET TH1=I/(NN/2-1)*360
      LET TH2=TH1+(T-NN/2/32)/(NN/2)*360
      SELECT CASE MODE$
      CASE "MODE1"
         FOR Y=R TO YE/16  STEP -YE/32
            IF Y<MAX(YS,YE)/2 THEN CALL DISK(0,0,Y+YE/32,COL,TH1,TH2) ELSE CALL DISK(0,0,Y+YE/32,MAXCOL,TH1,TH2)
         NEXT Y
         CALL DISK(0,0,YE/16,7,0,360)
      CASE "MODE2"
         IF MOD(R,YE/8)<YE/16 THEN LET X=0 ELSE LET X=1
         FOR Y=INT(R/(YE/16))*(YE/16) TO YE/16 STEP -YE/16
            LET X=1-X
            IF X=1 THEN
               IF Y<MAX(YS,YE)/2 THEN CALL DISK(0,0,Y+YE/16,COL,TH1,TH2) ELSE CALL DISK(0,0,Y+YE/16,MAXCOL,TH1,TH2)
            ELSE
               CALL DISK(0,0,Y+YE/16,0,TH1,TH2)
            END IF
         NEXT Y
         CALL DISK(0,0,YE/16,7,0,360)
      END SELECT
   NEXT I
END SUB

SUB VOLUMEBAR(RR(),XS,XE,YS,YE,COL,MAXCOL,MODE$,DIRECTION$) !'音量バー
   SET VIEWPORT XS,XE,YS*SCALE,YE*SCALE
   LET P=10*LOG10(2^(SAMPLEBIT-1))
   SELECT CASE DIRECTION$
   CASE "BOTTOM"
      LET YS=0
      LET YE=P
      LET XE=1
      LET XS=0
   CASE "TOP"
      LET YS=P
      LET YE=0
      LET XS=0
      LET XE=1
   CASE "LEFT"
      LET XS=0
      LET XE=P
      LET YS=0
      LET YE=1
   CASE "RIGHT"
      LET XS=P
      LET XE=0
      LET YS=0
      LET YE=1
   END SELECT
   SET WINDOW XS,XE,YS,YE
   CALL BOXFULL(XS,YS,XE,YE,0)
   FOR I=0 TO NN-1
      LET FR(I)=RR(I)*HANNING(I,NN)
   NEXT I
   MAT FI=ZER
   CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),FR,FI)
   LET R=0
   FOR I=0 TO NN/2-1
      LET R=R+10*LOG10(FR(I)^2+FI(I)^2+1) !'平均値
   NEXT I
   LET R=R/(NN/2)
   SELECT CASE DIRECTION$
   CASE "LEFT","RIGHT"
      SELECT CASE MODE$
      CASE "MODE1"
         IF R>MAX(XS,XE)/32 THEN
            FOR X=0 TO R STEP MAX(XS,XE)/32
               IF X<MAX(XS,XE)*.8 THEN CALL BOXFULL(X,0,X+MAX(XS,XE)/32,1,COL) ELSE CALL BOXFULL(X,0,X+MAX(XS,XE)/32,1,MAXCOL)
            NEXT X
         END IF
      CASE "MODE2"
         IF R>MAX(YS,YE)/16 THEN
            FOR X=0 TO R STEP MAX(XS,XE)/16
               IF X<MAX(XS,XE)*.8 THEN CALL BOXFULL(X,0,X+MAX(XS,XE)/16*.8,1,COL) ELSE CALL BOXFULL(X,0,X+MAX(XS,XE)/16*.8,1,MAXCOL)
            NEXT X
         END IF
      END SELECT
   CASE "TOP","BOTTOM"
      SELECT CASE MODE$
      CASE "MODE1"
         IF R>MAX(YS,YE)/32 THEN
            FOR Y=0 TO R STEP MAX(YS,YE)/32
               IF Y<MAX(YS,YE)*.8 THEN CALL BOXFULL(0,Y,1,Y+MAX(YS,YE)/32,COL) ELSE CALL BOXFULL(0,Y,1,Y+MAX(YS,YE)/32,MAXCOL)
            NEXT Y
         END IF
      CASE "MODE2"
         IF R>MAX(YS,YE)/16 THEN
            FOR Y=0 TO R STEP MAX(YS,YE)/16
               IF Y<MAX(YS,YE)*.8 THEN CALL BOXFULL(0,Y,1,Y+MAX(YS,YE)/16*.8,COL) ELSE CALL BOXFULL(0,Y,1,Y+MAX(YS,YE)/16*.8,MAXCOL)
            NEXT  Y
         END IF
      END SELECT
   END SELECT
END SUB

SUB VOLUMECIRCLE(RR(),XS,XE,YS,YE,COL,MAXCOL) !'音量円形
   SET VIEWPORT XS,XE,YS*SCALE,YE*SCALE
   LET YS=-10*LOG10(2^(SAMPLEBIT-1))
   LET YE=-YS
   LET XS=-10*LOG10(2^(SAMPLEBIT-1))
   LET XE=-XS
   SET WINDOW XS,XE,YS,YE
   CALL BOXFULL(XS,YS,XE,YE,0)
   FOR I=0 TO NN-1
      LET FR(I)=RR(I)*HANNING(I,NN)
   NEXT I
   MAT FI=ZER
   CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),FR,FI)
   LET R=0
   FOR I=0 TO NN/2-1
      LET R=R+10*LOG10(FR(I)^2+FI(I)^2+1) !'平均値
   NEXT I
   LET R=R/(NN/2)/2
   IF COUNT=1 OR MOD(COUNT,INT(FRAMERATE/2))=0 THEN LET TMAX=0
   LET TMAX=MAX(TMAX,R)
   CALL CIRCLE(0,0,TMAX,MAXCOL)
   IF MOD(R,XE/8)<XE/16 THEN LET Y=0 ELSE LET Y=1
   FOR X=INT(R/(XE/16))*(XE/16) TO XE/16 STEP -XE/16
      LET Y=1-Y
      IF Y=1 THEN
         CALL CIRCLEFULL(0,0,X,COL)
      ELSE
         CALL CIRCLEFULL(0,0,X,0)
      END IF
   NEXT X
   CALL CIRCLEFULL(0,0,XE/16,7)
END SUB

SUB XYPLOT(RR(),XS,XE,YS,YE,COL) !'スペクトルと位相
   SET VIEWPORT XS,XE,YS*SCALE,YE*SCALE
   LET YS=-PI
   LET YE=PI
   LET XS=0
   LET XE=10*LOG10(2^(SAMPLEBIT-1))
   SET WINDOW XS,XE,YS,YE
   CALL BOXFULL(XS,YS,XE,YE,0)
   FOR I=0 TO NN-1
      LET FR(I)=RR(I)*HANNING(I,NN)
   NEXT I
   MAT FI=ZER
   CALL CDFT(2*NN,COS(PI/NN),SIN(PI/NN),FR,FI)
   SET COLOR COL
   FOR I=0 TO NN/2-1
      IF FR(I)<>0 OR FI(I)<>0 THEN PLOT POINTS:10*LOG10(FR(I)^2+FI(I)^2+1),ANGLE(FR(I),FI(I))
   NEXT I
END SUB
END

EXTERNAL SUB BOXFULL(X1,Y1,X2,Y2,C)
OPTION ARITHMETIC NATIVE
SET AREA COLOR C
PLOT AREA:X1,Y1;X2,Y1;X2,Y2;X1,Y2
END SUB

EXTERNAL SUB CIRCLEFULL(X,Y,RR,C)
SET COLOR C
DRAW DISK WITH SCALE(RR)*SHIFT(X,Y)
END SUB

EXTERNAL SUB CIRCLE(X,Y,R,C)
SET COLOR C
DRAW CIRCLE WITH SCALE(R)*SHIFT(X,Y)
END SUB

EXTERNAL SUB DISK(XX,YY,R,C,S,T)
OPTION ANGLE DEGREES
OPTION BASE 0
DIM X(361),Y(361)
MAT X=(XX)*CON
MAT Y=(YY)*CON
FOR TH=S TO T
   LET X(TH)=XX+R*COS(TH)
   LET Y(TH)=YY-R*SIN(TH)
NEXT  TH
SET AREA COLOR C
MAT PLOT AREA : X,Y
END SUB

EXTERNAL FUNCTION CVI(A$)
OPTION ARITHMETIC NATIVE
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A$=LEFT$(A$,2)
LET A=ORD(A$(1:1))+ORD(A$(2:2))*256
IF A>32767 THEN LET A=A-65536
LET CVI=A
END FUNCTION

EXTERNAL FUNCTION CVL(A$)
OPTION ARITHMETIC NATIVE
OPTION CHARACTER BYTE
DECLARE NUMERIC A
LET A$=LEFT$(A$,4)
LET A=ORD(A$(1:1))+ORD(A$(2:2))*256+ORD(A$(3:3))*256^2+ORD(A$(4:4))*256^3
IF A>=2^31-1 THEN LET A=A-2^32
LET CVL=A
END FUNCTION

EXTERNAL SUB CDFT(N,WR,WI,AR(),AI())
OPTION ARITHMETIC NATIVE
OPTION BASE 0
DIM A(N)
FOR I=0 TO N/2-1
   LET A(2*I)=AR(I)
   LET A(2*I+1)=AI(I)
NEXT I
LET WMR=WR
LET WMI=WI
LET M=N
DO WHILE M>4
   LET L=M/2
   LET WKR=1
   LET WKI=0
   LET WDR=1-2*WMI*WMI
   LET WDI=2*WMI*WMR
   LET SS=2*WDI
   LET WMR=WDR
   LET WMI=WDI
   FOR J=0 TO N-M STEP M
      LET I=J+L
      LET XR=A(J)-A(I)
      LET XI=A(J+1)-A(I+1)
      LET A(J)=A(J)+A(I)
      LET A(J+1)=A(J+1)+A(I+1)
      LET A(I)=XR
      LET A(I+1)=XI
      LET XR=A(J+2)-A(I+2)
      LET XI=A(J+3)-A(I+3)
      LET A(J+2)=A(J+2)+A(I+2)
      LET A(J+3)=A(J+3)+A(I+3)
      LET A(I+2)=WDR*XR-WDI*XI
      LET A(I+3)=WDR*XI+WDI*XR
   NEXT J
   FOR K=4 TO L-4 STEP 4
      LET WKR=WKR-SS*WDI
      LET WKI=WKI+SS*WDR
      LET WDR=WDR-SS*WKI
      LET WDI=WDI+SS*WKR
      FOR J=K TO N-M+K STEP M
         LET I=J+L
         LET XR=A(J)-A(I)
         LET XI=A(J+1)-A(I+1)
         LET A(J)=A(J)+A(I)
         LET A(J+1)=A(J+1)+A(I+1)
         LET A(I)=WKR*XR-WKI*XI
         LET A(I+1)=WKR*XI+WKI*XR
         LET XR=A(J+2)-A(I+2)
         LET XI=A(J+3)-A(I+3)
         LET A(J+2)=A(J+2)+A(I+2)
         LET A(J+3)=A(J+3)+A(I+3)
         LET A(I+2)=WDR*XR-WDI*XI
         LET A(I+3)=WDR*XI+WDI*XR
      NEXT J
   NEXT K
   LET M=L
LOOP
IF M>2 THEN
   FOR J=0 TO N-4 STEP 4
      LET XR=A(J)-A(J+2)
      LET XI=A(J+1)-A(J+3)
      LET A(J)=A(J)+A(J+2)
      LET A(J+1)=A(J+1)+A(J+3)
      LET A(J+2)=XR
      LET A(J+3)=XI
   NEXT J
END IF
IF N>4  THEN CALL BITRV2(N,A)
FOR I=0 TO N/2-1
   LET AR(I)=A(2*I)/SQR(N)
   LET AI(I)=A(2*I+1)/SQR(N)
NEXT I
END SUB

EXTERNAL SUB BITRV2(N,A())
OPTION ARITHMETIC NATIVE
LET M=N/4
LET M2=2*M
LET N2=N-2
LET K=0
FOR J=0 TO M2-4 STEP 4
   IF J<K THEN
      LET XR=A(J)
      LET XI=A(J+1)
      LET A(J)=A(K)
      LET A(J+1)=A(K+1)
      LET A(K)=XR
      LET A(K+1)=XI
   ELSEIF J>K THEN
      LET J1=N2-J
      LET K1=N2-K
      LET XR=A(J1)
      LET XI=A(J1+1)
      LET A(J1)=A(K1)
      LET A(J1+1)=A(K1+1)
      LET A(K1)=XR
      LET A(K1+1)=XI
   END IF
   LET K1=M2+K
   LET XR=A(J+2)
   LET XI=A(J+3)
   LET A(J+2)=A(K1)
   LET A(J+3)=A(K1+1)
   LET A(K1)=XR
   LET A(K1+1)=XI
   LET L=M
   DO WHILE K>=L
      LET K=K-L
      LET L=L/2
   LOOP
   LET K=K+L
NEXT J
END SUB

EXTERNAL FUNCTION HANNING(X,N)
OPTION ARITHMETIC NATIVE
LET  HANNING=.5-.5*COS(2*PI*X/N) !'ハニング窓関数
END FUNCTION
 

戻る