be testfft be loadWav f local [size wav] openReadBin f setReader f size=fileSize f wav=readInt16ArrayBin size/2 setReader [] close f ; (pr f "loaded) output wav end be plot x y c PenUp setXY -400 0 PenDown setPixelXY x y IntArray c PenUp end be getRightChannel in s=int (count in)/2 out=IntArray s repeat s [ i=repcount out.i=in.(i*2) ] output out end be getRightChannelPart in part local [s out i] s=int (count in)/2*part-1 out=IntArray s repeat s [ i=repcount out.i=in.(i*2+1) ] output out end be saveArrayOfI16A a f openWriteBin f setWriter f typeBin Int count a typeBin Int count a.1 repeat count a [ typeBin a.repcount ] setWriter [] close f end be loadArrayOfI16A f local [a asize isize] openReadBin f setReader f asize=readIntBin a=Array asize isize=readIntBin repeat asize [ i=repcount a.i=readInt16ArrayBin isize ] setReader [] close f ; (pr f "loaded) output a end be saveArray a f openWriteBin f setWriter f typeBin Int count a typeBin a setWriter [] close f end be loadI16A f local [a asize] openReadBin f setReader f asize=readIntBin a=readInt16ArrayBin asize setReader [] close f output a end be genPalette psize=1000 pal=(IntArray psize 0) repeat psize [ i=repcount-1 pal.i=HSBA i/psize*300 1 1 (i/psize)^0.5 ] output pal end be genSpectrum wav=loadWav ;"D:/Users/AndreasM/Musik/scales.wav ;"D:/Users/AndreasM/Musik/scale_down.wav ;"D:/Users/AndreasM/Musik/19-05-2007_melody.wav "D:/Users/AndreasM/Musik/19-05-2007.wav ; playWave wav 1+4 ; compile [getRightChannelPart wav 1] wavori=getRightChannelPart wav 1 hideTurtle WindowMode norefresh clearScreen setPointSize 2 fftSize=int 2^14 wav=Int16Array (count wavori)+fftsize*2 setItems fftsize wav wavori win=FloatArray fftSize for [i 1 fftSize] [ win.i=exp -sqr (i-fftSize/2)/fftSize*4 ] size=(count wav)*0.99 ;/10 ;12*11.9 ;*0.95 pal=genPalette psize=count pal N=600 fwsize=800*10 ;*11.9 fwav=Array fwsize hp=(rSeqFA 0 1 N) tp=(rSeqFA 1 0.1 N) for [i 1 fwsize 1] [ xi=(modulo i 800)-400 if xi==-400 [clearScreen] x=rseqFA xi xi N y=(ln rseqFA 1 300 N)*100-300 wi=16+Int (i-1)/fwsize*size ;+size/2 w=(lowPassFilter FloatArray items wi wi+fftSize-1 wav 5)*win ; fw=items 1 600 (FFT w) fw=items 1 600 (PowerSpectrum w) fw=fw * hp*hp*hp * tp*tp*tp*tp*tp*tp*tp*tp fwav.i=(Int16Array abs fw) ;/5 plot x y pal.(saturateAbove psize-1 fwav.i) updateGraph GC if Key? [break] ] refresh saveArrayOfI16A fwav "D:/temp/tmp.dat end be computeNotes be removeTon p i N spec A psize local [y] y=(ln 1+p/N*300)*100-300 ton=floatarray N tmp=resize A Int N*p/82.5 if (count tmp)>N [tmp=items 1 N tmp] setitems 1 ton tmp ton=ton/(max ton) nspec=spec/(max spec) output Int16Array saturateAbove psize-1 abs spec-int16array (floatArray spec)*(ton*nspec)/(0+ton*ton) end be analyse i N spec A psize notes local [x y] ; peak=(max spec) ; p1=MaximumPosition+20 p1=10 ; if p1 < 1 [p1=N] peak=(max items p1 N spec) p2=MaximumPosition p=p1-1+p2-1 notes.i=-300 if or p<1 peak<200/l [output spec] y=(ln 1+p/N*300)*100-300 notes.i=y x=(modulo i 800)-400 ; setPointSize 3 setPixelXY x y RGB 1 0 0 ; setPointSize 1 ;output spec ton=floatarray N tmp=abs resize A Int N*p/82.5 if (count tmp)>N [tmp=items 1 N tmp] setitems 1 ton tmp ton=ton/(max ton) mspec=(max spec) nspec=spec/mspec output Int16Array saturateAbove psize-1 abs spec-int16array ((sqrt nspec)*sqrt ton)*mspec output Int16Array saturateAbove psize-1 abs spec-int16array (floatArray spec)*(ton*nspec)/(0+ton*ton) end be filterNotes notes l local [tonelist] setPointSize 3 dd=35 for [i 1 fwsize-2 1] [ j=i+1 k=1 while [and (j0) [((abs notes.j-notes.i/k) < notes.i/k/dd) ]] [ notes.i=notes.i+notes.j k=k+1 j=j-1 ] notes.i=notes.i/k for [j i i-k+1] [ notes.j=notes.i ] ] tonelist=[] len=0 tempo=10*10/10 for [i 1 fwsize-2] [ j=i+1 k=1 while [and (j -300 [ notes.i=(notes.i-y0)/yfaktor ; (pr round notes.i notes.i) ;comment ;[ jmax=min i-1 mem ; jmax=0 d=1 for [j 1 jmax 1] [ if (abs (notes.i)-12-(notes.(i-j))) < d [ notes.i=notes.i-12 break ] if (abs (notes.i)+12-(notes.(i-j))) < d [ notes.i=notes.i+12 break ] if (abs (notes.i)-20-(notes.(i-j))) < d [ notes.i=notes.i-20 break ] if (abs (notes.i)+20-(notes.(i-j))) < d [ notes.i=notes.i+20 break ] if (abs (notes.i)-24-(notes.(i-j))) < d [ notes.i=notes.i-24 break ] if (abs (notes.i)+24-(notes.(i-j))) < d [ notes.i=notes.i+24 break ] ] ;] y=(round notes.i)*yfaktor+y0 setPixelXY x y RGB 0 0 0 ][ notes.i=200 ] broken=true jmax=min i-1 mem for [j 1 jmax 1] [ if (round notes.(i-j))==round notes.i [ len=len+1 broken=false break ] ] if i<5 [broken=false len=len+1] if broken [ tonelist=(se tonelist round notes.(i-1)+55 len*tempo Int 127*0.8^l) (pr round notes.(i-1) "\ notes.(i-1) "\ len) if notes.(i-1) != 200 [ y=(round notes.(i-1))*yfaktor+y0 pu setXY x y setpc RGB 1 1 1 setPenSize 1 pd setXY x-len y pu ] len=1 ] ] i=fwsize-2 tonelist=(se tonelist round notes.(i-1)+55 len*tempo Int 127*0.8^l) (pr round notes.(i-1) "\ notes.(i-1) "\ len) if notes.(i-1) != 200 [ y=(round notes.(i-1))*yfaktor+y0 pu setXY x y setpc RGB 1 1 1 setPenSize 1 pd setXY x-len y pu ] setPointSize 1 updateGraph refresh output FloatArray tonelist end be play tonelist useMidi=false useMidi=true if useMidi [ MidiOpen 0 level=count tonelist for [i 1 level] [ MidiProgramChange i-1 24 ] ; for [l 1 level] ; [ (MidiOutStream l tonelist.l) ; ] MidiOutStreams tonelist MidiOutStreamsStart ] end fwav=loadArrayOfI16A "D:/temp/tmp.dat fwsize=count fwav hideTurtle norefresh clearScreen clearText WindowMode setPointSize 2 pal=genPalette psize=count pal N=600 level=10 A=Int16Array lowPassFilter (fwav.799+fwav.798+fwav.797+fwav.796+fwav.795)/5.05 5 ; saveArray A "testfft_A.dat A=loadI16A "testfft_A.dat m=(Max A) pr MaximumPosition ; A=Int16Array lowPassFilter A 3 notes=Array level repeat level [ notes.repcount=FloatArray fwsize ] for [i 1 fwsize-8 1] [ xi=(modulo i 800)-400 if xi==-400 [clearScreen] x=rseqFA xi xi N y=(ln rseqFA 1 300 N)*100-300 fw=Array level+3 fw.1=Int16Array (saturateBelow 10 lowPassFilter (fwav.i +fwav.(i+1);)/2.02 +fwav.(i+2)+fwav.(i+3)+fwav.(i+4) +fwav.(i+5)+fwav.(i+6)+fwav.(i+7))/8.05 0 )-10 ; fw.1=fwav.i ; fw.2=removeTon 22.125 i N fw.1 A psize ; fw.3=removeTon 43.25 i N fw.2 A psize fw.3=fw.1 plot x y pal.(saturateAbove psize-1 abs fw.3) for [l 1 level] [ fw.(l+3)=analyse i N fw.(l+2) A psize notes.l ] ; plot x y pal.(saturateAbove psize-1 abs fw.(level+3)) if Key? [break] ] for [i fwsize-7 fwsize 1] [ for [l 1 level] [ notes.l.i=-300 ] ] tonelist=Array level for [l 1 level] [ tonelist.l=filterNotes notes.l l ] play tonelist end ; genSpectrum computeNotes end