Jon Bjornstad recently presented a "Lightning Talk" at the 2001 O'Reilly Open Source Convention. He discussed a program that he had written for his friend, Sue Simpson. She is a mute quadriplegic, and Jon's program allows her to "speak", read online texts, and browse photos. The program is remarkably clever in its use of Perl/Tk to overcome various obstacles in the creation of an accessible GUI.

This program wasn't Jon's first volunteer effort; he earlier developed a complete administration program for a school and a Web store for a community project. A long-time C programmer, Jon found Perl five years ago and hasn't gone back since. Given the rapid development and assorted features he needed for Sue's program, it's a decision he has never regretted.

Jon met Sue in 1986 through a mailing list request to help her install software, and they became friends. For years he helped configure and program a device called the Express 3, a rectangular array of LEDs to which Sue could point with a light pen attached to her glasses. As that device became obsolete, newer devices were found to be too expensive, and other options did not seem to fit her needs. Jon began writing a program specifically tailored for Sue that would allow her to easily type and communicate. Since then, the program has continued to evolve into a full user environment. See Figure 1.

Figure 1

A Text Interface for Speaking

The first feature Jon created was an online keyboard (Figure 2) to allow Sue to input data. Because she cannot click a mouse button, the ability to select onscreen elements with movement presented an initial challenge. Jon employed the rarely used Enter and Leave motion callbacks for a Label, in combination with a timer functionality. The following simplified program illustrates this functionality and is shown in Figure 3. First, a window (the MainWindow object class) and a label to contain the value of variable $msg are created:

Figure 2

Figure 3

use Tk;

my $mw = MainWindow->new(-bg => "white");
my $msg = "";
$mw->Label(
    -textvariable => \$msg,
    -font         => "Arial 18 bold",
    -width        => 30,
    -bg           => "skyblue",
    -anchor       => 'w',
    -relief       => 'ridge',
)->pack;

Next, a subroutine show is defined, which will later serve as a callback function. The action here is dependent on the first parameter to this function, stored as $let :

sub show {
    my $let = shift;
    if ($let eq "Quit") {
        exit;
    } elsif ($let eq "Clear") {
        $msg = "";
    } elsif ($let eq "Del") {
        chop $msg;
    } else {
        $msg .= $let;
    }
}

Having defined the necessary elements and callback, we can populate the window with labels. Note that we are detecting the Enter and Leave events for each, and binding them to a subroutine reference, which in turn calls the show() callback:

my ($lab, $timer);
for my $let (qw(A B C D E Del Clear Quit)) {
    $lab = $mw->Label(
        -text   => " $let ",
        -font   => 'Arial 18 bold',
        -bg     => length($let) > 1? 'violet': 'lightgreen',
        -relief => 'ridge',
    )->pack;
    $lab->bind("<Enter>", sub {
        if ($let eq "Del") {
            $timer = $mw->repeat(500, [ \&show, $let ]);
        } else {
            $timer = $mw->after( 500, [ \&show, $let ])
        }
    });
    $lab->bind("<Leave>", sub {
        $timer->cancel;
    });
}

After looping to create the buttons (labels), the timers are implemented with the MainWindow method calls. When the mouse hovers over any label other than "Del", a timer after() function is called, which will delay the selection of that label. Once the time has passed, show() is called, and the action appropriate for the value of $let will execute.

This final piece of code starts the main Tk code loop:

MainLoop;

Using code similar to this, Sue is able to select any screen elements by hovering over them for an interval with no required mouse buttons. In practice, Sue uses a "head mouse" ( https://www.orin.com/access/headmouse/phm.htm ) fixed to her glasses, rather than the mouse.

Word Prediction

Typing an entire word can be time-consuming and laborious. For this reason, most text-input interfaces of this type perform a word prediction (Figure 4). As the letters are selected, the list shortens to reflect the matching words. Consider that the letters "esp" prefix 48 words in an unabridged dictionary, but the only ones commonly used are:

Figure 4

ESP
especially
Esperanto
espionage
espousal
espresso
esprit

By displaying the list after each letter is selected, Sue can select the word she wants after entering only a few letters. Jon decided to implement this feature with words Sue had typed previously, ordering the list according to the number of times she had used them. With the following excerpt, the list is read from or written to a plain text file rather than a DBM file (to facilitate manual editing):

my %times;      # key is the word
               # value is number of times it had been used

sub read_words {
    my ($word, $freq);
    open IN, "words.txt" or die "cannot open words.txt\n";
    while (<IN>) {
        chop;
        ($word, $freq) = split;
        $times{uc $word} = $freq;
    }
    close IN;
}

sub by_freq {
    $times{$b} <=> $times{$a} or
    $a cmp $b;
}

sub write_words {
    open OUT, ">words.txt" or die "cannot open words.txt\n";
    for my $w (sort by_freq keys %times) {
        print OUT "$w\t$times{$w}\n";
    }
    close OUT;
}

The program can then search the list for words. For example, to search for words beginning with a prefix:

my (@words);
my $maxwords = 10;        # actually 11 in all
for my $i (0 .. $maxwords) {
    $words[$i] = "";
    $mw->Label(
        -textvariable => \($words[$i]),
        # ... all other attributes
    )->pack;
    # ... Enter and Leave callbacks as above
}

sub clear_words {
       for my $w (@words) {
               $w = "";
       }
}

sub fill_words {
    clear_words;
    my $prefix = Msg->last_word;
    my $n = 0;
    for my $w  (sort by_freq
               grep { /^$prefix/ and \
                     $times{$_} > 1 }
               keys %times) {
        $words[$n] = $w;
        return if ++$n > $maxwords;
    }
}

The labels here are created with a textvariable attribute pointing to one of the elements in the @words array. The function fill_words() is called after each letter is added to the message window. Msg->last_word returns the last blank-separated word in the message window, and this word is then used as a prefix to search for subsequent matching words. Note that all the keys in the %times hash are considered, but only those matching the prefix are included:

grep { /^$prefix/ and $times{$_} > 1 }

A further restriction is to include only words that have been used more than once, which helps eliminate typos and misspellings. The resulting list is sorted by frequency, so the words near the top will be the ones most often selected. As a word is used more frequently, it will "rise" in the list to be more readily chosen.

All these features combine to allow Sue to quickly input words to form sentences. Once a sentence is entered, the program is able to speak it with a text-to-speech synthesizer. The synthesizer is a freely downloadable Microsoft program, which interfaces easily with Perl.

Texts and the Dictionary

Another feature of Sue's program is the ability to read online texts downloaded from the Gutenberg project (https://www.gutenberg.org). She can browse the texts as a hierarchy, jump quickly to sections, and bookmark pages. See Figure 5.

Figure 5

Soon after Jon created this functionality, Sue came across this passage while reading The Adventures of Tom Sawyer by Mark Twain,:

"... he uncovered an ambuscade, in the person of his aunt;

... her resolution became adamantine in its firmness."

She turned to her daughter and asked, "Do you think Jon could get a dictionary into this thing?" Jon accepted the challenge and devised a solution whereby pausing over words in the text would pop up the dictionary definitions (Figure 6). Starting with the 1913 Webster's Dictionary (also from the Gutenberg project), and then using the href="https://www.mso.anu.edu.au/~ralph/OPTED">OPTED project (which formats the text in consistent HTML, one word per line), Jon converted the dictionary into a DBM file for quick access. An excerpt from the dictionary looks like this:

Figure 6

<P><B>Abacus</B> (<I>n.</I>) A table or tray strewn
    with sand, anciently used for drawing, calculating, etc.</P>
<P><B>Abacus</B> (<I>n.</I>) A calculating table or frame;
    an instrument for performing arithmetical calculations by
    balls sliding on wires, or counters in grooves,
    the lowest line representing units, the second line,
    tens, etc. It is still employed in China.</P>
<P><B>Abada</B> (<I>n.</I>) The rhinoceros.</P>
<P><B>Abaddon</B> (<I>n.</I>) The destroyer, or angel of the
    bottomless pit; -- the same as Apollyon and Asmodeus.</P>

To index the 17 MB of data with DBM files, the following snippet was used:

use strict;
my (%dict, $last, $word);

unlink <*_dict.*>;      # tidy up any old ones

for my $let ('a' .. 'z') {
    dbmopen %dict, "${let}_dict", 0777;
    open IN, "wb1913_$let.html" or
        die "cannot open wb1913_$let.html\n";
    $last = "";
    while (<IN>) {
        next unless ($word) = m#^(.*)#;
        next if $word eq $last;
        $dict{$word} .= (tell(IN)-(length)-1) . " ";
                                   # -1 because of ^M at the end
                                   # of the lines
        $last = $word;
    }
    close IN;
    dbmclose %dict;
}

This creates a separate DBM file ( .pag and .dir ) for each letter of the alphabet, with the key as the word and the value as the concatenation of the seek addresses within the .html file containing the word's definitions. With the DBM files in place, it is easy to quickly provide a define() subroutine to display the definition for $word .

my %dict;
$word = ucfirst lc $word;
my $fl = lc substr($word, 0, 1);
dbmopen %dict, "dictionary/${fl}_dict", 0666
    or die "cannot dmbopen ${fl}_dict: $!\n";
open IN, "dictionary/wb1913_$fl.html" or
    die "could not open dictionary/wb1913: $!\n";

my $addrs = $dict{$word};           # the seek addresses
return unless $addrs;
insert("$word\n");                  # insert into a text widget
for my $a (split /\s+/, $addrs) {
    seek(IN, $a, 0) or die "cannot seek to $a in dict for $word $!\n";
    while (defined($line = <IN>) and
           $line =~ m%
               ^<P><B>$w</B>\     # must match the word
               \((.*)\)\     # part of speech into $1
               (.*)</P>$%x) {  # the definition into $2

        insert("\n  $1");
        my $def = $2;
        my $i;
        while (length($def) > 50) {        # wrap lines at 50 chars
            $i = rindex($def, ' ', 50);
            insert("\t  " . substr($def, 0, $i) . "\n");
            $def = substr($def, $i+1);
        }
        insert("\t  $def");
    }
}
close IN;
dbmclose %dict;

With the above, it is simple to truncate suffixes and add definitions for the resultant root word:

my $w;
for my $suffix (qw(s ly ed ing es ness)) {
    $w = $word;        # restore the original
    define($w) if $w =~ s/$suffix$//;
}

The final step of the dictionary feature was to make it convenient for Sue to simply point the cursor at a word within the text and have the definition of that word appear. The tricky part was determining which word was under the cursor at any given moment. A careful perusal of the book, Learning Perl/Tk by Nancy Walsh gave several suggestions. Jon began by creating a Define Tk label, which executes the following code when activated:

$lastw = "";
$firstTime = 0;
$mw->bind("<Motion>", \&show);
$readwin->configure(-cursor => "question_arrow");

Binding <Motion> events in this way should be the exception since they are activated by any mouse motion, causing many invocations of show() . Note that above, $readwin is the text widget containing the words we are reading. When the program switches to this "definition mode", the cursor for $readwin is changed to a little question mark. This cursor is used to pass over words in order to select the word to define.

Next, the show callback:

sub show {
    my $e = $readwin->XEvent;
    return unless $e;
    my ($x, $y, $time) = ($e->x, $e->y, $e->t);
    my $p = "\@$x,$y";
    my $w = $readwin->get("$p wordstart", "$p wordend");
    return unless length($w) > 3;
    if ($w ne $lastw) {
        $lastw = $w;
        $firstTime = $time;
    } elsif ($time - $firstTime > 1000) {
        $mw->bind("<Motion>", undef);
        $readwin->configure(-cursor => "arrow");
        Dict->define($w);
    }
}

The fancy footwork with XEvent gives us the exact (x,y) coordinate of the cursor and the time (in milliseconds) it passed over that spot. The get() method of the Text widget tells us what text is under a specific spot. With the wordstart and wordend modifiers, we can isolate the precise word under the cursor.

A few "catch" rules were used to prevent unintended words from being defined, which included ignoring all words of three characters or less and using $lastw and $firstTime to keep track of how long a word is hovered over before activating the pop-up definition.

The (Not So) Final Program

The complete program also gives Sue the ability to change display colors and browse photo albums of family and friends. Jon plans to add more features, including an X10 interface so that Sue can control her lights and television from within the program.

Jon's program is a good example of the flexibility of Perl. Because it's Perl-based, the program runs equally well on UNIX and Win32. Development was rapid, with the base functionality taking only a week of Jon's spare time. Updates are simple, and the program is easy to extend and maintain. Programming knowledge and creativity can go a long way, especially with tools as powerful as Perl.

The entire program is now available on Jon's Web site at: https://www.icogitate.com/~perl/sue/.

Dan Brian is a software engineer at Verio, Inc. He likes cake.

Jon Bjornstad is a certified Perl hacker, an amateur pianist, and tries to cultivate a quiet and open mind.

---