Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
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
  • Outside of code tags, you may need to use entities for some characters:
            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 about the Monastery: (6)
    As of 2014-12-21 12:21 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (104 votes), past polls