Dogs
[fluffyball.git] / fb-simple.pl
blob9fbcaa4538bb44290952f0a1716d3ea32c2a1952
1 #!/usr/bin/perl
3 use warnings;
4 use strict;
6 init_dsp(); init_fft();
8 use Tk;
9 our $mw = MainWindow->new;
10 $mw->after(1, \&ticks); # after 1ms, give control back
11 MainLoop;
13 sub ticks {
14 while (1) {
15 render_signal(process_signal(read_dsp()));
16 $mw->idletasks();
21 our ($devname, $fmt, $bitrate, $wps, $bps, $bufsize, $dsp);
22 BEGIN {
23 $devname = "default"; # or e.g. hw:1,0 for an additional USB soundcard input
24 $fmt = 16; # sample format (bits per sample)
25 $bitrate = 16384; # sample rate (number of samples per second)
26 $wps = 8; # FFT windows per second (rate of FFT updates)
27 $bps = ($fmt * $bitrate) / 8; # bytes per second
28 $bufsize = $bps / $wps; # window buffer size in bytes
31 sub init_dsp {
32 open ($dsp, '-|', 'arecord', '-D', $devname, '-t', 'raw', '-r', $bitrate, '-f', 'S'.$fmt) or die "arecord: $!";
33 use IO::Handle;
34 $dsp->autoflush(1);
37 sub read_dsp {
38 my $w;
39 read $dsp, $w, $bufsize or die "read: $!";
40 return $w;
44 use Math::FFT;
45 use List::Util qw(sum);
47 our @freqs;
48 sub init_fft {
49 my $dft_size = $bitrate / $wps;
50 for (my $i = 0; $i < $dft_size / 2; $i++) {
51 $freqs[$i] = $i / $dft_size * $bitrate;
55 sub process_signal {
56 my ($bytes) = @_;
58 # Convert raw bytes to a list of numerical values.
59 $fmt == 16 or die "unsupported $fmt bits per sample\n";
60 my @samples;
61 while (length($bytes) > 0) {
62 my $sample = unpack('s<', substr($bytes, 0, 2, ''));
63 push(@samples, $sample);
66 # Perform RDFT
67 my $fft = Math::FFT->new(\@samples);
68 my $coeff = $fft->rdft;
70 # The output are complex numbers describing the exactly phased
71 # sin/cos waves. By taking an abs value of the complex numbers,
72 # we just measure the amplitude of a wave for each frequency.
73 my @mag;
74 $mag[0] = sqrt($coeff->[0]**2);
75 for (my $k = 1; $k < @$coeff / 2; $k++) {
76 $mag[$k] = sqrt(($coeff->[$k * 2] ** 2) + ($coeff->[$k * 2 + 1] ** 2));
79 # Rescale to 0..1. Many fancy strategies are possible, this is
80 # extremely silly.
81 my $avgmag = sum (@mag) / @mag;
82 @mag = map { $_ / $avgmag * 0.3 } @mag;
83 return @mag;
87 our $canvas;
88 sub render_signal {
89 # Display parameters, tweak to taste:
90 my $rows = 2;
91 my $hspace = 20;
92 my $height = 150;
93 my $vspace = 20;
95 my @spectrum = @_;
96 my $row_freqn = @spectrum / $rows;
98 unless ($canvas) {
99 $canvas = $mw->Canvas(-width => $row_freqn + $hspace * 2, -height => $height * $rows + $vspace * ($rows + 1));
100 $canvas->pack;
102 $canvas->delete('all');
104 for my $y (0..($rows-1)) {
105 for my $x (0..($row_freqn-1)) {
106 my $hb = ($height + $vspace) * ($y + 1);
107 my $i = $row_freqn * $y + $x;
109 # Draw line:
110 my $ampl = $spectrum[$i]; $ampl <= 1.0 or $ampl = 1.0;
111 my $bar = $height * $ampl;
112 $canvas->createLine($x + $hspace, $hb, $x + $hspace, $hb - $bar);
114 # Draw label:
115 if (!($x % ($row_freqn/4))) {
116 $canvas->createLine($x + $hspace, $hb + 0, $x + $hspace, $hb + 5, -fill => 'blue');
117 $canvas->createText($x + $hspace, $hb + 15, -fill => 'blue', -font => 'small', -text => $freqs[$i]);
122 $mw->update();