aUCBLogo Demos and Tests / testfft2
be testfft2
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
;"D:/Users/AndreasM/Musik/hallo.wav
;"D:/Users/AndreasM/Musik/Supertramp - The Logical Song.wav
; playWave wav 1+4
; compile [getRightChannelPart wav 1]
wavori=getRightChannelPart wav 1 ;1/5
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.98 ;*0.48 ;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
[ updateGraph
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 N (PowerSpectrum w)
; fw=fw * hp*hp*hp * tp*tp*tp*tp*tp*tp*tp*tp
fw=fw * hp*hp*hp * tp*tp*tp*tp*tp*tp*tp*tp
fwav.i=(Int16Array abs fw)
plot x y pal.(saturateAbove psize-1 fwav.i)
updateGraph
GC
if Key? [break]
]
updateGraph
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 volumes
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
volumes.i=0
if or p<1 peak<5 [output spec]
y=(ln 1+p/N*300)*100-300
notes.i=y
volumes.i=peak
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 volumes 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=2
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
[ ifelse i > len
[ vol=(0+items i-len i volumes)/40/len
][ vol=0
]
tonelist=(se tonelist
round notes.(i-1)+55 len*tempo Int vol)
(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 0
]
; for [l 1 level]
; [ (MidiOutStream l tonelist.l)
; ]
MidiOutStreams tonelist
MidiOutStreamsStart
]
end
fwav=loadArrayOfI16A "D:/temp/tmp.dat
fwsize=count fwav
hideTurtle
norefresh
setUpdateGraph false
clearScreen
clearText
WindowMode
setPointSize 2
pal=genPalette
psize=count pal
N=600
level=1 ;15
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
volumes=Array level
repeat level
[ notes.repcount=FloatArray fwsize
volumes.repcount=FloatArray fwsize
]
for [i 1 fwsize-8 1]
[ xi=(modulo i 800)-400
if xi==-400
[ updateGraph
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 volumes.l
]
; plot x y pal.(saturateAbove psize-1 abs fw.(level+3))
if Key? [break]
]
updateGraph
for [i fwsize-7 fwsize 1]
[ for [l 1 level]
[ notes.l.i=-300
volumes.l.i=0
]
]
tonelist=Array level
for [l 1 level]
[ tonelist.l=filterNotes notes.l volumes.l l
]
play tonelist
refresh
output tonelist
end
be convert_g2n in [addNote 0][volume 127]
out=[]
stab=Table
[ E -17
a -12
d -7
g -2
h 2
e 7
]
s="g
len=1
note=256
while [in != []]
[ n=first in
ifelse Number? n
[ out=(se out note len*tempo volume)
note=s+n+addNote
len=1
][ while [(first n)==".]
[ len=len+1
n=butFirst n
]
if not empty? n
[ s=stab.n
]
]
in=butfirst in
]
out=(se out note len*tempo volume)
output out
end
be drawLines
p0=Pos
for [i 0 4]
[ right 90
PenDown
forward 800
PenUp
back 800
left 90
forward lineSpacing
]
setPos p0
end
be newline
setX -380
back lineSpacing*10
drawLines
end
be drawNotes notes base with_Bs tonart
; ct
; show notes
if empty? notes [stop]
ntab#=Table
[
-24 -14
-23 #-14
-22 -13
-21 -12
-20 #-12
-19 -11
-18 #-11
-17 -10
-16 -9
-15 #-9
-14 -8
-13 #-8
-12 -7
-11 #-7
-10 -6
-9 -5
-8 #-5
-7 -4
-6 #-4
-5 -3
-4 -2
-3 #-2
-2 -1
-1 #-1
0 0
1 #0
2 1
3 2
4 #2
5 3
6 #3
7 4
8 5
9 #5
10 6
11 #6
12 7
13 #7
14 8
15 9
16 #9
17 10
18 #10
19 11
20 12
21 #12
22 13
23 #13
]
ntabB=Table
[
-12 -7
-11 b-6
-10 -6
-9 -5
-8 b-4
-7 -4
-6 b-3
-5 -3
-4 -2
-3 b-1
-2 -1
-1 b0
0 0
1 b1
2 1
3 2
4 b3
5 3
6 b4
7 4
8 5
9 b6
10 6
11 b7
12 7
13 b8
14 8
15 9
16 b10
17 10
18 b11
19 11
20 12
21 b13
22 13
23 b14
]
ntab=ifelse with_Bs [ntabB][ntab#]
be octaves t
output (se t t-12 t+12 t-24)
end
b=1
es=6
as=11
des=4
ges=9
ces=3
fes=7
btab=Table 7
btab'F=b
btab'B=(se b es)
btab'Es=(se b es as)
btab'As=(se b es as des)
btab'Des=(se b es as des ges)
btab'Ges=(se b es as des ges ces)
btab'Ces=(se b es as des ges ces fes)
fis=9
cis=4
gis=11
dis=6
ais=1
eis=8
his=4
stab=Table 7
stab'G=fis
stab'D=(se fis cis)
stab'A=(se fis cis gis)
stab'E=(se fis cis gis dis)
stab'H=(se fis cis gis dis ais)
stab'Fis=(se fis cis gis dis ais eis)
stab'Cis=(se fis cis gis dis ais eis his)
newline
foreach btab.tonart
[ n=ntab.?
if (first n)=="b
[ b=true
n=butFirst n
]
p0=Pos
forward (n+3)*lineSpacing/2
right 90
PenDown
label "b
PenUp
setPos p0
forward noteSpacing*0.7
left 90
]
foreach stab.tonart
[ n=ntab.?
if (first n)=="#
[ sharp=true
n=butFirst n
]
p0=Pos
forward (n+3)*lineSpacing/2
right 90
PenDown
label "#
PenUp
setPos p0
forward noteSpacing*0.7
left 90
]
right 90
forward noteSpacing
left 90
btab'F=octaves btab'F
btab'B=octaves btab'B
btab'Es=octaves btab'Es
btab'As=octaves btab'As
btab'Des=octaves btab'Des
btab'Ges=octaves btab'Ges
btab'Ces=octaves btab'Ces
stab'G=octaves stab'G
stab'D=octaves stab'D
stab'A=octaves stab'A
stab'E=octaves stab'E
stab'H=octaves stab'H
stab'Fis=octaves stab'Fis
stab'Cis=octaves stab'Cis
n=0
if (first notes) > 255
[ notes=butFirst butFirst butFirst notes
]
while [not empty? notes]
[ p0=Pos
no=n
n=first notes
notes=butFirst notes
len=first notes
nn=base+modulo (n-base) 12
nq=7*int (n-base)/12
n=ntab.nn
;(type n " )
sharp=false
aufloes=false
ifelse (first n)=="#
[ sharp=true
n=butFirst n
if member? nn stab.tonart
[ sharp=false
ston=true
]
][
if member? nn+1 stab.tonart
[ aufloes=true
]
]
b=false
ifelse (first n)=="b
[ b=true
n=butFirst n
if member? nn btab.tonart
[ b=false
bton=true
]
][
if member? nn-1 btab.tonart
[ aufloes=true
]
]
forward (n+nq+3)*lineSpacing/2
extraSpace=0
if sharp or2 b or2 aufloes
[ right 90
PenDown
if sharp [label "#]
if b [label "b]
if aufloes [label "%]
PenUp
forward noteSpacing*0.7
left 90
extraSpace=noteSpacing
]
PenDown
circle lineSpacing/3
right 90
setPenSize 3
forward noteSpacing*len/70/3
setPenSize 0
left 90
PenUp
setPos p0
right 90
forward noteSpacing*(0.5+len/70/4)+extraSpace
left 90
if xCor > 400-noteSpacing*2
[ newline
]
if key? [break]
notes=butFirst butFirst notes
]
updateGraph
end
be drawStrings
p0=Pos
for [i 1 6]
[ right 90
PenDown
Label [E A D g h e].i
ops=first PenSize
setPenSize 0
forward 800
setPenSize ops
PenUp
back 800
left 90
forward stringSpacing
]
setPos p0
end
be drawGit in addNote
newstrings
stab=Table
[ E 0
a 1
d 2
g 3
h 4
e 5
]
len=1
s=3
snew=3
note=0
while [in != []]
[ n=first in
ifelse Number? n
[ if number? s
[ p0=Pos
forward s*stringSpacing
right 90
PenDown
label note
PenUp
setPos p0
forward noteSpacing*1.7
left 90
s=snew
]
note=n+addNote
len=1
][ while [(first n)==".]
[ len=len+1
n=butFirst n
]
if not empty? n and2 not number? n
[ snew=stab.n
]
]
if xCor > 400-noteSpacing*2
[ newstrings
]
in=butFirst in
]
if number? s
[ p0=Pos
forward s*stringSpacing
right 90
PenDown
label note
PenUp
setPos p0
forward noteSpacing*1.7
left 90
s=snew
]
end
be newstrings
setX -380
back stringSpacing*10
drawStrings
end
be drawMyNotes tonelist
notes=[g]
reducetempo=70
repeat (count tonelist)/3
[ i=repcount
ifelse tonelist.(i*3-2) < 255 and2 tonelist.(i*3) > 20
[ len="
repeat Int tonelist.(i*3-1)/reducetempo
[ len=(lput ". len)
]
notes=(lput tonelist.(i*3-2)-53 lput len notes)
][ len="
repeat Int tonelist.(i*3-1)/reducetempo
[ len=(lput ". len)
]
notes=(lput len notes)
]
]
pr notes
tr=0
tonart="F
WindowMode
tempo=70
setScreenRange -400 -400*4/3 400 400*4/3
clearScreen
PenUp
hideTurtle
disableRoundLineEnds
setLabelSize [1 1]*lineSpacing*2
setPenColor 0
setXY -380 500
drawTheGit=false
; drawTheGit=true
if drawTheGit
[ drawGit notes tr
]
drawTheNotes=false
drawTheNotes=true
if drawTheNotes
[ drawNotes (convert_g2n notes -12+tr) 7 true tonart
]
drawTheNotesSax=false
; drawTheNotesSax=true
tonart2="D
if drawTheNotesSax
[ drawNotes (convert_g2n notes -12+tr-3) 11 false tonart2
]
updateGraph
melo=(convert_g2n notes 55+tr)
useMidi=false
useMidi=true
if useMidi
[ MidiOpen 0
MidiProgramChange 0 0
MidiProgramChange 1 32
MidiProgramChange 2 24
MidiProgramChange 3 24
(MidiOutStream 0 melo)
MidiOutStreamsStart
]
end
; genSpectrum
tonelist=computeNotes
lineSpacing=10
noteSpacing=15
stringSpacing=12
tempo=70
drawMyNotes tonelist.1
end