File: [local] / mp3 / bin / mixer.pl (download)
Revision 1.2, Sat Aug 12 00:14:53 2006 UTC (17 years, 11 months ago) by andrew
Branch: MAIN
Changes since 1.1: +1 -0 lines
add RCS Ids. I am not sure why this wasn't committed when those were actually done, but it is now.
|
#!/usr/bin/perl -Tw
# $RedRiver$
########################################################################
# Mixer.pl *** Changes volume on the MP3 player
#
# 10/11/2002 4:26PM
# Written by andrew fresh <andrew@mad-techies.org>
########################################################################
use strict;
use diagnostics;
my $mixerctl = '/usr/bin/mixerctl';
my $me = MyName();
delete $ENV{PATH} if exists $ENV{PATH};
my @Vols = (
[ 7, 7],
[ 15, 15],
[ 23, 23],
[ 31, 31],
[ 39, 39],
[ 47, 47],
[ 55, 55],
[ 63, 63],
[ 71, 71],
[ 79, 79],
[ 87, 87],
[ 95, 95],
[103, 103],
[111, 111],
[119, 119],
[127, 127],
[135, 135],
[143, 143],
[151, 151],
[159, 159],
[167, 167],
[175, 175],
[183, 183],
[191, 191],
[199, 199],
[207, 207],
[215, 215],
[223, 223],
[231, 231],
[239, 239],
[247, 247],
[255, 255],
);
my $Cur_Vol = `$mixerctl outputs.master`;
#»print "Cur_Vol $Cur_Vol<BR>\n";
$Cur_Vol =~ /outputs.master=(\d+),(\d+)/i;
my $Cur_Vol_Left = $1;
my $Cur_Vol_Right = $2;
print "Content-Type: text/html\n\n";
print "<html>\n<head>\n\t<meta HTTP-EQUIV='Pragma' CONTENT='no-cache'> ";
my $New_Vol = "$Cur_Vol_Left&$Cur_Vol_Right";
if ($ENV{'QUERY_STRING'}) {
print "<meta HTTP-EQUIV=Refresh CONTENT=\"1; URL=mixer.pl\">";
$New_Vol = $ENV{'QUERY_STRING'};
}
print <<EOL;
<style type="text/css" media="screen">
<!--
a.down:link { color: red; text-decoration: none; }
a.down:visited { color: red; text-decoration: none; }
a.down:hover { color: red; text-decoration: none; }
a.down:active { color: red; text-decoration: none; }
a.up:link { color: blue; text-decoration: none; }
a.up:visited { color: blue; text-decoration: none; }
a.up:hover { color: blue; text-decoration: none; }
a.up:active { color: blue; text-decoration: none; }
-->
</style>
EOL
print "<title>Volume Mixer</title></head>\n<body>\n\n";
Print_Nav();
print "Volume - ";
#»print "New_Vol $New_Vol<BR>\n";
$New_Vol =~ /(\d+)&(\d+)/;
my $New_Vol_Left = $1;
my $New_Vol_Right = $2;
my @nav;
foreach my $vol (@Vols) {
if ($$vol[0] == $New_Vol_Left) {
push @nav, "<B><A HREF='$me?$$vol[0]&$$vol[1]' class=up>$$vol[0]</A></B>\n";
} elsif ($$vol[0] < $New_Vol_Left) {
push @nav, "<A HREF='$me?$$vol[0]&$$vol[1]' class=up>}</A>\n";
} elsif ($$vol[0] > $New_Vol_Left) {
push @nav, "<A HREF='$me?$$vol[0]&$$vol[1]' class=down>]</A>\n";
}
#print "$vol - $$vol[0] - $$vol[1]<br>\n";
}
print join " ", @nav;
#print "<br>\n";
Set_Vol($Cur_Vol_Left, $Cur_Vol_Right, $New_Vol_Left, $New_Vol_Right);
print "</body>\n</head>\n</html>\n";
sub Set_Vol
{
my $old_vol_right = shift;
my $old_vol_left = shift;
my $new_vol_left = shift;
my $new_vol_right = shift;
my $old_vol;
my $new_vol;
if (($old_vol_left + $old_vol_right) > ($new_vol_left + $new_vol_right)) {
$old_vol = $old_vol_left > $old_vol_right ? $old_vol_left : $old_vol_right;
$new_vol = $new_vol_left < $new_vol_right ? $new_vol_left : $new_vol_right;
} else {
$old_vol = $old_vol_left < $old_vol_right ? $old_vol_left : $old_vol_right;
$new_vol = $new_vol_left > $new_vol_right ? $new_vol_left : $new_vol_right;
}
#»print "Old: $old_vol - New: $new_vol<br>\n";
my $Set_Vol;
foreach my $vol ($old_vol < $new_vol ? $old_vol..$new_vol : reverse $new_vol..$old_vol) {
#»print "$vol<br>\n";
$Set_Vol = `$mixerctl -w outputs.master=$vol,$vol`;
#»print $Set_Vol . "<br>\n";
}
return $Set_Vol;
}
########################################################################
# *** EncodeURL: %encodes the parameters of the URL
sub EncodeURL {
my $strURL = shift;
$strURL =~ s/(\W)/sprintf("%%%x", ord($1))/eg;
return $strURL;
}
#########################################################################
# My name
sub MyName {
my @filename = (split /\//, $0);
pop @filename;
}
#######################################################################
# Bail: this subrouting dies and displays the error to the browser.
# gotten from the example in the O'Reilly
# _Learning_Perl_on_Win32_Systems_
sub bail {
my $error = shift;
print "\n\nUnexpected Error: <b>$error</b><br>\n";
print "In " . __FILE__ . "\n";
die;
exit;
}
sub Print_Nav
{
open FILE, 'nav.inc' or die "\n\ncouldn't open FILE nav.inc: $!";
while (<FILE>) {
print;
}
close FILE;
}