aUCBLogo Demos and Tests / testfft


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 [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 [fwsize 1]
      
[   xi=(modulo 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-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-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 Int N*p/82.5
         
if (count tmp)>[tmp=items N tmp]
         
setitems 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<peak<200/[output spec]
         
y=(ln 1+p/N*300)*100-300
         
notes.i=y
         
x=(modulo 800)-400
;         setPointSize 3
         
setPixelXY x y RGB 1 0 0
;         setPointSize 1
;output spec
         
ton=floatarray N
         
tmp=abs resize Int N*p/82.5
         
if (count tmp)>[tmp=items N tmp]
         
setitems 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 [fwsize-2 1]
         
[   j=i+1
            
k=1
            
while [and (j<fwsize) 
               
((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
            
]
         
]
         
for [i fwsize-1 2 -1]
         
[   j=i-1
            
k=1
            
while [and (j>0) 
               
[((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 [fwsize-2]
         
[   j=i+1
            
k=1
            
while [and (j<fwsize) 
            
((abs notes.j-notes.i   ) < notes.i/dd)]
            
[   k=k+1
               
j=j+1
            
]
            
if 2
            
[   for [j i i+k-1]
               
[   notes.j=-300               
               
]
            
]
            
x=(modulo 800)-400
            
y=notes.i
            
yfaktor=5.67 ;5.35
            
y0=73.88 ;15
            
mem=5
            
ifelse notes.> -300
            
[   notes.i=(notes.i-y0)/yfaktor
   
;            (pr round notes.i notes.i)
   ;comment
   ;[
               
jmax=min i-mem
            
;   jmax=0
               
d=1
               
for [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-mem
            
for [jmax 1]
            
[   if (round notes.(i-j))==round notes.i
               
[   len=len+1
                  
broken=false
                  
break
               
]
            
]
            
if i<[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 [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 [fwsize-8 1]
      
[   xi=(modulo 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-abs fw.3)
         
for [level]
         
[   fw.(l+3)=analyse i N fw.(l+2A psize notes.l
         
]
;         plot x y pal.(saturateAbove psize-1 abs fw.(level+3))
         
if Key? [break]
      
]
      
for [i fwsize-fwsize 1]
      
[   for [level]
         
[   notes.l.i=-300
         
]
      
]
      
tonelist=Array level
      
for [level]
      
[   tonelist.l=filterNotes notes.l l
      
]
      
play tonelist
   
end
;   genSpectrum
   
computeNotes
end