Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Tk-applause-meter

by zentara (Archbishop)
on Sep 25, 2005 at 21:25 UTC ( [id://494964]=sourcecode: print w/replies, xml ) Need Help??
Category: GUI Programming
Author/Contact Info zentara@zentara.net
Description: A recent node asked about doing this. This runs on linux with the alsa sound drivers, and ecasound effects program, which has a utility called "ecasignalview", which is a text mode loudness meter. I hacked it's output into a big tk meter (almost fullscreen). The spacebar toggles it's functioning, and it will hold the peak value in a text indicator, until it resets at 0.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use IPC::Open3;
use Proc::Killfam;
use constant PI => 3.1415926;
########################################################### 
#adjust between 0 and 100 for applause sensitivity 
my $sensitivity = 50;

#space bar toggles on and off 
############################################################# 

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

my $pid = (open OUT, "ecasignalview -f:s16_le,1,44100 -b:512 -r:10 2>/
+dev/null |");

# for mixer control commands 
my $pidcon = open3(\*CON,0,0,'/bin/sh');

&mic_con(1); #turn on Mic 

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

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

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

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'],
);

$mw->repeat(25,sub{
                    &update_meter;
                    $count_tot--;
                    if($count_tot < 0){$count_tot = 0}
                     });

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

my $text_ind = $c->createText(
       +40, $y/2 + 150,
       -text  => 'Ready',
       -fill  => 'lightgreen',
       -anchor => 's',
       -tags => ['text']
 );

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


$mw->fileevent(\*OUT,'readable',\&write_t);

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

MainLoop;
######################################################### 
sub write_t {
    $count_tot++;
   my $str = <OUT>;
   my $count = $str =~ tr/*/*/;
   $count_tot += $count;
  if($count_tot > 100){$count_tot = 100}
}
########################################################## 
sub update_meter {
  my $value = $count_tot;

  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 => $count_max);

return $value;
}
######################################################################
+#  
######################################################################
+#  
sub mic_con{
  my $con = shift;

 if($con == 1){  #turn Mic on to max for recording  
  #turn off playback to avoid feedback squeal  
  print CON "amixer -q cset name='AC97 Playback Volume', 0\n";

  #adjust mic capture sensitivity  
  print CON "amixer -q cset name='AC97 Capture Volume', $sensitivity\n
+";

  #switch the capture to Mic  
  print CON "amixer -q  sset Mic Capture cap\n";
  #turn up maximum Mic gain  
  print CON "amixer -q  cset name='Mic Playback Volume', 100\n";
  #turn on Mic +20db boost  
  #print CON "amixer cset name='Mic Boost (+20dB)', 1\n"; 
 }

 if($con == 0){  #restore old Line settings  
  #turn off Mic by changing capture to Line  
  print CON "amixer -q  sset Line Capture cap\n";
  #turn off Mic +20db boost  
  print CON "amixer -q  cset name='Mic Boost (+20dB)', 0\n";
  #restore normal capture volume      
  print CON "amixer -q  cset name='AC97 Playback Volume', 0\n";
  #restore full mic capture sensitivity  
  print CON "amixer -q  cset name='AC97 Capture Volume', 95\n";
  }
}
###################################################################  

sub clean_exit{
     # a call to &mic_con(0) dosn't work on exit, 
     # so run system calls 
     system("amixer -q  sset Line Capture cap");
     system("amixer -q  cset name='AC97 Playback Volume', 88");
     system("amixer -q  cset name='AC97 Capture Volume', 95");

     killfam 9,$pid;
     exit;
}
################################################################# 
sub toggle_status{
  my $stat = $c->itemcget($text_ind,'-text');
  if($stat eq 'Ready'){
       &mic_con(0);
       $c->itemconfigure($text_ind, -text=>'Disabled');
    }else{
       &mic_con(1);
       $c->itemconfigure($text_ind, -text=>'Ready');
    }
}
################################################################ 

__END__
Replies are listed 'Best First'.
Re: Tk-applause-meter
by zentara (Archbishop) on Sep 26, 2005 at 15:43 UTC

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (5)
As of 2024-04-25 19:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found