#!/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__
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.