SmileBASIC

プログラムリスト

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
ページトップへ