プログラムリスト
SU_SPEAN
トップメニュー「SmileBASICでプログラムを作る」からプログラムを読み込み、 キーボードの「EDIT」キーを押すとこのプログラムが自由に編集できます。
'======================================
'
' FFT Example
'
' Ver.1.00 2016/02/26
'
' (C)2016 SmileBoom
'
'======================================
OPTION STRICT
VAR MODE=0
VAR WFNC=#WFHANN
VAR FFTSIZE=512
DIM FFTIN_R[FFTSIZE]
DIM FFTIN_I[FFTSIZE]
DIM FFTOUT_R[FFTSIZE]
DIM FFTOUT_I[FFTSIZE]
DIM FFTDATA[FFTSIZE/2]
DIM FFTLAST[FFTSIZE/2]
VAR FFTDATASIZE=FFTSIZE/2
'================================
DEF HSV2RGB(H,S,V)
IF H<0 THEN INC H,360
IF H>=360 THEN DEC H,360
VAR R,G,B
VAR I=FLOOR(H/60) MOD 6
VAR F=(H/60)-FLOOR(H/60)
VAR P=ROUND(V*(1-(S/255)))
VAR Q=ROUND(V*(1-(S/255)*F))
VAR T=ROUND(V*(1-(S/255)*(1-F)))
IF I==0 THEN
R=V:G=T:B=P
ELSEIF I==1 THEN
R=Q:G=V:B=P
ELSEIF I==2 THEN
R=P:G=V:B=T
ELSEIF I==3 THEN
R=P:G=Q:B=V
ELSEIF I==4 THEN
R=T:G=P:B=V
ELSEIF I==5 THEN
R=V:G=P:B=Q
ENDIF
RETURN RGB(R,G,B)
END
DEF STRETCH(V,IMIN,IMAX,OMIN,OMAX)
VAR IRANGE=IMAX-IMIN
VAR ORANGE=OMAX-OMIN
VAR IV=(MAX(V-IMIN,0))/IRANGE
RETURN MIN(OMIN+IV*ORANGE,OMAX)
END
'=========================
VAR VPAGE=0
VAR OPAGE=1
DEF SWAPGPAGE
VAR SUM=VPAGE+OPAGE
VPAGE=SUM-VPAGE
OPAGE=SUM-OPAGE
GPAGE VPAGE,OPAGE
END
'=======================
DEF SPEANA
GCLS
VAR X0=(400-256)/2
VAR Y0=220
VAR RELEASE=3
VAR I,J,K,V,MV,X,Y,C
VAR W=(400-X0*2)/FFTDATASIZE*16
K=5
FOR I=0 TO 15
J=FLOOR(POW(1.259,I)*8)
MV=0
FOR K=K+1 TO J
VAR DB=20*LOG(MAX
(FFTDATA[K]/32768,0.001),10)
DB=DB-MAX(0,(5-I)*1.5) 'CUT LOW FREQ NOISE
V=STRETCH(DB,-45,-10,0,255)
IF V>MV THEN MV=V
NEXT
MV=MAX(MV,FFTLAST[I]-RELEASE)
FFTLAST[I]=MV
X=X0+(I)*W
FOR J=0 TO 31
Y=Y0-J*6
IF STRETCH(MV,0,255,-1,32)>J THEN
VAR CH=280-STRETCH(J,0,31,0,280)
VAR CV=STRETCH(J,0,31,100,255)
C=HSV2RGB(CH,255,CV)
GFILL X,Y,X+W-2,Y-4,C
ELSE
GBOX X,Y,X+W-2,Y-4,RGB(0,0,50)
ENDIF
NEXT
NEXT
END
'=======================
DEF SPECTROGRAM2D
GCOPY VPAGE,0,0,399,239,1,0,TRUE
VAR X0=0
VAR Y0=260
VAR I,V,X,Y,CH,CV,C
FOR I=0 TO FFTDATASIZE-1
VAR DB=20*LOG(MAX(FFTDATA[I]/32768,0.001)
,10)
V=STRETCH(DB,-60,-20,0,255)
CH=280-MIN(STRETCH(V,0,255,0,280),280)
CV=STRETCH(V,0,255,20,255)
C=HSV2RGB(CH,255,CV)
X=X0
Y=Y0-I
GPSET X,Y,C
NEXT
END
'=======================
DEF SPECTROGRAM3D
GCOPY VPAGE,0,1,399,239,1,0,TRUE
VAR SI=10
VAR X0=0
VAR Y0=200
VAR I,V,X,Y,CH,CV,C
FOR I=SI TO FFTDATASIZE-1
VAR DB=20*LOG(MAX(FFTDATA[I]/32768,0.001)
,10)
V=STRETCH(DB,-60,-20,0,255)
CH=280-MIN(STRETCH(V,0,255,0,280),280)
CV=STRETCH(V,0,255,20,255)
C=HSV2RGB(CH,255,CV)
X=X0+I
Y=Y0-V/8
GLINE X,Y,X,Y0,C
NEXT
END
'=================================
DEF MICREADY LASTPOS
VAR POS,READABLE_SIZE
REPEAT
POS=MICPOS
IF POS=FFTSIZE
END
DEF MICGET POS,ARY
DIM TMP[FFTSIZE]
VAR SIZE1,SIZE2
IF (POS+FFTSIZE)<=MICSIZE THEN
MICSAVE POS,FFTSIZE,ARY
ELSE
SIZE1=MICSIZE-POS
SIZE2=FFTSIZE-SIZE1
MICSAVE POS,SIZE1,ARY
MICSAVE 0,SIZE2,TMP
COPY ARY,SIZE1,TMP,0,SIZE2
ENDIF
END
'=================================
DIM FFTW[FFTSIZE]
DEF INIT_FFT
FFTWFN FFTW,WFNC
END
DEF DO_FFT
FFT FFTOUT_R,FFTOUT_I,FFTIN_R,FFTIN_I,FFTW
VAR I,VR,VI
FOR I=0 TO FFTSIZE/2-1
VR=FFTOUT_R[I]
VI=FFTOUT_I[I]
FFTDATA[I]=SQR(VR*VR+VI*VI)*100
NEXT
END
'=================================
DIM MINFO$[3]
MINFO$[0]="SPECTRAM ANALYZER"
MINFO$[1]=" SPECTROGRAM 2D"
MINFO$[2]=" SPECTROGRAM 3D"
DEF SHOW_INFO
VAR WS$
IF WFNC==#WFRECT THEN
WS$="RECTANGULAR WINDOW"
ELSEIF WFNC==#WFHAMM THEN
WS$=" HAMMING WINDOW"
ELSEIF WFNC==#WFHANN THEN
WS$=" HANNING WINDOW"
ELSEIF WFNC==#WFBLKM THEN
WS$=" BLACKMAN WINDOW"
ENDIF
COLOR #TGREEN
LOCATE 26,28:PRINT "MODE WINDOW EXIT"
LOCATE 30,0:PRINT MINFO$[MODE]
LOCATE 29,2:PRINT WS$
END
'=================================
ACLS
SHOW_INFO
SWAPGPAGE
XON MIC
'0:8180Hz 1:10910Hz 2:16360Hz 3:32730Hz
'0:8bit 1:16bit
'0:Loop
MICSTART 3,1,0
VAR READPOS
VAR LASTPOS=0
VAR BTN,LASTBTN
VAR J
INIT_FFT
WHILE TRUE
VSYNC
MICREADY LASTPOS
READPOS=LASTPOS
LASTPOS=MICPOS
MICGET READPOS,FFTIN_R
DO_FFT
IF MODE==0 THEN
SPEANA
ELSEIF MODE==1 THEN
SPECTROGRAM2D
ELSEIF MODE==2 THEN
SPECTROGRAM3D
ENDIF
SWAPGPAGE
BTN=BUTTON(0)
IF BTN==LASTBTN THEN CONTINUE
LASTBTN=BTN
IF (BTN AND #A)!=0 THEN
GCLS
SWAPGPAGE
GCLS
MODE=(MODE+1) MOD 3
SHOW_INFO
ENDIF
IF (BTN AND #B)!=0 THEN
IF WFNC==#WFBLKM THEN
WFNC=#WFRECT 'Rectangular
ELSEIF WFNC==#WFRECT THEN
WFNC=#WFHAMM 'Hamming
ELSEIF WFNC==#WFHAMM THEN
WFNC=#WFHANN 'Hann
ELSEIF WFNC==#WFHANN THEN
WFNC=#WFBLKM 'Blackman
ENDIF
INIT_FFT
SHOW_INFO
ENDIF
IF (BTN AND #X)!=0 THEN
ACLS
XOFF MIC
END
ENDIF
WEND