Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Zero sound detection with Tk graphics

by zentara (Archbishop)
on Aug 14, 2006 at 19:44 UTC ( #567312=snippet: print w/ replies, xml ) Need Help??

Description: Someone asked on the perl.beginners list how to detect silence on the linux sound card, to be used in a studio to detect when the DJ is sleeping. :-) This reads /dev/dsp and detects when sound is zero. Just play a song on your alsa sound system (standard on linux), start this script, and watch. :-) It works for wavs, mp3's, etc, but not midi's.

UPDATE Aug16,2006....fixed a division by zero error when app is started with a quiet sound card.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Audio::DSP;
use constant PI => 3.1415926;

#alsamixer must be setup right, AC'97 capture adjusts sensitivity,
#just turn it up to 100 for this to work as intended

my ($buf, $chan, $fmt, $rate) = (4096, 1, 16 , 8000);

my $dsp = new Audio::DSP(buffer   => $buf,
                     channels => $chan,
                     format   => $fmt,
                     rate     => $rate);

$dsp->init() || die $dsp->errstr();

my $mw = MainWindow->new;
my $x = 300;
my $y = 300;

$mw->protocol('WM_DELETE_WINDOW' => sub { &clean_exit });

$mw->fontCreate('big', -family=>'arial',
     -weight=>'bold', -size=> 36 );

my $count_tot = 0;
my $count_max = 0;

my $c = $mw->Canvas(
              -width => $x,
              -height => $y,
              -bd => 2,
              -relief => 'sunken',
              -background => 'black',
              )->pack();

$c->createLine( $x/2, $y/2, 10 , $y/2 ,
          -tags => ['needle'],
          -arrow => 'last',
          -width => 15,
          -fill => 'hotpink',
           );

my $gauge = $c->createArc(
        10,10, $x-10,$y-10,
        -start => 0,
        -style => 'arc',
        -width => 5,
        -extent => 180,
        -outline => 'skyblue',
        -tags => ['gauge'],
);

my $hub = $c->createArc(
        ($x/2 - 20), ($y/2 - 20) ,( $x/2 + 20) ,( $y/2 + 20),
        -start => 90,
        -extent => 359,
        -fill => 'lightgreen',
        -tags => ['hub'],
);


my $text = $c->createText(
      $x/2, $y/2 + 150,
       -text  => $count_max,
       -font  => 'big',
       -fill  => 'yellow',
       -anchor => 's',
       -tags => ['text']
 );


$c->raise('needle','text');
$c->raise('hub','needle');

$mw->bind('<space>',sub{ &toggle_status  });

$mw->waitVisibility;

my $timer = $mw->repeat(50,sub{ 
                    my $value = &update_meter;
                    $value = sprintf('%2.1f',$value);
        
            if($value <= 0){$value = 0 }
                    if($value >= 100){$value = 100}

                  my $pos = $value/100;
                  
          my $x1 = $x/2 - .95*$x/2 * (cos( $pos * PI ));
                  my $y1 = $y/2 - .95*$y/2 * (sin( $pos * PI ));

                  $c->coords('needle', ($x/2), ($y/2), $x1, $y1);

                   if($value > $count_max){ $count_max = $value }
                   if($value == 0){ $count_max = 0 }

                    $c->itemconfigure($text, -text => $value);
                    $mw->update;
                });

MainLoop;

#########################################################
sub update_meter {

  my $samples = 15;
  my $num_tot = 0;
  my $div_tot = 0;
  my $value =0;

# Record x samples of sound
for (1..$samples) {
        #read 16 bits of raw data
        my $data = $dsp->dread(16); # || die $dsp->errstr();
        my $num =  unpack( 'v', $data  );
    
        #filter out baseline noise
        if($num > 65000){next}else{
        #print  "$num ";    
            $num_tot += $num;
            $div_tot += 32768;  #gives a good average
    }
 }

 if( $div_tot != 0 ){
   $value = ($num_tot/$div_tot) * 100;
} 

return $value;

}
######################################################################
+# 
sub clean_exit{
    $timer->cancel;
    $dsp->close();
    exit;
}
#################################################################
__END__


Comment on Zero sound detection with Tk graphics
Download Code

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://567312]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (10)
As of 2014-09-23 22:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (241 votes), past polls