Programming Republic of Perl Logo

Uitleg deel 3: Graphics

OK, nu de eigenlijke graphics zoals ze door de schildpad zullen worden getekend. Ook hier weer eerst het aanmaken van een subwindow, dit keer van type 'Canvas' (schildersdoek):

my ($xsize, $ysize) = (640, 440);       # +/- 200 plus borders

# create canvas for drawings
$canvas = $top->Canvas(-width => $xsize, -height => $ysize, -border => 1);
$canvas->configure(-relief => 'ridge', -background => 'white');
$canvas->pack();

Wat variabelen en hulproutines en zo die later het werk wat makkelijker maken: 'dsin' en 'dcos' werken in graden in plaats van radialen, wat wat makkelijker denkt. 'xt' en 'yt' vertalen de coördinaten gezien vanuit de schildpad (0,0 in het midden, positief is naar boven/rechts) naar de schermcoördinaten (0,0 in linkerbovenhoek).

use constant PI => 3.14159265358979323;

my $color = "red"; # initial drawing color is red
my $width = 1; # initial line width is 1
my $dir = 0; # initial direction upwards on screen

sub degrees { return $_[0] * PI / 180; }
sub dsin { return sin($_[0] * PI / 180); }
sub dcos { return cos($_[0] * PI / 180); }

sub xt { return $_[0] + $xsize/2; }
sub yt { return $ysize/2 - $_[0]; }

De turtleHet wissen van de schildpad op de oude positie en het opnieuw tekenen op de nieuwe positie is beschreven in de routine 'turtle'. Merk op dat een canvas geen bitmap is, maar een vector-gebaseerd object, we hoeven dus niet bang te zijn voor witte gaten als we de oude schildpad wissen, alle gedeeltelijk gewiste objecten worden automatisch weer netjes volledig getekend. Wissen gaat dus ook niet door er met witte verf overheen te schilderen, maar door het object te verwijderen (indien aanwezig). De schildpad bestaat uit twee lijnen en twee rondjes (met verschil in lijnkleur en vulkleur), waarbij helaas wat lastige formules gebruikt worden om de schildpad in de goede richting te laten kijken.......

Omdat het maken van sommige tekeningen heel lang kunnen duren (denk aan een boom van Pythagoras met diepte 20), check ik ook nog of de gebruiker op 'Stop' heeft gedrukt (zie de knoppenbalk-definitie: de variabele $stop wordt dan gezet), en genereer dan een foutmelding die netjes wordt opgevangen in de eerder besproken 'execline' routine.....

# redraw turtle at current pos
sub turtle
{
$canvas->delete($t1) if defined $t1;
$canvas->delete($t2) if defined $t2;
$canvas->delete($t3) if defined $t3;
$canvas->delete($t4) if defined $t4;

$t1 = $canvas->createLine( xt($xpos+15*dcos($dir+45)), yt($ypos+15*dsin($dir+45)),
xt($xpos-15*dcos($dir+45)), yt($ypos-15*dsin($dir+45)), -fill => "dark green",
-width => 2);
$t2 = $canvas->createLine( xt($xpos+15*dcos($dir-45)), yt($ypos+15*dsin($dir-45)),
xt($xpos-15*dcos($dir-45)), yt($ypos-15*dsin($dir-45)), -fill => "dark green",
-width => 2);
$t3 = $canvas->createOval( xt($xpos+10), yt($ypos+10), xt($xpos-10), yt($ypos-10),
-fill => "green", -outline => "dark green", -width => 2);
$t4 = $canvas->createOval( xt($xpos+12*dcos($dir)+4), yt($ypos+12*dsin($dir)+4),
xt($xpos+12*dcos($dir)-4), yt($ypos+12*dsin($dir)-4),
-fill => "green", -outline => "dark green", -width => 2);

if ($stop) { $warn = ""; die "Stop" } # halted by user
return "";
}

Hoe laten we de schildpad nu een lijn tekenen? De gebruikersopdracht hiervoor is 'vooruit', intern vertaald naar 'forward'. 'forward' doet dit niet in een keer (dan zou de schildpad ineens ver springen, schildpadden zijn niet zo snel) maar breekt de lijn in kleine stukjes van lengte 10 om het gevoel van beweging te geven. De kleine stukjes worden door 'doforward' getekend op het canvas door de aanroep van 'createLine'. Wordt er geen afstand meegegeven aan forward dan neemt deze hiervoor de waarde 20 aan (als er geen argument wordt gegeven is het eerste argument $_[0] niet gedefinieerd).

sub forward     # actual forward routine: break in steps
{ # to give impression of speed
my $dist = $_[0] || 20;
my $steps = 1 + int(abs($dist) / 10);
foreach (1..$steps) { doforward $dist/$steps; }
}
sub doforward     # go forward for x (default 20) steps
{
my $step = $_[0] || 20;
my $xnew = $xpos + dcos($dir) * $step;
my $ynew = $ypos + dsin($dir) * $step;
$canvas->createLine( xt($xpos), yt($ypos), xt($xnew), yt($ynew),
-fill => $color, -width => $width);
$xpos = $xnew;
$ypos = $ynew;
turtle();
$top->update;
}

De andere routines zijn dan eigenlijk erg simpel:

sub jump        # go forward  without drawing for x (default 20) steps
{
my $step = $_[0] || 20;
$xpos = $xpos + dcos($dir) * $step;
$ypos = $ypos + dsin($dir) * $step;
turtle();
}

sub left { $dir += $_[0] || 90; turtle(); } # turn left (degrees)
sub right { left -($_[0] || 90); }
sub erase { $canvas->delete('all'); home(); }
sub home { ($xpos, $ypos, $dir) = (0, 0, 90); turtle(); } # reset at home

sub green { $color = 'green'; }
sub blue { $color = 'blue'; }
sub red { $color = 'red'; }
sub yellow { $color = 'yellow'; }
sub white { $color = 'white'; }
sub black { $color = 'black'; }
sub gray { $color = 'gray'; };

Dat is alles. Hopelijk geeft dit een aardig idee hoe Tk programma's eenvoudig een user-interface kunnen maken bovenop Perl, met gebruik van items als knoppen, tekstwindows en canvas. Hierop voortbouwend is het eenvoudig zelf verder te experimenteren met de in Tk aanwezige elementen. Veel plezier er mee.