comment on

This was inspired by Which Perl modules to use to display karaoke lyrics?. After a bit of thought, I figured out how to get the output of timidity through IPC::Open3. You need to open a shell, and let it execute timidity. Instead of opening timidity itself.

The method of opening a shell, lets you stop play of a kar file, and start another, without restarting the program.

This script shows a couple of neat tricks, like how to set a background image resized to fullscreen, on a canvas. I use Imager, but have included the equivalent Image::Magick method in comments.

I also didn't spend much time making sure it would run without tweaking on all Xserver screen dimensions. I run 1024x768 and things work well. If you have a smaller screen, you will have to adjust the "big font" size, and adjust the upward scrolling line at

$canvas->move('text', 0, -45);
[download]

There may be a few other tweaks needed on a smaller screen too, but this should be a pretty good basis for how to do this.

There is also the problem of "readbility of the text as it scrolls upward". I have no trouble following it, but some people may like the lyrics presented in a longer line, instead of word by word. I tried making a tempstring which nicely slows down the scrolling, but I've noticed that it occaisionally lags behind the music. The code I tried is

     $tempstring .= $buf;
     if($tempstring =~ /\n/){
        my @temps = split(/\n/,$tempstring);
        write_lyric("$temps[0] $temps[1]\n");
       $tempstring = '';
      }
[download]

But you may know a better way.

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::JPEG;
use IPC::Open3;
use Imager;
use MIME::Base64;

local *IN;
local *OUT;
local *ERR;
$|=1;

my $imagenam = shift || '1Zen16.jpg'  or die "need a jpg $!\n";
my $defaultkar = "sloop-john-b.kar";

my $start = 0;  # clip off midi header info 

my $pid = open3(\*IN,\*OUT,\*ERR,'/bin/sh');
my $timpid; #used to stop timidity with closing filehandles to sh 

my $mw = new MainWindow;

my ($width,$height) = ( $mw->screenwidth(), $mw->screenheight() );

#################################################### 
my $imagein = Imager->new();
my $imageout;
$imagein->open(file=>$imagenam, type=>'jpeg') or die $imagein->errstr(
+);
my $newimg = $imagein->scale(xpixels=>$width, ypixels=>$height, type=>
+'min');
$newimg->write(type => 'jpeg', data => \$imageout );
my $imageenc = encode_base64($imageout) or die $!;
my $image = $mw->Photo(-data => $imageenc);
#################################################### 
#in case you want to use Image Magick 
# use Image::Magick; 
# my $im = Image::Magick->new; 
# $im->Read($imagenam); 
# $im->Scale( geometry => $width.'x'.$height); 
# my $imageout = $im->ImageToBlob(); 
# my $imageenc = encode_base64($imageout) or die $!; 
# my $image = $mw->Photo(-data => $imageenc);    
######################################################## 

$mw->fontCreate('big',
     -family=>'courier',
     -weight=>'bold',
     -size=>int(-32*32/18));

my $topframe = $mw->Frame(-bg => 'steelblue')->pack(-fill =>'x');
my $lab = $topframe->Label(
         -text=> 'Enter Kar file to play: ')->pack(-side=>'left');

my $entry=$topframe->Entry(-width => 80)->pack(-side=>'left');

$entry->bind('<Return>', \&send_to_shell );

$topframe->Button(-text => 'Ok',
        -command => \&send_to_shell)->pack(-side=>'left');

$topframe->Button(-text => 'Exit',
                 -command => sub{exit})->pack(-side=>'right',-padx=>10
+);

my $stopbut = $topframe->Button(-text => 'Stop',
                -state => 'disabled',
                -command => \&send_stop)->pack(-side=>'left',-padx=>10
+);

my $canvas = $mw->Canvas(
                    -width => $width,
                    -height => $height,
                    -bg=>'black',
                  )->pack(-expand => 1, -fill=>'both');


my $tile = $canvas->createImage(0,0,
           -image=> $image,
           -anchor => 'nw',
          );

$mw->fileevent(\*OUT,'readable',\&get_from);

MainLoop;

sub send_to_shell {
   $canvas->delete('text');
   my $cmd=$entry->get() || $defaultkar;
   $cmd = "timidity $cmd";
   print IN "$cmd\n";
   $stopbut->configure(-state => 'normal');
   $entry->configure(-state => 'disabled');

}
sub get_from {
     my $buf='';
     sysread OUT,$buf,1024;

     if($buf =~ /Title/){
               $start = 1;
               #hack to get first word of actual song lyrics 
               my @words=split(/\s+/,$buf);
               $buf = pop @words;
               }
     if( $start == 0){ return}

  $buf =~ tr/\n/ /;
  write_lyric("$buf\n");
}

sub write_lyric {
   my $str = shift;

   $canvas->createText($width/2, $height-50,
          -fill => 'hotpink',
          -font => 'big',
          -text => $str,
          -tags => ['text'],
   );

$canvas->move('text', 0, -45);

}

sub send_stop{
    my $timgrep = `ps -a | grep timidity`;
    ($timpid) = $timgrep =~ /(\d+)/;
    system("kill $timpid");
    $stopbut->configure(-state =>'disabled');
    $entry->configure(-state => 'normal');
    $start = 0;
    }

__END__
[download]

In reply to Tk-Karoake Player-w-timidity by zentara

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.