#!/pro/bin/perl our $VERSION = 0.010; # See bottom for versions # TODO: # meerdere wektijden # grote snooze button. Click op digi-canvas zou ook moeten kunnen # misschien zelfs de bekende AnyKey :) # file browser voor wav bestanden (play) # file browser voor mp3/pls/m3u bestanden (bmp) # ondersteuning voor shuffle bij m3u/pls playlists # bookmarks e/o conf file (meerdere radio stations) # GUI cleanups: resize etc # auto-conf voor bepalen welke players beschikbaar zijn # controle of de radio inderdaad *speelt*, en anders terugvallen op beeps # niet spelen kan o.a. een gevolg zijn van ontbrekende codecs (b.v. in # /usr/lib/bmp/Input) of het off-line zijn van de internet-radio stream # controle of de (audio) cd inderdaad speelt # meerdere beep sounds # beep sounds in i.p.v. als file. ze zijn klein. moet kunnen # ACME::Time::BabyTalk plug-in (natuurlijk mèt spraak) # PC/Laptop uit slaapstand halen (patches welcome) # Sleep/Sluimer functie (countdown). Logischerwijs NIET voor beeps # Skype # Make used modules (and the functionality that depends on them) optional # Move to module # Find modules that support other OS's (OS/X) for Linux::CDROM and Audio::Mixer # Audio::CD Audio::OSS AudioCD AudioCD::Mac Mac::Sound Device::Cdio # Find a way to deal with Unicode file names passing to play and xmms use strict; use warnings; use integer; use Getopt::Long qw(:config bundling nopermute passthrough); my $mode = "bel"; # bel, mp3, url, cd my $testing = 0; # Nothing to see here, walk on please my $nbell = 30; # Number of times to repeat the beep my $repeat = 9; # delay time in minutes my $bellf = "Beep.wav"; my @atime = (); my $Atime = ""; my $atime = "__:__"; my $radio = "$ENV{HOME}/radio/alternative.m3u"; #"http://87.117.201.178:7170"; my $cdplay = 0; GetOptions ( "n=i" => \$nbell, "c" => sub { $mode = "cd"; }, "T" => \$testing, ) or die "usage: xwekker [-c] [alarm-time]\n"; # Arg parsing for (@ARGV) { if (m{^ (\d\d?) :? (\d\d) $}x) { # Alarm time HH:MM $atime = sprintf "%02d:%02d", $1, $2; next; } if (m{^ cd $}xi) { # Play CD $mode = "cd"; next; } if (m{^ http:// }xi || # URL m{\.(?: pls | m3u ) $}xi) { # Playlist $radio = $_; $mode = "url"; next; } if (m{ \.(?: wav | mp3 )$}xi) { # audio-file $radio = $_; # Mode "mp3" will play blocking the alarm clock # xmms and friends deal with this ok # Take care with UTF8 file names. Something fails somewhere $mode = "url"; next; } if (m{^ test $}xi) { # Test $testing++; next; } } my $locat = $mode =~ m{^(?: bel | cd )$}x ? $bellf : $radio; use Tk; use Tk::Scale; use Tk::Clock; use Tk::BrowseEntry; use Audio::Mixer; use Linux::CDROM; my %color = ( Back => "Black", Digits => "Green", Dots => "Yellow", Alarm => "Maroon", ); my @dig_data = ( " ### # ### ### # ##### ### ##### ### ### ", "# # ## # # # # # # # # # # # # # # ", "# # # # # # #### # # # # # # ", "# # # # ### # # # #### # ### #### ", "# # # # # ##### # # # # # # # ", "# # # # # # # # # # # # # # # # ", " ### ### ##### ### # ### ### # ### ### "); my @dots; # $dots[$dig][$row][$col] = "#" || ""; foreach my $d (0..9) { foreach my $r (0..6) { $dots[$d][$r][$_] = substr ($dig_data[$r], 6 * $d + $_, 1) for 0..4 } } ### ########################################################################### # Create the interface my $mw = MainWindow->new; my %pack = ( efl => [ qw( -expand 1 -fill both -side left )], eft => [ qw( -expand 1 -fill both -side top )], _fl => [ qw( -expand 0 -fill both -side left )], _ft => [ qw( -expand 0 -fill both -side top )], e_l => [ qw( -expand 1 -fill none -side left )], e_t => [ qw( -expand 1 -fill none -side top )], ); # +-------+------------------+-+ # | \ | 1 2 : 3 4 : 5 6 |-| # | . |------------------+-| # | | | 07:30 |=| # | 29-11 | /home/merijn/mp3 |-| # +-------+------------------+-+ # Left: The analog clock my $clock = $mw->Clock ()->pack (@{$pack{efl}}); $clock->config ( -secsColor => "OrangeRed", -timeFormat => "", -dateFormat => "ddd dd\nmmm yyy", ); # Middle top: digital time my $midfr = $mw->Frame ()->pack (@{$pack{efl}}); my $px = 5; # Pixel width/height my $display = $midfr->Canvas ( -relief => "ridge", -background => $color{Back}, -width => $px * 43, -height => $px * 9, )->pack (@{$pack{_ft}}); my @pixel; foreach my $r (0..6) { foreach my $c (0..40) { my $x = $c + 1; $pixel[$r][$c] = $display->createRectangle ( $px * $x, $px * $r + $px, $px * $x + $px, $px * $r + 2 * $px, -fill => $color{Back}, -tags => "$r:$c", ); } } # Middle middle: options my $snooze = 1; my $do_repeat = 1; # delay time in minutes my $options = $midfr->Frame->pack (@{$pack{eft}}); my @cbo = ( -anchor => "w", -relief => "flat", -borderwidth => 1, -highlightthickness => 0, -width => 2, -font => "6x10", ); $options->Checkbutton (@cbo, -text => "Snooze", -variable => \$snooze, )->pack (@{$pack{efl}}); $options->Checkbutton (@cbo, -text => "Repeat", -variable => \$do_repeat, )->pack (@{$pack{efl}}); my $msl = $options->BrowseEntry ( -variable => \$mode, -relief => "flat", -width => 4, -listwidth => 4, )->pack (@{$pack{efl}}); $msl->insert ("end", $_) for qw( bel cd url mp3 ); # Middle bottom: the ascii data and input fields my $panel = $midfr->Frame->pack (@{$pack{eft}}); $panel->Entry ( -width => 5, -textvariable => \$atime, )->pack (@{$pack{e_l}}); $panel->Entry ( -width => 0, #25, -font => "6x10", -textvariable => \$locat, )->pack (@{$pack{e_l}}); # Right vertical: audio volume my $volume = (Audio::Mixer::get_cval ("pcm"))[0]; $mw->Scale ( -borderwidth => 1, -length => 100, -width => 10, -variable => \$volume, -sliderlength => 10, -troughcolor => "Black", -showvalue => 0, -from => 100, -to => 0, -command => \&set_volume, )->pack (@{$pack{efl}}); ### ########################################################################### my @END; sub run_end () { $_->() for @END; } # run_end sub set_end ($) { run_end (); @END = $_[0]; } # set_end END { run_end (); } my $rtime = 0; # time last alarm went off sub executable ($) { my $prog = shift or return 0; # use Which; would be fine here foreach my $p (split m/:+/, $ENV{PATH}) { -x "$p/$prog" and return 1; } 0; } # executable # Force a `sorted' hash, # Put your most preferred player on top my @players = ( play => [qw( play )], pia => [qw( pia )], xine => [qw( xine --verbose=0 --auto-play=hwq --hide-gui --no-logo --no-splash )], mplayer => [qw( mplayer -really-quiet -nojoystick -nolirc -msglevel all=-1 )], # sox # mpg321 ); my %players = @players; @players = grep { exists $players{$_} && executable $_ } @players; # List all available xmms clones in order of preference $players{xmms} = [ grep { executable $_ } qw( beep-media-player audacious xmms )]; sub play_file { my ($n, $f) = @_; local $ENV{MPLAYER_VERBOSE} = -99; my $player = $players[0]; $testing and print STDERR join " ", @{$players{$player}}, $f, "\n"; system @{$players{$player}}, $f for 1 .. $n; } # play_file sub audio_volume () { Audio::Mixer::set_cval ("vol", 100, 100); Audio::Mixer::set_cval ("cd", 100, 100); Audio::Mixer::set_cval ("pcm", $volume, $volume); } # audio_volume sub set_volume () { audio_volume (); $mode eq "bel" || ($mode eq "cd" && !$cdplay) and play_file (1, $bellf); } # set_volume sub rring () { $snooze and return; time - $rtime < 5 and return; $rtime = time; print STDERR "ALARM!\a\a\a\n"; if ($mode eq "cd") { foreach my $cd (Linux::CDROM->new ("/dev/cdrom")) { unless ($cd->drive_status == CDS_DISC_OK) { print STDERR "CD no disc or disc not ready\n"; $mode = "bel"; last; } unless ($cd->disc_status == CDS_AUDIO) { print STDERR "not an audio CD\n"; $mode = "bel"; last; } $cd->set_vol (255, 255, 255, 255); $do_repeat = 0; print STDERR "Starting CD ..."; print STDERR $cd->play_ti (); $cdplay = 1; print STDERR " $Linux::CDROM::error\n"; set_end (sub { $cd->stop; $cd->close; undef $cd }); return; } $mode eq "cd" and print STDERR "$Linux::CDROM::error\n"; } if ($mode eq "mp3") { # This will block xwekker, and wait for the file to finish playing play_file (1, $locat); return; } if ($mode eq "url") { use Xmms (); use Xmms::Remote (); my $bmp = Xmms::Remote->new; my $pid = 0; unless ($bmp->is_running) { $pid = fork or exec $players{xmms}[0]; set_end (sub { kill 9, $pid }); sleep 1; } # print STDERR "BMP ", $bmp->get_version, "\n"; if ($bmp->is_playing) { print STDERR "BMP is already playing ", $bmp->get_playlist_files, " : ", $bmp->get_playlist_pos, " ...\n"; return; } $bmp->playlist_clear; Xmms::sleep (0.25); $bmp->playlist ([ $locat ]); Xmms::sleep (0.25); # $bmp->repeat ($do_repeat); $bmp->play; return; } $do_repeat and $mw->after (60 * $repeat * 1000, \&rring); if ($locat && -f $locat && -s _) { play_file ($nbell, $locat); return; } $display->bell for 1 .. $nbell; } # rring sub clock { my @now = localtime; $display->itemconfigure ("all", -fill => $color{Back}); foreach my $r ( 0 .. 6 ) { my $c = 0; foreach my $l ( @now[2,1,0] ) { foreach my $d ($l / 10, $l % 10) { for (0 .. 4) { $dots[$d][$r][$_] eq "#" and $display->itemconfigure ("$r:$c", -fill => $color{Digits}); $c++; } $c++; } $c += 3; } } $display->itemconfigure ($_, -fill => $color{Dots}) for qw( 2:13 2:28 5:13 5:28 ); $volume = (Audio::Mixer::get_cval ("pcm"))[0]; if ($atime ne $Atime) { $Atime = $atime; if (@atime = ($atime =~ m{^ \s* (\d\d?) : (\d\d) $}x) and $atime[0] >= 0 && $atime[0] <= 23 && $atime[1] >= 0 && $atime[1] <= 59) { $snooze = 0; } else { @atime = (); } } if ($testing) { print STDERR "TESTING\n"; $nbell = 1; $do_repeat = 0; $snooze = 0; rring (); $testing = 0; return; } @atime and $now[0] <= 1 && $atime[0] == $now[2] && $atime[1] == $now[1] and rring (); } # clock $mw->repeat (995, \&clock); MainLoop; __END__ 0.010 03 Sep 2007 Command line args parsing; Dropdown list for play mode in GUI, play mp3/wav, all modes now in one flag: $mode 0.004 31 Mar 2007 Players now auto-select on availability, including the available xmms clones. Unix-like. should still be tested on MacOS and Win32 0.003 18 Jan 2007 Volume control handle now "follow"s pcm volume 0.002 02 Jan 2007 Added TODO list 0.001 02 Jan 2007 Initial public release