Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
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;
# 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 ); }


Jouke Visser, Perl 'Adept'

In reply to pVoice 0.01 by Jouke

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • 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, 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, 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:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (7)
    As of 2015-07-29 08:13 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (261 votes), past polls