Windows PerlTk/Sirius App

Discussion in 'Perl Misc' started by Stefan, Jan 17, 2008.

  1. Stefan

    Stefan Guest

    I wrote a Perl/Tk app using Audio::Radio::Sirius for interfacing with
    a Sirius Receiver via Serial. It's lame, but it works well... Any
    suggestions?

    My question is this -- if the serial loses connection to the Sirius
    Receiver, the program becomes unresponsive and has to be killed via C-
    A-D. Does anyone have any suggestions on how to make the program
    continue to function so that it can be exited gracefully? Or even
    better so that it can regain connection with the Sirius Receiver via
    the Serial line?

    Thanks!
    Stefan

    #! /usr/bin/perl

    use Tk;
    use Tk::DialogBox;
    use Tk::NoteBook;
    use Tk::LabEntry;
    use Audio::Radio::Sirius;
    use Win32::SerialPort;
    use strict;
    $^W++;

    my %tuner = (
    power => 0,
    channel => 1,
    mute => 0,
    monitor => 0,
    presets => {
    row1 => {
    1 => "Top 40",
    8 => "80\'s",
    9 => "90\'s",
    12 => "SIRIUS\nSuper Mix",
    21 => "Alternative\nRock",
    60 => "Today\'s\nCountry",
    103 => "Blue Collar\nComedy",
    104 => "Comedy\nUncensored",
    105 => "Family\nComedy",
    },
    row2 => {
    119 => "DSC",
    129 => "CNBC",
    130 => "Bloomberg\nRadio",
    132 => "CNN",
    134 => "NPR Now",
    135 => "NPR Talk",
    141 => "BBC",
    146 => "Sirius Left",
    151 => "StL Traffic &\nWeather",
    },
    },
    );

    my $serial = new Win32::SerialPort('com9');
    my $tuner = new Audio::Radio::Sirius;
    $tuner->connect($serial);
    $tuner->verbosity(1);

    my $mw = MainWindow->new();
    $mw->title('Sirius');
    $mw->minsize(250,50);

    my @frame;
    $frame[0] = $mw->Frame->pack(-side=>'top',-fill=>'x');
    my $exit = $frame[0]->Button(
    -text => 'Exit',
    -command => sub { power($tuner{power}=0); exit; },
    -height => 3, -width => 15,
    )->pack(-side=>'left', -padx=>6, -pady=>6);
    my $power = $frame[0]->Button(
    -text => $tuner{power} ? 'Off' : 'On',
    -command => sub { power($tuner{power}=$tuner{power}?0:1); },
    -height => 3, -width => 15,
    )->pack(-side=>'left', -padx=>6, -pady=>6);
    my $mute = $frame[0]->Button(
    -text => $tuner{mute} ? 'Unmute' : 'Mute',
    -command => sub { mute($tuner{mute}=$tuner{mute}?0:1); },
    -height => 3, -width => 15,
    )->pack(-side=>'left', -padx=>6, -pady=>6);
    $frame[1] = $mw->Frame->pack(-side=>'top',-fill=>'x');
    my $channel = $frame[1]->Entry(
    -textvariable => \$tuner{channel},
    -width => 4,
    )->pack(-side=>'left', -padx=>6, -pady=>6);
    my $set = $frame[1]->Button(
    -text => 'Set',
    -command => sub { channel($tuner{channel}); },
    -height => 3, -width => 15,
    )->pack(-side=>'left', -padx=>6, -pady=>6);
    my $clock = $frame[1]->Label(
    -text => '',
    -width => 25,
    )->pack(-side=>'left', -padx=>6, -pady=>6);
    my $c = 2;
    foreach my $cat ( keys %{$tuner{presets}} ) {
    $frame[$c] = $mw->Frame->pack(-side=>'top',-fill=>'x');
    foreach my $chan ( sort {$a<=>$b} keys %{$tuner{presets}{$cat}} ) {
    $_ = $tuner{presets}{$cat}{$chan};
    $frame[$c]->Button(
    -text => $_,
    -command => sub { channel($chan); },
    -height => 3, -width => 10,
    )->pack(-side=>'left', -padx=>6, -pady=>6);
    }
    }

    refresh();

    while (1) {
    eval MainLoop();
    }

    sub power {
    $tuner->power($_[0]);
    $power->configure(-text => $_[0] ? 'Off' : 'On');
    channel($tuner{channel});
    }

    sub mute {
    $tuner->mute($_[0]);
    $mute->configure(-text => $_[0] ? 'Unmute' : 'Mute');
    }

    sub channel {
    return unless $tuner{power};
    $tuner->channel($_[0]);
    }

    sub refresh {
    if ( ! ($tuner{monitor}%5) && $tuner{power} ) {
    $tuner->monitor();
    $tuner->set_callback('channel_update', \&channelupdate);
    $tuner{monitor} = 0;
    }
    $tuner{monitor} += 1;
    my $tpiece = localtime();
    $tpiece =~ s/(\S+:\S+)//;
    my $hpiece = $1;
    $tpiece =~ s/\s+/ /g;
    $clock->configure(-text => "$tpiece / $hpiece");
    $clock->after($tuner{monitor}%5?1000:1, \&refresh);
    }

    sub channelupdate {
    my ($channel, $pid, $artist, $title, $composer) = @_;
    no warnings;
    my @info = ();
    push @info, $artist if $artist;
    push @info, $title if $title;
    my $info = join ' - ', @info;
    $mw->title($channel ? "$channel: $info" : 'Powered off');
    }
     
    Stefan, Jan 17, 2008
    #1
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. tom
    Replies:
    4
    Views:
    14,201
    jpowers5882
    Oct 24, 2008
  2. Replies:
    1
    Views:
    358
  3. =?Utf-8?B?R2lhbmNhcmxv?=

    debug Windows app works but, not web app

    =?Utf-8?B?R2lhbmNhcmxv?=, Sep 26, 2005, in forum: ASP .Net
    Replies:
    0
    Views:
    333
    =?Utf-8?B?R2lhbmNhcmxv?=
    Sep 26, 2005
  4. A Epstein

    Setting the mode for trees in PerlTk

    A Epstein, Jul 9, 2003, in forum: Perl Misc
    Replies:
    2
    Views:
    85
    Steve Lidie
    Jul 9, 2003
  5. Stefan

    Windows Perl/Tk Sirius App

    Stefan, Jul 4, 2008, in forum: Perl Misc
    Replies:
    0
    Views:
    220
    Stefan
    Jul 4, 2008
Loading...

Share This Page