
Program List
SU_SPEAN

Load the program from "Create Programs with SmileBASIC" on the TOP MENU, and then press the EDIT key on the keyboard to edit this program.
'======================================
'
' 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
 
