#!/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__

[download]

In reply to Tk-applause-meter by zentara

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.