Precompute rectangles before rendering

[fluffyball.git] / fb.pl

#!/usr/bin/perl

use warnings;
use strict;

use Audio::DSP;
use Math::FFT;
use List::Util qw(min max sum);
use Tk;


our ($mw, $canvas);
our ($dsp, $dspin, $ana);

our ($chan, $fmt, $rate, $sps) = (1, 8, 32768, 16);
our $bps = ($chan * $fmt * $rate) / 8;
our $buf = $bps / $sps;

our @avgsteps = (4, 8);

# How much to amplify the spectrum
our $amplifier = 1;

# Rectangles cover averages in various bands. They also include averages
# of surrounding of the rectangle picture. E.g. with step 20, over 10,
# the average includes average of 20 of the covered area + 10 on each side.
our $rect_step = 10;
our $rect_over = 5;

our $draw_lines = 0; # this makes for real pretty graphs but it is a huge slowdown
our $draw_rect = 1;


sub render_spectrum {
        my ($finfo, $label, $reflabel, $fir, $srows, $xofs, $yofs, $w, $h, $hs) = @_;
        my @fi = @$fir;
        my @f = @{$finfo->{"freq_$label"}};
        my @fref; defined $reflabel and @fref = @{$finfo->{"freq_$reflabel"}};
        my @r = @{$finfo->{"rect_$label"}};
        my @rref; defined $reflabel and @rref = @{$finfo->{"rect_$reflabel"}};
        for my $y (0..($srows-1)) {
                for my $x (0..($w-1)) {
                        my $hb = $yofs + $h * ($y + 1) + $hs * $y;
                        my $i = $w * $y + $x;

                        if ($draw_lines) {
                                my $barh = $h * ($draw_rect ? 2/3 : 1);
                                my $bar = $h * $f[$i] * $amplifier;
                                $bar = min ($barh, $bar);
                                $canvas->createLine($xofs + $x, $hb, $xofs + $x, $hb - $bar);
                                if (defined $reflabel) {
                                        my $refbar = $h * $fref[$i] * $amplifier;
                                        $refbar = min ($barh, $refbar);
                                        if ($refbar > $bar) {
                                                $canvas->createLine($xofs + $x, $hb - $bar, $xofs + $x, $hb - $refbar, -fill => 'darkred');
                                        } else {
                                                $canvas->createLine($xofs + $x, $hb - $refbar, $xofs + $x, $hb - $bar, -fill => 'red');
                                        }
                                }
                        }

                        if ($draw_rect and !($i % $rect_step) and $i >= $rect_over and $i <= @f - $rect_step - $rect_over) {
                                my $recth = $h * ($draw_lines ? 2/3 : 1);
                                my $avg = $recth * $amplifier * $r[$i / $rect_step];
                                $avg = min ($h, $avg);
                                my $rhb = $hb - $h;
                                $canvas->createRectangle($xofs + $x, $rhb, $xofs + $x + $rect_step, $rhb + $avg, -fill => 'black');
                                if (defined $reflabel) {
                                        my $refavg = $recth * $amplifier * $rref[$i / $rect_step];
                                        $refavg = min ($h, $refavg);
                                        if ($refavg > $avg) {
                                                $canvas->createRectangle($xofs + $x, $rhb + $avg, $xofs + $x + $rect_step, $rhb + $refavg, -fill => 'darkred', -outline => 'darkred');
                                        } else {
                                                $canvas->createRectangle($xofs + $x, $rhb + $refavg, $xofs + $x + $rect_step, $rhb + $avg, -fill => 'red', -outline => 'red');
                                        }
                                }
                        }

                        if (!($x % ($w/4))) {
                                $canvas->createLine($xofs + $x, $hb + 0, $xofs + $x, $hb + 5, -fill => 'blue');
                                $canvas->createText($xofs + $x, $hb + 15, -fill => 'blue', -font => 'small', -text => $fi[$i]);
                        }
                }
        }
        $canvas->createText($xofs, $yofs, -fill => 'darkgreen', -font => 'small', -text => $label);
}

sub render {
        my ($finfo) = @_;
        my @fi = @{$finfo->{freqi}};

        # main plot
        my $srows = 32/$sps; # spectrum rows; "density" of data depends on sps
        my $w = @fi / $srows; # width
        my $ws = 20; # spacing
        my $h = 150; # height
        my $hs = 20; # spacing

        my $htot = $hs + ($h + $hs) * $srows;

        # averages plots
        my $acols = 1;
        my $arows = @avgsteps / $acols; # rows of plots; each plot is further divided to $srows rows of spectrum
        my $aw = $w;
        my $ahtot = ($htot - 3 * $hs) / $arows;
        my $ah = $ahtot / $srows - $hs;

        unless ($canvas) {
                $canvas = $mw->Canvas(-width => $ws + $w + $ws*3 + ($aw + $ws) * $acols + $ws, -height => $htot);
                $canvas->pack;
        }
        $canvas->delete('all');

        render_spectrum($finfo, 'now', $avgsteps[0], $finfo->{freqi}, $srows, $ws, $hs, $w, $h, $hs);
        for my $i (0..$#avgsteps) {
                my $ax = $i % $acols;
                my $ay = sprintf('%d', $i / $acols);
                my $su = $avgsteps[$i];
                render_spectrum($finfo, $su, $i < $#avgsteps ? $avgsteps[$i+1] : undef, $finfo->{freqi}, $srows,
                                $ws + $w + $ws*3 + ($ws + $aw) * $ax,
                                ($ahtot + $hs*2) * $ay + $hs,
                                $aw, $ah, $hs);
        }

        $mw->update();
}

# Array with frequencies corresponding to elements of fftsig
sub fftfreq {
        my @freqs;
        my $dft_size = $rate / $sps;
        for (my $i = 0; $i < $dft_size / 2; $i++) {
                $freqs[$i] = $i / $dft_size * $rate;
        }
        return @freqs;
}

sub fftsig {
        my ($bytes) = @_;

        my @samples;
        $fmt == 8 or die "bits per sample must be 8";
        while (length($bytes) > 0) {
                my $sample = unpack('c', substr($bytes, 0, 1, ''));
                push(@samples, $sample);
        }

        # Magic from Audio::Analyze:
        my $fft = Math::FFT->new(\@samples);
        my $coeff = $fft->rdft;
        my $size = scalar(@$coeff);
        my $k = 0;
        my @mag;

        $mag[$k] = sqrt($coeff->[$k*2]**2);
        for($k = 1; $k < $size / 2; $k++) {
                $mag[$k] = sqrt(($coeff->[$k * 2] ** 2) + ($coeff->[$k * 2 + 1] ** 2));
        }

        # Rescale to 0..1
        my $avgmag = sum (@mag) / @mag; #[1000..$#mag];
        @mag = map { $_ / $avgmag * 0.3 } @mag;
        return @mag;
}

sub rectsof {
        my ($finfo, $l) = @_;
        my @f = @{$finfo->{"freq_$l"}};
        my @r;
        for (my ($fi, $ri) = ($rect_step, 1); $fi <= $#f - $rect_step - $rect_over; $fi += $rect_step, $ri++) {
                $r[$ri] = sum (@f[$fi - $rect_over .. $fi + $rect_step + $rect_over]) / ($rect_step + 2 * $rect_over);
        }
        $finfo->{"rect_$l"} = \@r;
}

sub ticks {
        my $s = 0;
        my $finfo;

        while (1) {
                my $w = $dsp->dread();
                $finfo->{freqi} = [fftfreq()];
                $finfo->{freq_now} = [fftsig($w)];

                # Create averaged rects
                rectsof($finfo, 'now');

                # Update floating freq. averages
                for my $su (@avgsteps) {
                        for my $i (0..$#{$finfo->{freqi}}) {
                                my $fn = $finfo->{freq_now}->[$i];
                                my $fs = $finfo->{"freq_$su"}->[$i];
                                $fs ||= $fn;
                                $finfo->{"freq_$su"}->[$i] = ($fs * ($su - 1) + $fn) / $su;
                        }
                        rectsof($finfo, $su);
                }

                render($finfo);

                $mw->idletasks();

                $s++;
        }
}


$dsp = new Audio::DSP(buffer   => $buf,
        channels => $chan,
        format   => $fmt,
        rate     => $rate);
$dsp->init() || die $dsp->errstr();


$mw = MainWindow->new;

$mw->after(1, \&ticks);
MainLoop;

$dsp->close();