pVoice 0.01

Since I've mentioned the project so many times in the chatterbox and many people have shown interest, I thought it would be fair to let you all see what I have up till now. Updates will come later.

Update: I'm posting next versions on this node.
Update II: Changed the link to www.pvoice.org
If you want to know more about it, check out http://www.pvoice.org

#!/usr/bin/perl -w
#
# pVoice
#
# pVoice is a simple speech-application for disabled people. It displa
+ys buttons
# with images, and by selecting them, the corresponding word will be s
+poken.
# The images have to be in JPEG fileformat and will be resized to fit 
+in the
# defined $MAX_HEIGHT and $MAX_WIDTH.
#
# Words are grouped together in categories. These categories are defin
+ed in the
# file $SOUNDDIR/$CATFILE which has the following format:
# <pagenumber><tab><categorynumber><tab><categoryname><newline>
# Pagenumber can currently only be '1', categorynumbers start at '0', 
+and 
# categoryname is a self-defineable name for the category. There has t
+o be a
# $SOUNDDIR/<categoryname>.$IMG_EXT and a directory $SOUNDDIR/<categor
+yname>. 
# For example:
# if $SOUNDDIR is './data', and $IMG_EXT is set to 'jpg' and if the fi
+rst 
# category is named 'people', there has to be a file ./data/people.jpg
+ and
# a directory ./data/people .
#
# In the directory <categoryname> there is a file $INDEXFILE, in which
+ the
# words of that category are defined. The $INDEXFILE has the following
+ format:
# <pagenumber><tab><wordnumber><tab><word><newline>
# Pagenumbers start at 1, wordnumbers start at 0. The word must corres
+pond with
# a <word>.$SOUND_EXT and <word>.$IMG_EXT. For example:
# if $SOUNDDIR is './data/, $IMG_EXT is 'jpg', $SOUND_EXT is 'wav' and
+ the
# current category is 'people', then if a word 'teacher' is listed in 
+the 
# $INDEXFILE, there has to be a file ./data/people/teacher.jpg (the im
+age) and
# a file ./data/people/teacher.wav (the sound)
#
# There are three neccesary 'navigation-images', namely $UP_IMG, $NEXT
+_IMG and
# $PREV_IMG, which have to reside in the $SOUNDDIR. They are used for 
# -respectively- going back to the category-page, going to the next wo
+rdpage and
# going to the previous wordpage.
#
# To operate the program only two 'actions' are needed. A left mousebu
+ttonclick
# and a right mousebuttonclick. Disabled people (like my daughter) can
+ generate
# these mouseevents with various devices like a headsupport, which gen
+erates
# a left click when the head goes left, and a right click when the hea
+d goes 
# right.
# One thing to keep in mind is that the mousepointer itself should sta
+y inside
# the program-window, but pointed at the window-background - not at an
+ image.
# To browse through the images, keep clicking right. To activate an im
+age 
# (either a word, a category or an up/left/right arrow), click left.
# 
# It works on both Win32 platforms (tested on Win98) and Unix platform
+s (tested
# on SuSE Linux 6.4 and 7.0) but requires the following modules:

use Tk 800.017;
use Tk::JPEG;
use GD 1.27;
use MIME::Base64;

# And on unix-systems it requires the system command 'play' to play th
+e .wav 
# files, and on Win32 systems, it requires Win32::Sound for the same p
+urpose.
#
# Author:        Jouke Visser
# Last modification:    March 15, 2001
#
# Copyright (c) 2001, Jouke Visser
# pVoice may be distributed under the terms of Perl itself (either usi
+ng the
# Artistic License or the GNU Public License)

require Win32::Sound if $^O eq "MSWin32"; 
use strict;
[download]

# These variables are global, so they don't have to be passed through 
+to every 
# subroutine
use vars qw (
        $PROGRAM_TITLE    
        $BGCOLOR 
        $ACTIVE_BGCOLOR      
        $SOUNDDIR       
        $CURRENT_CATEGORY 
        $CURRENT_PAGE
        $INDEXFILE        
        $CATFILE          
        $SOUND_EXT        
        $IMG_EXT          
        $NEXT_IMG         
        $PREV_IMG         
        $UP_IMG           
        $MAX_HEIGHT       
        $MAX_WIDTH        
        $BORDER_WIDTH     
        $SELECTED_BUTTON  
        @BUTTONS          
        );
#---------------------------------------------------------------------
+---------

# Configuration-stuff
$PROGRAM_TITLE    = "pVoice";
$BGCOLOR       = 'white';
$ACTIVE_BGCOLOR      = 'red';
$SOUNDDIR       = "./data";
$CURRENT_CATEGORY = "";
$CURRENT_PAGE      = 1;
$INDEXFILE        = "index.txt";
$CATFILE          = "cat.txt";
$SOUND_EXT        = "wav";
$IMG_EXT          = "jpg";
$NEXT_IMG         = "volgende.$IMG_EXT"; # next-image
$PREV_IMG         = "vorige.$IMG_EXT";   # previous-image
$UP_IMG           = "omhoog.$IMG_EXT";   # up-image
$MAX_HEIGHT       = 120;
$MAX_WIDTH        = 100;
$BORDER_WIDTH     = 10;
$SELECTED_BUTTON  = 0;
@BUTTONS          = (); 

# Create the main window
my $main = MainWindow->new(-background => $BGCOLOR);
# Maximize the window
my ($screenw, $screenh) = ($main->screenwidth, $main->screenheight);
$main->geometry($screenw."x".$screenh);

# Write the title of the window
$main->title($PROGRAM_TITLE);

#create the window for the images
my $mainframe = $main->Frame(-background => $BGCOLOR)->pack();
#                    -fill=>'both', 
#                    -expand=>1
#                    );

#configure the grid to constant cellsizes
$mainframe->gridColumnconfigure(0, -minsize => $MAX_WIDTH + 2*$BORDER_
+WIDTH,
                   -weight => 0, -pad => 4);
$mainframe->gridColumnconfigure(1, -minsize => $MAX_WIDTH + 2*$BORDER_
+WIDTH, 
                -weight => 0, -pad => 4);
$mainframe->gridColumnconfigure(2, -minsize => $MAX_WIDTH + 2*$BORDER_
+WIDTH, 
                -weight => 0, -pad => 4);
$mainframe->gridColumnconfigure(3, -minsize => $MAX_WIDTH + 2*$BORDER_
+WIDTH, 
                -weight => 0, -pad => 4);
$mainframe->gridRowconfigure   (0, -weight => 0, -pad => 4);
$mainframe->gridRowconfigure   (1, -minsize => $MAX_HEIGHT + 2*$BORDER
+_WIDTH, 
                -weight => 0, -pad => 4);
$mainframe->gridRowconfigure   (2, -minsize => $MAX_HEIGHT + 2*$BORDER
+_WIDTH, 
                -weight => 0, -pad => 4);
$mainframe->gridRowconfigure   (3, -minsize => $MAX_HEIGHT + 2*$BORDER
+_WIDTH, 
                -weight => 0, -pad => 4);
$mainframe->gridRowconfigure   (4, -minsize => $MAX_HEIGHT + 2*$BORDER
+_WIDTH, 
                -weight => 0, -pad => 4);

# Write the header
my $label=$main->Label(-text => $PROGRAM_TITLE, -background => $BGCOLO
+R);
$label->grid(
        -in     => $mainframe,
        -column => 0,
        -row    => 0,
        -columnspan=> 4
        );

# Read the categoryfile and draw the first page with category-buttons
my @categories = readcategoryfile();
drawcatpage($mainframe, \@categories);

# Make the first button active 
$BUTTONS[$SELECTED_BUTTON]->configure(-state => 'active');

# At present time only left and right mousebuttons are used...
$main->bind('<Button-3>', 
        sub { 
            $BUTTONS[$SELECTED_BUTTON]->configure(
                            -state => 'normal'); 
            if ($SELECTED_BUTTON < @BUTTONS -1) 
                {$SELECTED_BUTTON++} 
            else     {$SELECTED_BUTTON=0} 
            $BUTTONS[$SELECTED_BUTTON]->configure(
                            -state => 'active');
            } 
        );
$main->bind('<Button-1>', sub { 
                    $BUTTONS[$SELECTED_BUTTON]->invoke;
                    }
        );
MainLoop;

#---------------------------------------------------------------------
+---------
sub play
# Play the sound
{
    my ($label) = @_;
    my $file = "$SOUNDDIR/$CURRENT_CATEGORY/$label.$SOUND_EXT"; 
    warn "File does not exist ($file)" unless (-f $file);
    return sub {system('play', "$file")} if $^O ne 'MSWin32';
    return sub {Win32::Sound::Play($file)} if $^O eq 'MSWin32';
}


#---------------------------------------------------------------------
+---------
sub readcurrentcategoryindex
{
    my (@categorycontents, $page, $index, $file);
    # Parse index.txt in the category directory and open the files
    open (INDEX, "$SOUNDDIR/$CURRENT_CATEGORY/$INDEXFILE") || die "Can
+'t open $SOUNDDIR/$CURRENT_CATEGORY/$INDEXFILE: $!\n";
    my @indexfile = <INDEX>;
    close(INDEX);

    foreach(@indexfile)
    {
        next if !($_);
        chop;
        ($page, $index, $file) = split(/\t/);
        $categorycontents[$page]->[$index]=$file;
    }
    return @categorycontents;
}

#---------------------------------------------------------------------
+---------
sub readcategoryfile
{
    my (@categoryfile, $page, $index, $dir);
    # Parse cat.txt 
    open (INDEX, "$SOUNDDIR/$CATFILE") || die "Can't open $SOUNDDIR/$C
+ATFILE: $!\n";
    my @catfile = <INDEX>;
    close(INDEX);

    foreach(@catfile)
    {
        next if !($_);
        chop;
        ($page, $index, $dir) = split(/\t/);
        $categoryfile[$page]->[$index]=$dir;
    }
    return @categoryfile;
}

#---------------------------------------------------------------------
+---------
sub drawpage
{    
    my ($mainframe, $categorycontentsref) = @_;
    my @categorycontents = @{$categorycontentsref};
    my ($j, @images);
    @BUTTONS = ();
    die "No words found\n" unless @{$categorycontents[$CURRENT_PAGE]};
+ 

    if ($CURRENT_PAGE eq 1) 
    {
        addupbutton($mainframe, \@categorycontents);
    }
    else {
        addprevbutton($mainframe, \@categorycontents);
    }
    my $y=1;
    #Draw the images of the current category (first page)
    for ($j=1; $j<15; $j++)
    {
        next if not defined($categorycontents[$CURRENT_PAGE]->[$j-1]);

        my $scaledimage = $mainframe->Photo(
                            "button$y", 
                            -data   => scaleimage("$SOUNDDIR/$CURRENT_
+CATEGORY/$categorycontents[$CURRENT_PAGE]->[$j-1].$IMG_EXT"), 
                            -format => 'jpeg'
                            );

        my $callback = \&play($categorycontents[$CURRENT_PAGE]->[$j-1]
+);
        $BUTTONS[$y] = $mainframe->Button(
                            -activebackground => $ACTIVE_BGCOLOR, 
                            -borderwidth      => $BORDER_WIDTH, 
                            -image            => "button$y", 
                            -command          => $callback,
                            -relief           => 'flat'
                            );
        $BUTTONS[$y]->grid(
                    -in     => $mainframe,
                    -column => ($j%4),
                    -row    => int($j/4)+1
                    );
        $y++;
    }


    
}

#---------------------------------------------------------------------
+---------
sub scaleimage
{
    my ($file) = @_;
    open(GDFILE, $file) || die "File could not be opened ($file) : $!\
+n";
    my $im = GD::Image->newFromJpeg(\*GDFILE);
    close (GDFILE);
    my ($width, $height) = $im->getBounds();
    # Create an empty image with the desired dimensions
    my $resizedim = $width/($height/$MAX_HEIGHT)<$MAX_WIDTH ? new GD::
+Image($width/($height/$MAX_HEIGHT),$MAX_HEIGHT) : new GD::Image($MAX_
+WIDTH, $height/($width/$MAX_WIDTH));
    # Copy everything from $im and resize it into $resizedim
    $resizedim->copyResized($im,0,0,0,0,$resizedim->getBounds(),$width
+, $height);
    # encode the jpeg-output of the $resizedim
    return encode_base64($resizedim->jpeg(100));
}

#---------------------------------------------------------------------
+---------
sub drawcatpage
{    
    my ($mainframe, $categoryref) = @_;
    my @categories = @{$categoryref};
    my ($j, @images, $x);
    @BUTTONS = ();
    die "No categories found\n" unless $#{$categories[$CURRENT_PAGE]};
+ 

    $x = 0;
    #Put the images of the categories on the screen
    for ($j=1; $j<=@{$categories[$CURRENT_PAGE]}; $j++)
    {
        my $idx = $CURRENT_PAGE eq 1 ? $x : $j;
        my $cat = $categories[$CURRENT_PAGE]->[$x];
        my $scaledimage = $mainframe->Photo("button$idx", 
                            -data => scaleimage("$SOUNDDIR/$cat.$IMG_E
+XT"), 
                            -format => 'jpeg'
                        );
        my $callback = sub {
                    #retrieve the categorycontents
                    $CURRENT_CATEGORY=$cat;
                    my @categorycontent = readcurrentcategoryindex();
                    foreach (@BUTTONS) 
                    {
                        $_->destroy()
                    } 
                    @BUTTONS = ();
                    $CURRENT_PAGE=1;
                    drawpage($mainframe, \@categorycontent);
                    if ($CURRENT_PAGE < $#categorycontent) {addlastbut
+ton($mainframe, \@categorycontent);}
                    else {addupbutton($mainframe, \@categorycontent);}
                    $SELECTED_BUTTON=0;
                    $BUTTONS[$SELECTED_BUTTON]->configure(-state => 'a
+ctive');
                    };
        $BUTTONS[$idx] = $mainframe->Button(
                            -activebackground => $ACTIVE_BGCOLOR, 
                            -borderwidth      => $BORDER_WIDTH, 
                            -image            => "button$idx", 
                            -command          => $callback,
                            -relief           => 'flat'
                            );
        $BUTTONS[$idx]->grid(
                    -in     => $mainframe,
                    -column => ($idx%4),
                    -row    => int($idx/4)+1
                    );
        $x++;
    }


    
}

#---------------------------------------------------------------------
+---------
sub addupbutton
{
    my ($mainframe, $categorycontentref) = @_;
    my @categorycontent = @$categorycontentref;
    my $i = @BUTTONS;
    my $y = $CURRENT_PAGE == $#{$categorycontentref} ? 15 : 0;
    my $scaledimage = $mainframe->Photo("button$i", 
                        -data => scaleimage("$SOUNDDIR/$UP_IMG"), 
                        -format => 'jpeg'
                    );
    my $callback = sub {
                my @categories = readcategoryfile();
                foreach (@BUTTONS) 
                {
                    $_->destroy()
                } 
                @BUTTONS = ();
                $CURRENT_PAGE=1;
                drawcatpage($mainframe, \@categories);
                $SELECTED_BUTTON=0;
                $BUTTONS[$SELECTED_BUTTON]->configure(-state => 'activ
+e');
    
                };
    $BUTTONS[$i] = $mainframe->Button(
                        -activebackground => $ACTIVE_BGCOLOR, 
                        -borderwidth      => $BORDER_WIDTH, 
                        -image            => "button$i", 
                        -command          => $callback,
                        -relief           => 'flat'
                        );
    $BUTTONS[$i]->grid(
                -in     => $mainframe,
                -column => $y%4,
                -row    => int($y/4)+1
                );
}

#---------------------------------------------------------------------
+---------
sub addlastbutton
{
    my ($mainframe, $categorycontentref) = @_;
    my @categorycontent = @$categorycontentref;
    my $y = 15;
    my $j = @BUTTONS;
    my $scaledimage = $mainframe->Photo("button$j", 
                        -data => scaleimage("$SOUNDDIR/$NEXT_IMG"), 
                        -format => 'jpeg'
                    );
    my $callback = sub {
                foreach (@BUTTONS) 
                {
                    $_->destroy()
                } 
                @BUTTONS = ();
                $CURRENT_PAGE++;
                drawpage($mainframe, \@categorycontent);
                if ($CURRENT_PAGE < $#categorycontent) {addlastbutton(
+$mainframe, \@categorycontent);}
                else {addupbutton($mainframe, \@categorycontent);}
                # Make the first button active
                $SELECTED_BUTTON=0;
                $BUTTONS[$SELECTED_BUTTON]->configure(-state => 'activ
+e');
                };
    $BUTTONS[$j] = $mainframe->Button(
                        -activebackground => $ACTIVE_BGCOLOR, 
                        -borderwidth      => $BORDER_WIDTH, 
                        -image            => "button$j", 
                        -command          => $callback,
                        -relief           => 'flat'
                        );
    $BUTTONS[$j]->grid(
                -in     => $mainframe,
                -column => ($y%4),
                -row    => int($y/4)+1
                );
}

#---------------------------------------------------------------------
+---------
sub addprevbutton
{
    my ($mainframe, $categorycontentref) = @_;
    my @categorycontent = @$categorycontentref;
    my $j = @BUTTONS;
    my $scaledimage = $mainframe->Photo("button$j", 
                        -data => scaleimage("$SOUNDDIR/$PREV_IMG"), 
                        -format => 'jpeg'
                    );
    my $callback = sub {
                foreach (@BUTTONS) 
                {
                    $_->destroy()
                } 
                @BUTTONS = ();
                $CURRENT_PAGE--;
                drawpage($mainframe, \@categorycontent);
                if ($CURRENT_PAGE < $#categorycontent) {addlastbutton(
+$mainframe, \@categorycontent);}
                else {addupbutton($mainframe, \@categorycontent);}
                $SELECTED_BUTTON=0;
                $BUTTONS[$SELECTED_BUTTON]->configure(-state => 'activ
+e');
                };
    $BUTTONS[$j] = $mainframe->Button(
                        -activebackground => $ACTIVE_BGCOLOR, 
                        -borderwidth      => $BORDER_WIDTH, 
                        -image            => "button$j", 
                        -command          => $callback,
                        -relief           => 'flat'
                        );
    $BUTTONS[$j]->grid(
                -in     => $mainframe,
                -column => ($j%4),
                -row    => int($j/4) +1
                );
}
[download]

Jouke Visser, Perl 'Adept'

Comment on pVoice 0.01 Select or Download Code

Replies are listed 'Best First'.
Re: pVoice 0.01 by jeroenes (Priest) on Apr 27, 2001 at 10:53 UTC
Jouke, great to see the code! May your daughter and others enjoy the use of it... Little remark (at first glance): It would be nice if you warn users at startup if they are on unix and not have the 'play' command available. I've glanced at CPAN (yes, it's still your friend), and I saw a few possibilities. -Audio::Play plays sounds on both unix and win32, but it cannot play WAVs, only .au and .snd formats, which I don't know. -Audio::Play::MPG123 plays mpegs cross-platform (tested on win32 and linux). There are many more modules to convert and change audio-files in different formats. Search on Audio to find them. Hope this helps, Jeroen "We are not alone"(FZ)	[reply]
Re: Re: pVoice 0.01 by Jouke (Curate) on Apr 27, 2001 at 11:08 UTC
Short replies to your comments: 1. There are a lot of things to improve, indeed like warning if things aren't available and they should. I'll take that into consideration for a next step. 2. I've been looking around for the most suitable cross-platform audio-player. Audio::Play seems to be suitable, but OeufMayo has tried to compile it in different ways on Win32 with no luck. I've contacted the author -Nick Ing-Simmons- who promised to update the CPAN-version because he has another version that DOES compile on Win32...sadly he didn't up till now despite some reminder-mails from me... 3. I'll take a look at Audio::Play::MPG123. I didn't look any further at it because I thought it was only a wrapper around some other tool. It would however be a great improvement if I could play MP3's. I'm planning to use Festival for the speech-output, but Kevin Lenzo (one of Festival's authors) is still busy with the dutch language part...takes time... Jouke Visser, Perl 'Adept'	[reply]
Re: pVoice 0.01 by azatoth (Curate) on Apr 26, 2001 at 16:36 UTC
Rock on, Jouke! It's always nice to see Perl working its wonders in every way, shape and form. I truly hope pVoice is a success for you and your daughter. Azatoth a.k.a Captain Whiplash Make Your Die Messages Full of Wisdom! Get YOUR PerlMonks Stagename here! Want to speak like a Londoner?	[reply]
Re: pVoice 0.01 by mrmick (Curate) on Apr 27, 2001 at 04:24 UTC
Wonderful! It touches my heart (and what's left of my soul) to see Perl put to GOOD use. ++Jouke for this one! Mick	[reply]
Re: pVoice 0.01 by Sinister (Friar) on Apr 26, 2001 at 18:10 UTC
Jouke, Without beeing unpolite; isn't it better when you try to catch file opening problems instead of letting your script die... I could imagine your daughter isn't able to restart the application her-self ... Generating an error message and letting the application return to the screen it came from seems a more humane variety then die (not only for the disabled...) I've tried to run it, but after five minutes of trying I gave up. I'll try again tonight ;-) Anyway... Keep up the good work! *Sinister greetings.*	[reply]
Re: Re: pVoice 0.01 by Jouke (Curate) on Apr 26, 2001 at 18:17 UTC
Very important -but very un-programmer-ish - is to read the documentation at the top of the script. It's explained there how to make it run. The whole script can't do a thing if it can't open those files. And my daughter is the user, not the administrator. I'm the one who makes it work (to be quite correct: this morning I was responsible for the whole damn thing to crash so she had to go to school without her pVoice :( Literally a crying shame ), she's the one to use it. But -even more important- this is only version 0.01...things will be better in the future...tonight will be an evening full of pStory (see my homenode for details...Tomorrow night will probably be a night full of pVoice... Jouke Visser, Perl 'Adept'	[reply]