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 [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 (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 [i 1 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 k < 2
[ for [j i i+k-1]
[ notes.j=-300
]
]
x=(modulo i 800)-400
y=notes.i
yfaktor=5.67 ;5.35
y0=73.88 ;15
mem=5
ifelse notes.i > -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