Uitleg deel 2: Programmatekst

Verder met de volgende stap: het tekstwindow om turtle-programma's te kunnen schrijven. Ten eerste moeten we dit window vorm geven: we maken een window met type scrollende tekst, afbrekend op woordgrenzen, en zoveel mogelijk ruimte binnen het top-level window vullend. Tevens zorgen we dat dit window de aandacht krijgt, zodat tekst die getypt wordt hier automatisch in komt.

$text = $top->Scrolled('Text',
                -wrap => "word",
                -scrollbars => "se",
                -width => 40, -height => 8);
$text->pack(-expand => 1, -fill => 'both');
$text->focus();

Nu de acties om iets met het programma in dit window te doen; tevens de acties die aan de knoppen hangen. Eerst de simpelste: het creëren van een nieuw (leeg) programma. We gooien het tekstwindow leeg ($text->delete()), en wissen de laatstgebruikte filenaam (die bij een eerdere laad- of save-actie ingevuld kan zijn).

my $filename = "Untitled";              # current file name

sub newprog {                           # erase program
    $text->delete('1.0', 'end');
    $filename = "Untitled";
    $top->title("$title $filename");
}

Het laden van een bestaand programma bevat iets meer code. Ik maak gebruik van de ingebouwde 'getOpenFile' functie om de gebruiker een file te laten kiezen. Deze functie heeft wat extra informatie nodig, als file types en een default filenaam (zonder pad!), zie onderstaand fragment. De standaard file-extensie die ik voor turtle-programma's heb gekozen is '.tl'. Na aanroep check ik op de file bestaat (-f operator) en zo niet verschijnt er een foutmelding met behulp van fail_dialog (zie complete listing in zip file, bij de help-tekst dialog).

Ik wis nu eerst de oude inhoud van het tekstwindow, en lees dan de nieuwe file regel voor regel in. En uiteindelijk werk ik de titel van het window bij, om de huidige filenaam weer te geven.

sub loadprog {                          # read file into input pane
    my $line;
    my $filetypes = [ ['Turtle files', ['.tl']], ['All files', ['*']]];

    $filename =~ s/.*[\/\\]//;          # strip path
    $filename = $top->getOpenFile(-title => "Select file to open",
                    -initialfile => $filename, -filetypes => $filetypes,
                    -defaultextension => ".tl");
    return $fail_dialog->Show() if ! -f $filename;

    $text->delete('1.0', 'end');        # first delete old contents
    if (open(FILE, $filename) || die "Can't open $filename")
    {   while($line = <FILE>)           # next read file line by line
        {   $text->insert('end', $line);
        }    
        close(FILE);
    }
    $top->title("$title $filename");
}

Saven is nog haast eenvoudiger: weer de gebruiker vragen naar een file, en vervolgens de inhoud van het tekstscherm er in een keer in wegschrijven:

sub saveprog {                          # save input pane to file
    my $result;
    my $filetypes = [ ['Turtle files', ['.tl']]];
    
    $filename =~ s/.*[\/\\]//;          # strip path
    $filename = $top->getSaveFile(-title => "Select file to save to",
                    -initialfile => $filename, -filetypes => $filetypes,
                    -defaultextension => ".tl");
    return $fail_dialog->Show() if !$filename;

    $result = $text->get('1.0', 'end');
    if(open(OUTPUT, ">$filename") || die "Can't open >$filename")
    {   print OUTPUT $result;           # save results to file in one go
        close(OUTPUT);
    }
    $top->title("$title $filename");
}

Het meeste werk is het uitvoeren van een programma. Om te beginnen een vertaaltabel Nederlands naar Engels met de basiscommando's.

my %translation = (
    "voor"      => "foreach",   "vooruit"   => "forward",
    "als"       => "if",        "anders"    => "else",
    "links"     => "left",      "rechts"    => "right",
    "huis"      => "home",      "wis"       => "erase",
    "green"     => "groen",     "blauw"     => "blue",
    "rood"      => "red",       "geel"      => "yellow",
    "wit"       => "white",     "zwart"     => "black",
    "grijs"     => "gray",      "spring"    => "jump");

De routine 'execline' doet het vertaalwerk en de uitvoering. De geselecteerde tekst in het tekstwindow wordt opgevraagd (of alle tekst, in het geval niets geselecteerd was). Vervolgens wordt de 'vertaling' uitgevoerd: voor alle woorden in de tabel wordt dat woord voor alle gevallen vervangen (mits het zelfstandig voorkomend). Tevens wordt het vraagteken vervangen door 'print', en de argumenten van functies omgezet naar de minder leesbare Perl syntax ('arg3' wordt bijvoorbeeld '$_[3]').

Dan hebben we nu het turtle-programma omgezet naar een hopelijk geldig Perl programma, dat we nu met behulp van 'eval' uitvoeren. Er kan echter van alles zijn misgegaan, en dan willen we een nette foutmelding geven (hoewel ik niet zo ver ga dat ik de melding naar het nederlands vertaal). Nu kan er op twee manieren een melding komen:

• Perl snapt het programma maar er gaat iets fout bij het uitvoeren hiervan (bijvoorbeeld als bij deling door 0). Dit wordt door 'eval' afgevangen, Perl laat dan de foutmelding achter in $@
• Er zit een syntaxfout in het programma, Perl stopt met vertalen en roept de interne foutafhandeling aan. In dat laatste geval vangen wij dat af door de Perl errorhandler af te vangen (zie onderaan, via $SIG{__WARN__} = ....) waarbij we de waarschuwing in $warn zetten.

Door het testen van $@ en @warn zien we dus of er iets is foutgegaan, en laten een window verschijnen met de foutmelding. Ik negeer echter de foutmelding dat een routine al eerder gedefinieerd was (op deze manier kunnen routines meerdere malen gedefinieerd worden, net zo lang totdat we hem goed hebben) of als de gebruiker op 'Stop' had gedrukt. Ging alles goed, dan druk ik het resultaat af op de standaard output (die normaal echter niet in beeld is, maar in Windows kan je kijken op het DOS-scherm dat geminimaliseerd op de Windows balk aanwezig is).

sub execline {
    $top->Busy;              # change cursor in 'busy'
    my $tags = $text->tagNextrange('sel', '1.0', 'end');
    $_ = $text->get('sel.first', 'sel.last') if defined $tags;
    $_ = $text->get('1.0', 'end') if !defined $tags;   # all if none selected

    foreach $word (keys %translation) { s/\b$word\b/$translation{$word}/g;  }
    s/\?/ print /g;
    s/\$arg(\d)\b/\$_[$1]/g;

    $stop = 0;
    $warn = "";              # used to trap warning messages
    @result = eval;          # evaluate entered expression

    if (!$stop && ($@ || $warn) && !($warn =~ "Subroutine .* redefined at"))
    {   $err = $@;
        print "Warning = $warn\nError = $err";
        $syntax_dialog->configure(-text => "$warn$err");
        $syntax_dialog->Show();
    }
    else
    {
        print "\neval returned: " if !/^\s*print/;
        print @result if !/^print/;     # only print if statement didn't
    }
    $top->Unbusy;            # cursor back to normal arrow
}   

$SIG{__WARN__} = sub { $warn = $_[0]; };   # trap early warnings

Dat zijn de functies nodig voor het afhandelen van het tekst-gedeelte. Blijft er nog een deel over: de bewegingen van de schildpad. Ga hiervoor door naar deel drie.