Disable draw_lines again
[fluffyball.git] / fb.pl
blob9b9a08849f1e32fda38195ddea7a117724f75289
1 #!/usr/bin/perl
3 use warnings;
4 use strict;
6 use Audio::DSP;
7 use Math::FFT;
8 use List::Util qw(min max sum);
9 use Tk;
12 our ($mw, $canvas);
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
22 our $amplifier = 10;
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.
27 our $rect_step = 10;
28 our $rect_over = 5;
30 our $draw_lines = 0; # this makes for real pretty graphs but it is a huge slowdown
31 our $draw_rect = 1;
34 sub render_spectrum {
35 my ($label, $fr, $frefr, $fir, $srows, $xofs, $yofs, $w, $h, $hs) = @_;
36 my @f = @$fr;
37 my @fi = @$fir;
38 for my $y (0..($srows-1)) {
39 for my $x (0..($w-1)) {
40 my $hb = $yofs + $h * ($y + 1) + $hs * $y;
41 my $i = $w * $y + $x;
43 if ($draw_lines) {
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);
48 if ($frefr) {
49 my $refbar = $h * $frefr->[$i] * $amplifier;
50 $refbar = min ($barh, $refbar);
51 if ($refbar > $bar) {
52 $canvas->createLine($xofs + $x, $hb - $bar, $xofs + $x, $hb - $refbar, -fill => 'darkred');
53 } else {
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);
63 my $rhb = $hb - $h;
64 $canvas->createRectangle($xofs + $x, $rhb, $xofs + $x + $rect_step, $rhb + $avg, -fill => 'black');
65 if ($frefr) {
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);
68 if ($refavg > $avg) {
69 $canvas->createRectangle($xofs + $x, $rhb + $avg, $xofs + $x + $rect_step, $rhb + $refavg, -fill => 'darkred', -outline => 'darkred');
70 } else {
71 $canvas->createRectangle($xofs + $x, $rhb + $refavg, $xofs + $x + $rect_step, $rhb + $avg, -fill => 'red', -outline => 'red');
76 if (!($x % ($w/4))) {
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);
85 sub render {
86 my ($finfo) = @_;
87 my @fi = @{$finfo->{freqi}};
89 # main plot
90 my $srows = 4; # spectrum rows
91 my $w = @fi / $srows; # width
92 my $ws = 20; # spacing
93 my $h = 150; # height
94 my $hs = 20; # spacing
96 my $htot = $hs + ($h + $hs) * $srows;
98 # averages plots
99 my $acols = 1;
100 my $arows = @avgsteps / $acols; # rows of plots; each plot is further divided to $srows rows of spectrum
101 my $aw = $w;
102 my $ahtot = ($htot - 3 * $hs) / $arows;
103 my $ah = $ahtot / $srows - $hs;
105 unless ($canvas) {
106 $canvas = $mw->Canvas(-width => $ws + $w + $ws*3 + ($aw + $ws) * $acols + $ws, -height => $htot);
107 $canvas->pack;
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,
119 $aw, $ah, $hs);
122 $mw->update();
125 # Array with frequencies corresponding to elements of fftsig
126 sub fftfreq {
127 my @freqs;
128 my $dft_size = $rate / $sps;
129 for (my $i = 0; $i < $dft_size / 2; $i++) {
130 $freqs[$i] = $i / $dft_size * $rate;
132 return @freqs;
135 sub fftsig {
136 my ($bytes) = @_;
138 my @samples;
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);
149 my $k = 0;
150 my @mag;
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));
157 # Rescale to 0..1
158 my $maxmag = max @mag;
159 @mag = map { $_ / $maxmag } @mag;
160 return @mag;
163 sub ticks {
164 my $s = 0;
165 my $finfo;
167 while (1) {
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];
177 $fs ||= $fn;
178 $finfo->{"freq_$su"}->[$i] = ($fs * ($su - 1) + $fn) / $su;
182 render($finfo);
184 $mw->idletasks();
186 $s++;
191 $dsp = new Audio::DSP(buffer => $buf,
192 channels => $chan,
193 format => $fmt,
194 rate => $rate);
195 $dsp->init() || die $dsp->errstr();
198 $mw = MainWindow->new;
200 $mw->after(1, \&ticks);
201 MainLoop;
203 $dsp->close();