at work, I like to mute the volume when the advertising starts so I can concentrate on what I'm doing.
The problem is, when I'm in the middle of a software task I often forget to unmute the volume, so a period of time goes by before I realize I'm still "listening" to the radio.
This simple app is my lazy way to avoid having to turn on the volume again. I can click on the big green On/Off button (or type "Enter") and the speaker volume goes off for a preset time (15-seconds by default; typically long enough for most ads), and then automatically unmutes when the interval expires.
There's a volume control slider, as well as the capability to disable the timer altogether, making the unmute operation manual instead.
#!/usr/bin/perl -w
###############
## Libraries ##
###############
use strict;
use warnings;
use Tk;
use Tk::Font;
use Tk::Photo;
use Tk::ROText;
use Tk::DialogBox;
use Win32::Sound;
##################
## User-defined ##
##################
my $prog_title = "SoundOff v1.0 -- Dec. 2011 by John C. Norton";
my $min_mute = 5;
my $dflt_mute = 15;
# GUI Look & Feel
my $a_timer_bg = [ '#ffafef', '#ffbf7f' ];
my $a_timer_txt = [ 'Timer Inactive (Esc)', 'Timer Active (Esc)' ];
my $bg_button = '#afcfff';
my $bg_label = '#ffbf7f';
my $bg_meter = '#ffdf3f';
my $bg_help = '#cfff9f';
my $fo_slider = 'Lucida Sans:9/*';
my $fo_button = 'Comic Sans MS:10*';
my $fo_label = 'Arial:10*';
my $fo_help = 'Lucida Sans:8';
my $a_can_geo = [ 128, 256 ];
my $a_meter_x = [ 48, 90 ];
my $a_meter_y = [ 32, 220 ];
my $a_bg_meter = [ '#ffffcf', '#ff3f3f' ];
my $a_btn_geo = [ 280, 317, 3 ];
my $a_on_off_geo = [ 280, 317, 3 ];
my $h_on_xpm = { '0' => '#7fcf7f', '2' => '#000000', '1' => '#87f7
+17' };
my $h_off_xpm = { '0' => '#ffbf7f', '2' => '#000000', '1' => '#ff3f
+3f' };
#############
## Globals ##
#############
my $volume = '100';
my $b_resume = 1;
my $b_mute = 0;
my $c_tick = 0;
my $mute_time = my $resume = $dflt_mute;
my ($btn_on, $btn_off, $cv_meter, $id_meter, $id_text, $mute_ent, $c_t
+imer);
##################
## Main Program ##
##################
create_gui();
#################
## Subroutines ##
#################
sub create_gui {
my $mw = new MainWindow(-title => $prog_title);
my $fr1 = frame($mw, '^0x'); # Help, Master Volume, Quit
my $fr2 = frame($mw, '^1b'); # Main frame
my $fr3 = frame($fr2, '<0b'); # Large On/Off button
my $fr4 = frame($fr2, '<1b'); # Timer Active, Mute Time, Meter
main_options($fr1);
$btn_on = sound_on_button($fr3);
$btn_off = sound_off_button($fr3);
$c_timer = togglebtn($fr4, \$b_resume, $a_timer_txt, $a_timer_bg)
+;
lbl_entry($fr4, 'Mute Time', \$mute_time);
resume_meter($fr4);
my $c_idle = sub { ($b_mute and $b_resume and $c_tick) and $c_tick
+->(1) };
$mw->repeat(1000 => $c_idle);
MainLoop;
}
sub main_options {
my ($w) = @_;
my $mw = $w->toplevel;
my $fr1 = frame($w, '<0bg1');
my $fr2 = frame($w, '<1xg1');
my $fr3 = frame($w, '>0bg1');
my $b1 = button($fr1, 'Help (F1)', '<1b');
my $b2 = button($fr3, 'Quit (^Q)', '<1b');
volume_slider($fr2);
$b1->configure(-command => sub { give_help($mw) });
$b2->configure(-command => sub { exit });
$mw->bind("<F1>" => sub { $b1->invoke });
$mw->bind("<Control-q>" => sub { $b2->invoke });
$mw->bind("<Return>" => sub { toggle_mute() });
$mw->bind("<KeyPress-Left>" => sub { adjust_mute_time(-5) });
$mw->bind("<KeyPress-Right>" => sub { adjust_mute_time(5) });
$mw->bind("<KeyPress-Down>" => sub { adjust_volume('-') });
$mw->bind("<KeyPress-Up>" => sub { adjust_volume('+') });
$mw->bind("<Escape>" => sub { $c_timer->() });
}
sub resume_meter {
my ($w) = @_;
$cv_meter = $w->Canvas(-bg => 'gray', -takefocus => 0);
$cv_meter->configure(-width => $a_can_geo->[0]);
$cv_meter->configure(-height => $a_can_geo->[1]);
my ($x0, $x1, $y0, $y1) = ( @$a_meter_x, @$a_meter_y );
my @rect = ( $x0, $y0, $x1, $y1, -fill => $a_bg_meter->[0] );
$cv_meter->createRectangle(@rect);
packit($cv_meter, '1bg2');
}
sub volume_slider {
my ($w) = @_;
my $a_vol = [ '-orient' => 'horizontal', -label => '~ Master Volum
+e ~' ];
my $vol = $w->Scale(@$a_vol, -variable => \$volume, -bg => $bg_m
+eter);
$vol->configure(-command => [ \&adjust_volume, '*' ]);
$vol->configure(-takefocus => 0, -font => create_font($w, $fo_slid
+er));
packit($vol, '<1b');
}
sub adjust_mute_time {
my ($incr) = @_;
$mute_time =~ s/\D//g;
$mute_time ||= $dflt_mute;
($incr eq '*') and $incr = 0;
$mute_time += $incr;
($mute_time < $min_mute) and $mute_time = $min_mute;
return $mute_time;
}
sub button {
my ($w, $text, $pack) = @_;
my $btn = $w->Button(-bg => $bg_button, -text => $text, -takefocu
+s => 0);
$btn->configure(-font => create_font($w, $fo_button));
return packit($btn, $pack || '<');
}
sub create_font {
my ($w, $font_spec) = @_;
my $weight = ($font_spec =~ s/[*]//)? 'bold': 'normal';
my $slant = ($font_spec =~ s:[/]::)? 'italic': 'roman';
my ($fam, $size, $bold) = $font_spec =~ /(.+):(\d+)([*])?$/;
my $mw = $w->toplevel;
my @args = ( -weight => $weight, -slant => $slant );
my $font = $mw->Font(-family => $fam, -size => $size, @args);
return $font;
}
sub lbl_entry {
my ($w, $label, $s_var) = @_;
my $frm = frame($w, '0xg2');
my $lbl = $frm->Label(-bg => $bg_label, -text => $label);
$lbl->configure(-font => create_font($w, $fo_label));
$mute_ent = $frm->Entry(-width => 1, -justify => 'center');
my $c_validate = sub { return ($_[0] =~ /^\d*$/)? 1: 0 };
$mute_ent->configure(-textvar => $s_var);
$mute_ent->configure(-validate => 'all', -validatecommand => $c_va
+lidate);
$lbl->pack($mute_ent, -side => 'left');
$mute_ent->pack(-expand => 1, -fill => 'both');
$mute_ent->focus;
$mute_ent->selectionRange(0, 15);
}
sub togglebtn {
my ($w, $s_var, $a_text, $a_bg) = @_;
my $frm = frame($w, '0xg2');
my $btn = $frm->Button();
my $c_toggle = sub {
my $text = $a_text->[$$s_var = 1 - $$s_var];
my $bg = $a_bg->[$$s_var];
$btn->configure(-text => $text, -bg => $bg);
};
$btn->configure(-text => $a_text->[$$s_var], -bg => $a_bg->[$$s_va
+r]);
$btn->configure(-command => $c_toggle, -takefocus => 0);
$btn->configure(-font => create_font($w, $fo_button));
packit($btn, '1b');
return $c_toggle;
}
sub frame {
my ($w, $pack, $bg) = @_;
my $frm = $w->Frame;
($bg || "") and $frm->configure(-bg => $bg);
return packit($frm, $pack);
}
sub packit {
my ($w, $pack) = @_;
$pack ||= '^0n';
my $h_sides = {qw{ < left > right ^ top v bottom}};
my $h_fill = {qw{n none b both x x y y }};
my $h_rel = {qw{ - flat g groove r ridge s solid ^ raised v sunk
+en }};
my $side = ($pack =~ s/^([<v^>])//)? $h_sides->{$1}: 'top';
my $b_exp = ($pack =~ s/^([01])//)? $1: 0;
my $fill = ($pack =~ s/^([nbxy])//)? $h_fill->{$1}: 'none';
my $rel = ($pack =~ s/^([-grs^v])//)? $h_rel->{$1}: '';
my $bw = ($pack =~ s/^(\d+)//)? $1: 2;
$rel and $w->configure(-relief => $rel, -borderwidth => $bw);
$w->pack(-expand => $b_exp || 0, -fill => $fill, -side => $side);
}
sub toggle_mute {
my ($btn) = @_;
return ($b_mute = 1 - $b_mute)? mute_on(): mute_off();
}
sub mute_on {
adjust_volume(0);
$btn_on->packForget;
$btn_off->pack;
$resume = my $curr_mute = adjust_mute_time(0);
$b_mute = 1;
$c_tick = sub {
my ($nsecs) = @_;
$resume -= $nsecs;
($resume <= 0) and return mute_off();
my $pcnt = (100 * $resume / $curr_mute);
meter_level($pcnt);
meter_label($resume);
};
$c_tick->(0);
}
sub mute_off {
$resume = $mute_time || $dflt_mute;
$btn_on->pack;
$btn_off->packForget;
meter_level(0);
meter_label('On');
$b_mute = $c_tick = 0;
adjust_volume('*');
}
sub meter_level {
my ($pcnt) = @_;
$pcnt = 100 - $pcnt;
my ($x0, $x1, $y0, $y1) = ( @$a_meter_x, @$a_meter_y );
$y0 += ($pcnt * ($y1 - $y0)) / 100;
my @rect = ( $x0, $y0, $x1, $y1, -fill => $a_bg_meter->[1] );
$id_meter and $cv_meter->delete($id_meter);
$id_meter = $cv_meter->createRectangle(@rect);
}
sub meter_label {
my ($text) = @_;
my ($x0, $x1, $y0, $y1) = ( @$a_meter_x, @$a_meter_y );
my ($textx, $texty) = (($x0 + $x1) / 2, $y1 + 4);
my @args = ( $textx, $texty, -anchor => 'n', -text => $text);
$id_text and $cv_meter->delete($id_text);
$id_text = $cv_meter->createText(@args);
}
sub adjust_volume {
my ($vol) = @_;
($vol eq '*') and $vol = $volume;
($vol eq '-') and $vol = ($volume > 0)? --$volume: $volume;
($vol eq '+') and $vol = ($volume < 100)? ++$volume: $volume;
if (0 == $vol or !$b_mute) {
my $val = int(65535 * $vol / 100) & 0x0000ffff;
Win32::Sound::Volume(($val << 16) | $val);
}
}
sub create_xpm {
my ($a_geo, $h_xpm, $data) = @_;
my ($w, $h, $nsyms) = @$a_geo;
my ($lb, $rb) = (chr(123), chr(125)); # Don't mess up '%' i
+n vim
# Create XPM header
my $xpm = qq{
:/* XPM */
:static char *xpm[] = $lb
:"$w $h $nsyms 1",
};
# Fill in XPM color symbols
foreach my $key (keys %$h_xpm) {
my $line = sprintf "%s c %s", $key, $h_xpm->{$key};
$xpm .= qq{\n\t\t:"$line",};
}
$xpm =~ s/(^\s+:)|((?<=\n)\s+:)|(\s+$)//g;
my $c_dec = sub {
my $N = ord($_[0]);
return 126 == $N? 0: 124 == $N? 75: $N < 92? $N-17: $N-92;
};
# Decode XPM data
$data =~ s/(^[^:]+:)|((?<=\n)\s+(?=:))|(:[^:]+$)//gs;
$data =~ s/:\n://g;
my $nhuff = $c_dec->(substr($data, 0, 1, ""));
my $size = $c_dec->(substr($data, 0, 1, ""));
for (my $i = 0; $i < $nhuff; $i++) {
my $sym = substr($data, 0, $size, "");
my $rep = substr($data, 0, 1, "");
$data =~ s/\Q$rep\E/$sym/g;
}
substr($data, 0, $c_dec->(substr($data, 0, 1, "")), "");
my $decode = "";
while ($data) {
my $symbol = substr($data, 0, 1, "");
my ($b1, $b2) = substr($data, 0, 2, "") =~ /^(.)(.)$/;
$decode .= $symbol x (76 * $c_dec->($b1) + $c_dec->($b2));
}
# Merge XPM header and data
for (my $i = 1; $i <= $h; $i++) {
my $line = substr($decode, 0, $w, "");
$xpm .= qq{\n"$line"} . (($i < $h)? ",": "$rb;");
}
return $xpm;
}
sub sound_on_button {
my ($w) = @_;
my $data = on_off_data();
my $xpm = create_xpm($a_on_off_geo, $h_on_xpm, $data);
my $btn = image_button($xpm, $w);
$btn->configure(-command => \&toggle_mute);
return packit($btn);
}
sub sound_off_button {
my ($w) = @_;
my $data = on_off_data();
my $xpm = create_xpm($a_on_off_geo, $h_off_xpm, $data);
my $btn = image_button($xpm, $w);
$btn->configure(-command => \&toggle_mute);
return $btn;
}
sub image_button {
my ($xpm, $w) = @_;
my $mw = $w->toplevel;
my $img = $mw->Photo(-format => 'xpm', -data => $xpm);
my $btn = $w->Button();
$btn->configure(-image => $img, -takefocus => 0);
return $btn;
}
sub give_help {
my ($mw) = @_;
my $title = "Help Menu";
my $db = $mw->DialogBox(-title => $title, -buttons => [ "Dismiss"
+ ]);
my $frm = $db->add('Frame');
packit($frm, '0xr4');
my $text = qq{
:
: ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
: SoundOff is a simple Windows application that mutes the comp
+uter
: speaker for a given timer interval, after which the volume i
+s
: automatically restored (unless the timer is inactive).
:
: The modules 'Tk' and 'Win32::Sound' are both required.
:
: The following features exist:
:
: 1. Help button (or F1)
:
: Displays this help menu. (Same as the <F1> key).
:
: 2. Master Volume slider (or <Up Arrow> and <Down Arrow>)
:
: Selects the speaker volume when unmuted. The keyboard
: accelerator keys <Up Arrow> and <Down Arrow> may be us
+ed
: to respectively raise or lower the volume.
:
: 3. Quit button (or ^Q)
:
: Exits the program. (Same as the <Control-Q> key).
:
: 4. Speaker Off/On Button (or <Enter>)
:
: Mutes or unmutes the speaker for the duration of the
: current Mute Time. The <Enter> key does the same thin
+g.
:
: 5. Timer Active button (or <Escape>)
:
: Disables the timer so the speaker is not automatically
: unmuted, even after the mute time interval has elapsed
+.
: This lets the user mute/unmute the speaker manually.
: The <Escape> key can be used as a shortcut for this.
:
: 6. Mute Time (or <Left Arrow> and <Right Arrow>)
:
: Selects the exact number of seconds after which the sp
+eaker
: volume is restored. The <Left Arrow> and <Right Arrow
+> keys
: respectively subtract or add 5-second intervals to th
+e time.
:
: 7. Progress meter
:
: A meter which displays a visual indication of the numb
+er
: of seconds left until the speaker is unmuted.
: ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
: $prog_title
};
$text =~ s/(^\s+:)|((?<=\n)\s+:)|(\s+$)//g;
my @text = split /\n/, $text;
my @dim = ( -width => 64, -height => 1 + @text );
my $txt = $db->add('ROText', -bg => $bg_help, @dim);
packit($txt, '1b');
$txt->configure(-font => create_font($mw, $fo_help));
map { $txt->insert('end', " $_\n") } @text;
$txt->see('end');
$db->Show;
}
sub on_off_data {
return q{
:l^0~ ~t!1~"1^#~r$~s%0]&1_'`2(1])0_*~q+x2,b2-~u.~2/_1020eg2~f*
+92~:
:j*62~l*42~n*22~p*02$*z2$*y2!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!
+*,!:
:*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*v"^2!"^*k
+"g2:
:!"g*]"l2!"l0^T"q2!"q0^K"u2!"u0^D",!"x0^>"02!"00^8"32!"30^22~c
+"z2:
:!"z2~c0^,~g",!",~g0^s2~k"w2!"w2~k0^n2~n"v2!"v2~n0^j2+"u2!"u2+
+0^f:
:2!1!2!1!2!0^-~v1!2!1!2~v0^^2~y"s2!"s2~y&[2~0"s2!"s2~0&W2/"s2!
+"s2:
:/&S2~4"s2!"s2~4&O2~6"s2!"s2~6&L2~7"s2!"s2~7&I2~9"s2!"s2~9&F2~
+91!:
:2!1!2~9&C2~;1!2!1!2~;&@2~;"u2!"u2~;&=2~<"v2!"v2~<&:2~<"w2!"w2
+~<&:
:72~=",!",~=&42~<"z2!"z2~<&22~;"12!"12~;&z2~;"32!"32~;&w2~;"42
+!"4:
:2~;&u2~:"62!"62~:&s2~9"82!"82~9&q2~8":2!":2~8&o2~7"<2!"<2~7&m
+2~6:
:">2!">2~6&k2~6"?2!"?2~6&h2~6"A2!"A2~6&e2~6"B2!"B2~6&c2~5"D2!"
+D2~:
:5&a2~5"E2!"E2~5&(~3"G2!"G2~3&_2~3"H2!"H2~3&]2/"J2!"J2/ |2/"K2
+!"K:
:2/ Z2/"L2!"L2/ X2~1"N2!"N2~1 V2~1"O2!"O2~1 T2~1"P2!"P2~1 R2~1
+"Q2:
:!"Q2~1 Q2~0"R2!"R2~0 P2~0"S2!"S2~0 N2~0"T2!"T2~0 L2~0"U2!"U2~
+0 K:
:2~y"W2!"W2~y J2~y"X2!"X2~y H2~z"X2!"X2~z G2~y"Y2!"Y2~y F2~y"Z
+2!":
:Z2~y D2~y"[2!"[2~y C2~x"|2!"|2~x B2~x)/!)/~x @2~x)]2!)]2~x ?2
+~w):
:^2!)^2~w >2~w)_2!)_2~w <2~x)_2!)_2~x ;2~w)a2$)a2~w :2~w)-$)-~
+w 9:
:2~v)d2~p)d2~v 82~w)e2~n)e2~w 72~v)g2~l)g2~v 62~v)i2~j)i2~v 52
+~v):
:k2~f)k2~v 42~v#;2~v 32.#=2. 22~v#=2~v 12.#?2. 02.#A2. z2.#A2.
+ y2:
:.#C2. ,!#E2! w2.#E2. v2!#G2! u2.#G2. t2!#I2! t2!#I2! s2!#K2!
+r2!:
:#K2! q2!#M2! p2!#M2! p2%#O2% o2!#O2! n2!#O2! n2%#Q2% m2!#Q2!
+l2%:
:#S2% l2%#S2% k2!#S2! j2%#U2% j2%#U2% i2!#U2! h2%#W2% h2%#W2%
+h2%:
:#W2% g2%#Y2% f2%#Y2% f2%#Y2% f2$#[2$ f2$#[2$ e2%#[2% d2%#[2%
+d2$:
:'/$ d2$'/$ d2$'/$ c2%'/% -%'/% -$'^2$ -$'^2$ -$'^2$ -$'^2$ -$
+'^2:
:$ -+'(+ -+'(+ a2$'($ ($'($ ($'($ ($'($ ($'($ ($'($ ($'($ (+'-
++ (:
:+'-+ (+'-+ (+'-+ (+'-+ (+'-+ (+'-+ (+'-+ (+'-+ (+'-+ (+'-+ (+
+'-+:
: (+'-+ (+'-+ ($'($ ($'($ ($'($ ($'($ ($'($ ($'($ ($'($ a2+'(+
+ -+:
:'(+ -$'^2$ -$'^2$ -$'^2$ -$'^2$ -$'^2$ -%'/% -%'/% c2$'/$ d2$
+'/$:
: d2$'/$ d2%#[2% d2%#[2% e2$#[2$ f2$#[2$ f2%#Y2% f2%#Y2% f2%#Y
+2% :
:g2%#W2% h2%#W2% h2%#W2% h2!#U2! i2%#U2% j2%#U2% j2!#S2! k2%#S
+2% :
:l2%#S2% l2!#Q2! m2%#Q2% n2!#O2! n2!#O2! o2%#O2% p2!#M2! p2!#M
+2! :
:q2!#K2! r2!#K2! s2!#I2! t2!#I2! t2.#G2. u2!#G2! v2.#E2. w2!#E
+2! :
:,.#C2. y2.#A2. z2.#A2. 02.#?2. 12~v#=2~v 22.#=2. 32~v#;2~v 42
+~v#:
:92~v 52~v#92~v 62~v#72~v 72~w#52~w 82~v#52~v 92~w#32~w :2~w#1
+2~w:
: ;2~x#z2~x <2~w#z2~w >2~w#,~w ?2~x#v2~x @2~x#t2~x B2~x#r2~x C
+2~y:
:#p2~y D2~y#n2~y F2~y#l2~y G2~z#j2~z H2~y#j2~y J2~y#h2~y K2~0#
+d2~:
:0 L2~0#-~0 N2~0#(~0 P2~0#^2~0 Q2~1#/~1 R2~1)[2~1 T2~1)Y2~1 V2
+~1):
:W2~1 X2/)S2/ Z2/)Q2/ |2/)O2/&]2~3)K2~3&_2~3)I2~3&(~5)E2~5&a2~
+5)C:
:2~5&c2~6)?2~6&e2~6)=2~6&h2~6)92~6&k2~6)72~6&m2~7)32~7&o2~8)z2
+~8&:
:q2~9)v2~9&s2~:)r2~:&u2~;)n2~;&w2~=)h2~=&z2~=)d2~=&22~?)^2~?&4
+2~A:
:"Y2~A&72~B"S2~B&:2~D"M2~D&=2~F"E2~F&@2~J";2~J&C2~M"12~M&F2~U"
+j2~:
:U&I2]W&L2]U&O2]Q&S2]M&W2]I&[2]E0^^2]A0^-]=0^f2]90^j2]50^n2]10
+^s2:
:]v0^,]r0^22]l0^82]f0^>2]`0^D2~[0^K2~S0^T2~I*]2~?*k2~x0e^:
};
}