fb.pl

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use Math::FFT;
   7 use List::Util qw(min max sum);
   8 use Tk;
   9
  10 my ($devname) = @ARGV;
  11 $devname ||= 'default';
  12
  13
  14 our ($mw, $canvas, $text);
  15 our ($dsp);
  16 our ($sampleno, $sampling);
  17
  18 our ($chan, $fmt, $rate, $sps) = (1, 16, 16384, 8);
  19 our $bps = ($chan * $fmt * $rate) / 8;
  20 our $buf = $bps / $sps;
  21
  22 our @avgsteps = (2, 4);
  23
  24 # How much to amplify the spectrum
  25 our $amplifier = 1;
  26
  27 # Rectangles cover averages in various bands. They also include averages
  28 # of surrounding of the rectangle picture. E.g. with step 20, over 10,
  29 # the average includes average of 20 of the covered area + 10 on each side.
  30 our $rect_step = 10;
  31 our $rect_over = 5;
  32
  33 our $draw_lines = 0; # this makes for real pretty graphs but it is a huge slowdown
  34 our $draw_rect = 1;
  35
  36
  37 sub render_spectrum {
  38         my ($finfo, $label, $reflabel, $fir, $srows, $xofs, $yofs, $w, $h, $hs) = @_;
  39         my @fi = @$fir;
  40         my @f = @{$finfo->{"freq_$label"}};
  41         my @fref; defined $reflabel and @fref = @{$finfo->{"freq_$reflabel"}};
  42         my @r = @{$finfo->{"rect_$label"}};
  43         my @rref; defined $reflabel and @rref = @{$finfo->{"rect_$reflabel"}};
  44         for my $y (0..($srows-1)) {
  45                 for my $x (0..($w-1)) {
  46                         my $hb = $yofs + $h * ($y + 1) + $hs * $y;
  47                         my $i = $w * $y + $x;
  48
  49                         if ($draw_lines) {
  50                                 my $barh = $h * ($draw_rect ? 2/3 : 1);
  51                                 my $bar = $h * $f[$i] * $amplifier;
  52                                 $bar = min ($barh, $bar);
  53                                 $canvas->createLine($xofs + $x, $hb, $xofs + $x, $hb - $bar);
  54                                 if (defined $reflabel) {
  55                                         my $refbar = $h * $fref[$i] * $amplifier;
  56                                         $refbar = min ($barh, $refbar);
  57                                         if ($refbar > $bar) {
  58                                                 $canvas->createLine($xofs + $x, $hb - $bar, $xofs + $x, $hb - $refbar, -fill => 'darkred');
  59                                         } else {
  60                                                 $canvas->createLine($xofs + $x, $hb - $refbar, $xofs + $x, $hb - $bar, -fill => 'red');
  61                                         }
  62                                 }
  63                         }
  64
  65                         if ($draw_rect and !($i % $rect_step) and $i >= $rect_over and $i <= @f - $rect_step - $rect_over) {
  66                                 my $recth = $h * ($draw_lines ? 2/3 : 1);
  67                                 my $avg = $recth * $amplifier * $r[$i / $rect_step];
  68                                 $avg = min ($h, $avg);
  69                                 my $rhb = $hb - $h;
  70                                 $canvas->createRectangle($xofs + $x, $rhb, $xofs + $x + $rect_step, $rhb + $avg, -fill => 'black');
  71                                 if (defined $reflabel) {
  72                                         my $refavg = $recth * $amplifier * $rref[$i / $rect_step];
  73                                         $refavg = min ($h, $refavg);
  74                                         if ($refavg > $avg) {
  75                                                 $canvas->createRectangle($xofs + $x, $rhb + $avg, $xofs + $x + $rect_step, $rhb + $refavg, -fill => 'darkred', -outline => 'darkred');
  76                                         } else {
  77                                                 $canvas->createRectangle($xofs + $x, $rhb + $refavg, $xofs + $x + $rect_step, $rhb + $avg, -fill => 'red', -outline => 'red');
  78                                         }
  79                                 }
  80                         }
  81
  82                         if (!($x % ($w/4))) {
  83                                 $canvas->createLine($xofs + $x, $hb + 0, $xofs + $x, $hb + 5, -fill => 'blue');
  84                                 $canvas->createText($xofs + $x, $hb + 15, -fill => 'blue', -font => 'small', -text => $fi[$i]);
  85                         }
  86                 }
  87         }
  88         $canvas->createText($xofs, $yofs, -fill => 'darkgreen', -font => 'small', -text => $label);
  89 }
  90
  91 sub render {
  92         my ($finfo) = @_;
  93         my @fi = @{$finfo->{freqi}};
  94
  95         # main plot
  96         my $srows = 32/$sps; # spectrum rows; "density" of data depends on sps
  97         my $w = @fi / $srows; # width
  98         my $ws = 20; # spacing
  99         my $h = 150; # height
 100         my $hs = 20; # spacing
 101
 102         my $htot = $hs + ($h + $hs) * $srows;
 103
 104         # averages plots
 105         my $acols = 1;
 106         my $arows = @avgsteps / $acols; # rows of plots; each plot is further divided to $srows rows of spectrum
 107         my $aw = $w;
 108         my $ahtot = ($htot - 3 * $hs) / $arows;
 109         my $ah = $ahtot / $srows - $hs;
 110
 111         unless ($canvas) {
 112                 $canvas = $mw->Canvas(-width => $ws + $w + $ws*3 + ($aw + $ws) * $acols + $ws, -height => $htot);
 113                 $canvas->pack;
 114         }
 115         $canvas->delete('all');
 116
 117         render_spectrum($finfo, 'now', $avgsteps[0], $finfo->{freqi}, $srows, $ws, $hs, $w, $h, $hs);
 118         for my $i (0..$#avgsteps) {
 119                 my $ax = $i % $acols;
 120                 my $ay = sprintf('%d', $i / $acols);
 121                 my $su = $avgsteps[$i];
 122                 render_spectrum($finfo, $su, $i < $#avgsteps ? $avgsteps[$i+1] : undef, $finfo->{freqi}, $srows,
 123                                 $ws + $w + $ws*3 + ($ws + $aw) * $ax,
 124                                 ($ahtot + $hs*2) * $ay + $hs,
 125                                 $aw, $ah, $hs);
 126         }
 127
 128         $mw->update();
 129 }
 130
 131 sub getdata {
 132         my $w;
 133         read $dsp, $w, $buf or die "arecord read: $!";
 134         return $w;
 135 }
 136
 137 # Array with frequencies corresponding to elements of fftsig
 138 sub fftfreq {
 139         my @freqs;
 140         my $dft_size = $rate / $sps;
 141         for (my $i = 0; $i < $dft_size / 2; $i++) {
 142                 $freqs[$i] = $i / $dft_size * $rate;
 143         }
 144         return @freqs;
 145 }
 146
 147 sub fftsig {
 148         my ($bytes) = @_;
 149
 150         my @samples;
 151         if ($fmt == 8) {
 152                 while (length($bytes) > 0) {
 153                         my $sample = unpack('c', substr($bytes, 0, 1, ''));
 154                         push(@samples, $sample);
 155                 }
 156         } elsif ($fmt == 16) {
 157                 while (length($bytes) > 0) {
 158                         my $sample = unpack('s<', substr($bytes, 0, 2, ''));
 159                         push(@samples, $sample);
 160                 }
 161         } else {
 162                 die "unsupported $fmt bits per sample\n";
 163         }
 164
 165         # Magic from Audio::Analyze:
 166         my $fft = Math::FFT->new(\@samples);
 167         my $coeff = $fft->rdft;
 168         my $size = scalar(@$coeff);
 169         my $k = 0;
 170         my @mag;
 171
 172         $mag[$k] = sqrt($coeff->[$k*2]**2);
 173         for($k = 1; $k < $size / 2; $k++) {
 174                 $mag[$k] = sqrt(($coeff->[$k * 2] ** 2) + ($coeff->[$k * 2 + 1] ** 2));
 175         }
 176
 177         # Rescale to 0..1
 178         my $avgmag = sum (@mag) / @mag; #[1000..$#mag];
 179         @mag = map { $_ / $avgmag * 0.3 } @mag;
 180         return @mag;
 181 }
 182
 183 sub rectsof {
 184         my ($finfo, $l) = @_;
 185         my @f = @{$finfo->{"freq_$l"}};
 186         my @r;
 187         for (my ($fi, $ri) = ($rect_step, 1); $fi <= $#f - $rect_step - $rect_over; $fi += $rect_step, $ri++) {
 188                 $r[$ri] = sum (@f[$fi - $rect_over .. $fi + $rect_step + $rect_over]) / ($rect_step + 2 * $rect_over);
 189         }
 190         $finfo->{"rect_$l"} = \@r;
 191 }
 192
 193 sub ticks {
 194         my $s = 0;
 195         my $finfo;
 196
 197         while (1) {
 198                 my $w = getdata();
 199                 defined $sampling and $sampling .= $w;
 200                 $finfo->{freqi} = [fftfreq()];
 201                 $finfo->{freq_now} = [fftsig($w)];
 202
 203                 # Create averaged rects
 204                 rectsof($finfo, 'now');
 205
 206                 # Update floating freq. averages
 207                 for my $su (@avgsteps) {
 208                         for my $i (0..$#{$finfo->{freqi}}) {
 209                                 my $fn = $finfo->{freq_now}->[$i];
 210                                 my $fs = $finfo->{"freq_$su"}->[$i];
 211                                 $fs ||= $fn;
 212                                 $finfo->{"freq_$su"}->[$i] = ($fs * ($su - 1) + $fn) / $su;
 213                         }
 214                         rectsof($finfo, $su);
 215                 }
 216
 217                 render($finfo);
 218
 219                 $mw->idletasks();
 220
 221                 $s++;
 222         }
 223 }
 224
 225
 226 sub recStart {
 227         if (defined $sampling) {
 228                 recCancel();
 229                 return;
 230         }
 231         $sampleno++;
 232         $sampling = '';
 233         $text->delete('all');
 234         $text->createText(0, 20, -anchor => 'nw', -font => 'Small', -text => "Recording $sampleno", -fill => 'red');
 235 }
 236
 237 sub recCancel {
 238         $sampleno--;
 239         $sampling = undef;
 240         $text->delete('all');
 241 }
 242
 243 sub recSave {
 244         open my $fh, '>'.sprintf('sample-%04d.raw', $sampleno) or die "$!";
 245         print $fh $sampling;
 246         close $fh;
 247         $sampling = undef;
 248         $text->delete('all');
 249 }
 250
 251
 252 # '-c', $chan,
 253 print join(' ', 'arecord', '-D', $devname, '-t', 'raw', '-r', $rate, '-f', 'S'.$fmt)."\n";
 254 open ($dsp, '-|', 'arecord', '-D', $devname, '-t', 'raw', '-r', $rate, '-f', 'S'.$fmt) or die "arecord: $!";
 255 use IO::Handle;
 256 $dsp->autoflush(1);
 257
 258 $mw = MainWindow->new;
 259 $mw->bind('<space>' => \&recStart);
 260 $mw->bind('<Escape>' => \&recCancel);
 261 $mw->bind('<Return>' => \&recSave);
 262 $text = $mw->Canvas(-width => 400, -height => 40);
 263 $text->pack;
 264
 265 $mw->after(1, \&ticks);
 266 MainLoop;