# A-weighted filtering
# Made by AudiTon (auditon@xs4all.nl) october 2007
# 1st order high pass and 1st order low pass sections in cascade
# result: 1. selected Sound A-weighted filtered accurately
#         2. filter available as spectrum object (complex)
#         3. function can be drawn if asked for
#         4. filter can be made by analog hardware

form A-weighted filter, made by 1st order lp and hp sections
    comment Select Sound object first!
    comment DFT is most accurate but can be slow
    choice Transfer_mode 1
    button DFT
    button FFT
    boolean Plot_filter_gain_function yes
endform

t1 = 1.30516738e-5
t2 = t1
t3 = 7.7263443e-3
t4 = t3
t5 = 1.47841175e-3
t6 = 0.21569737e-3

# make base spectrum
obj$ = selected$("Sound")
if transfer_mode = 1
    To Spectrum... no
else
    To Spectrum... yes
endif
Copy... former

# make modulus 1
Formula... 1/sqrt(2)

# filters 1 and 2 (low pass)
for i to 2
    tc= t'i'
    call lowpass
endfor

# filters 3 .. 6 (high pass)
for i from 3 to 6
    tc= t'i'
    call highpass
endfor

# lift 2 dB for normalizing 0 dB at 1000 Hz (ref. ANSI)
Formula... self*10^(2/20)

Copy... filter

# filter sound
re$="Spectrum_'obj$'[1,col]"
im$="Spectrum_'obj$'[2,col]"
select Spectrum former
call complexmult
Rename... filtered
To Sound

if plot_filter_gain_function=1
    select Spectrum filter
    # make unity gain ref. 0 dB in picture
    # When modulus = 1 then level = 94 dB SPL
    bin=Get bin width
    Formula... self*10^(-94/20)/sqrt(2*'bin')
    Draw (log freq)... 20 20000 -60 6 yes
    One mark left... 0 yes yes yes  
    # adjust level back to normal for possible more filtering
    Formula... self*10^(94/20)*sqrt(2*'bin')
endif

# end



procedure lowpass
    re$="1/(1+(2*pi*x)^2*'tc'^2)"
    im$="-2*pi*x*'tc'/(1+(2*pi*x)^2*'tc'^2)"
    call complexmult
endproc

procedure highpass
    re$="(2*pi*x)^2*'tc'^2/(1+(2*pi*x)^2*'tc'^2)"
    im$="2*pi*x*'tc'/(1+(2*pi*x)^2*'tc'^2)"
    call complexmult
endproc

procedure complexmult
    Copy... filter
    Formula... if row=1 then Spectrum_former[1,col]*'re$'-Spectrum_former[2,col]*'im$'
    ... else Spectrum_former[1,col]*'im$'+Spectrum_former[2,col]*'re$' fi
    select Spectrum former
    Remove
    select Spectrum filter
    Rename... former
endproc