8 use List
::Util
qw(min max sum);
13 our ($dsp, $dspin, $ana);
15 our ($chan, $fmt, $rate, $sps) = (1, 8, 32768, 8);
16 our $bps = ($chan * $fmt * $rate) / 8;
17 our $buf = $bps / $sps;
19 our @avgsteps = (4, 8);
21 # How much to amplify the spectrum
24 # Rectangles cover averages in various bands. They also include averages
25 # of surrounding of the rectangle picture. E.g. with step 20, over 10,
26 # the average includes average of 20 of the covered area + 10 on each side.
30 our $draw_lines = 0; # this makes for real pretty graphs but it is a huge slowdown
35 my ($label, $fr, $frefr, $fir, $srows, $xofs, $yofs, $w, $h, $hs) = @_;
38 for my $y (0..($srows-1)) {
39 for my $x (0..($w-1)) {
40 my $hb = $yofs + $h * ($y + 1) + $hs * $y;
44 my $barh = $h * ($draw_rect ?
2/3 : 1);
45 my $bar = $h * $f[$i] * $amplifier;
46 $bar = min
($barh, $bar);
47 $canvas->createLine($xofs + $x, $hb, $xofs + $x, $hb - $bar);
49 my $refbar = $h * $frefr->[$i] * $amplifier;
50 $refbar = min
($barh, $refbar);
52 $canvas->createLine($xofs + $x, $hb - $bar, $xofs + $x, $hb - $refbar, -fill
=> 'darkred');
54 $canvas->createLine($xofs + $x, $hb - $refbar, $xofs + $x, $hb - $bar, -fill
=> 'red');
59 if ($draw_rect and !($i % $rect_step) and $i >= $rect_over and $i <= @f - $rect_step - $rect_over) {
60 my $recth = $h * ($draw_lines ?
1 : 2);
61 my $avg = $recth * $amplifier * (sum
@f[$i - $rect_over .. $i + $rect_step + $rect_over]) / ($rect_step + 2 * $rect_over);
62 $avg = min
($h, $avg);
64 $canvas->createRectangle($xofs + $x, $rhb, $xofs + $x + $rect_step, $rhb + $avg, -fill
=> 'black');
66 my $refavg = $recth * $amplifier * (sum @
{$frefr}[$i - $rect_over .. $i + $rect_step + $rect_over]) / ($rect_step + 2 * $rect_over);
67 $refavg = min
($h, $refavg);
69 $canvas->createRectangle($xofs + $x, $rhb + $avg, $xofs + $x + $rect_step, $rhb + $refavg, -fill
=> 'darkred', -outline
=> 'darkred');
71 $canvas->createRectangle($xofs + $x, $rhb + $refavg, $xofs + $x + $rect_step, $rhb + $avg, -fill
=> 'red', -outline
=> 'red');
77 $canvas->createLine($xofs + $x, $hb + 0, $xofs + $x, $hb + 5, -fill
=> 'blue');
78 $canvas->createText($xofs + $x, $hb + 15, -fill
=> 'blue', -font
=> 'small', -text
=> $fi[$i]);
82 $canvas->createText($xofs, $yofs, -fill
=> 'darkgreen', -font
=> 'small', -text
=> $label);
87 my @fi = @
{$finfo->{freqi
}};
90 my $srows = 4; # spectrum rows
91 my $w = @fi / $srows; # width
92 my $ws = 20; # spacing
94 my $hs = 20; # spacing
96 my $htot = $hs + ($h + $hs) * $srows;
100 my $arows = @avgsteps / $acols; # rows of plots; each plot is further divided to $srows rows of spectrum
102 my $ahtot = ($htot - 3 * $hs) / $arows;
103 my $ah = $ahtot / $srows - $hs;
106 $canvas = $mw->Canvas(-width
=> $ws + $w + $ws*3 + ($aw + $ws) * $acols + $ws, -height
=> $htot);
109 $canvas->delete('all');
111 render_spectrum
('now', $finfo->{freq_now
}, $finfo->{"freq_".$avgsteps[0]}, $finfo->{freqi
}, $srows, $ws, $hs, $w, $h, $hs);
112 for my $i (0..$#avgsteps) {
113 my $ax = $i % $acols;
114 my $ay = sprintf('%d', $i / $acols);
115 my $su = $avgsteps[$i];
116 render_spectrum
($su, $finfo->{"freq_$su"}, $i < $#avgsteps ?
$finfo->{"freq_".$avgsteps[$i+1]} : undef, $finfo->{freqi
}, $srows,
117 $ws + $w + $ws*3 + ($ws + $aw) * $ax,
118 ($ahtot + $hs*2) * $ay + $hs,
125 # Array with frequencies corresponding to elements of fftsig
128 my $dft_size = $rate / $sps;
129 for (my $i = 0; $i < $dft_size / 2; $i++) {
130 $freqs[$i] = $i / $dft_size * $rate;
139 $fmt == 8 or die "bits per sample must be 8";
140 while (length($bytes) > 0) {
141 my $sample = unpack('c', substr($bytes, 0, 1, ''));
142 push(@samples, $sample);
145 # Magic from Audio::Analyze:
146 my $fft = Math
::FFT
->new(\
@samples);
147 my $coeff = $fft->rdft;
148 my $size = scalar(@
$coeff);
152 $mag[$k] = sqrt($coeff->[$k*2]**2);
153 for($k = 1; $k < $size / 2; $k++) {
154 $mag[$k] = sqrt(($coeff->[$k * 2] ** 2) + ($coeff->[$k * 2 + 1] ** 2));
158 my $maxmag = max
@mag;
159 @mag = map { $_ / $maxmag } @mag;
168 my $w = $dsp->dread();
169 $finfo->{freqi
} = [fftfreq
()];
170 $finfo->{freq_now
} = [fftsig
($w)];
172 # Update floating freq. averages
173 for my $su (@avgsteps) {
174 for my $i (0..$#{$finfo->{freqi}}) {
175 my $fn = $finfo->{freq_now
}->[$i];
176 my $fs = $finfo->{"freq_$su"}->[$i];
178 $finfo->{"freq_$su"}->[$i] = ($fs * ($su - 1) + $fn) / $su;
191 $dsp = new Audio
::DSP
(buffer
=> $buf,
195 $dsp->init() || die $dsp->errstr();
198 $mw = MainWindow
->new;
200 $mw->after(1, \
&ticks
);