#!/pro/bin/perl

# Nintendo DS BrainTrainer LaagHoog test

use strict;
use warnings;

use Tk;
use Tk::Scale;
use Time::HiRes qw( usleep time );
use List::Util qw( shuffle max min );

my $use_uni = 0;

my %fonts = (
    button	=> "{Liberation Mono} 12",
    games	=> "{Liberation Sans} 12 bold",
    digits	=> "{Times}           34 bold",
    input	=> "{Times}           72 bold",
    calc	=> "{Liberation Sans} 14 bold",
    score	=> "{Times}           18 bold",
    info	=> "{Liberation Sans} 24 bold",
    countdown	=> "{Helvetica}       72 bold",
    wrong	=> "{Liberation Sans} 48 bold",
    correct	=> "{Liberation Sans} 96 bold",
    );

my %delay = (
    easy => 600_000,
    dflt => 140_000,
    hard =>  60_000,
    );
my $delay    = $delay{dflt};
my $moeilijk = 0;
my $dist     = 60;
my @place    = map { [ $_ / 4, $_ % 4 ] } 0 .. 15;
my %square   = (
    4 => [  5,  6,  9, 10 ],
    5 => [  5,  7, 10, 13, 15 ],
    6 => [  7, 10, 11, 13, 14, 15 ],
    7 => [  6,  7,  9, 10, 11, 13, 14 ],
    8 => [  4,  5,  6,  7,  8,  9, 10, 11 ],
    9 => [  5,  6,  7,  9, 10, 11, 13, 14, 15 ],
   10 => [  1,  2,  4,  5,  6,  7,  8,  9, 10, 11 ],
   );

binmode STDERR, ":utf8";

sub p
{
    my $p = shift;
    my %fill = qw( x x y y b both );
    my %side = map {( substr ($_, 0, 1), $_ )} qw( top bottom left right ) ;
    (   (-expand => $p =~ m/^e../         ? 1         :      0 ) ,
	(-fill   => $p =~ m/^.([xyb])./   ? $fill{$1} : "none" ) ,
	(-side   => $p =~ m/^..([lrtbc])/ ? $side{$1} :     "" ) ,
	);
    } # p

my $mw = MainWindow->new (); $mw->geometry ("+400+150");

my @co = qw( -background white
	     -height 400 -width 300
	     -relief ridge
	     -borderwidth 8
	     );
$mw->Scale (
    -borderwidth  =>       1,
    -length       =>     400,
    -width        =>      15,
    -variable     => \$delay,
    -sliderlength =>      20,
    -troughcolor  => "Black",
    -showvalue    =>       0,
    -from         =>       0,
    -to           => 1000000,
    -resolution   =>   50000,
#   -command      => sub { print "$delay\n" },
    )->pack (p("ebl"));

my $df = $mw->Frame->pack (p("ebt"));
my $cl = $df->Canvas (@co)->pack (p("ebl")); # Left  screen
my $cr = $df->Canvas (@co)->pack (p("ebl")); # Right screen

sub countdown
{
    for ("\x{2462}", "\x{2461}", "\x{2460}") {
	$cr->createText (150, 150, -anchor => "c", -tag => "c",
	    -text => $_, -font => $fonts{countdown});
	$mw->update;
	sleep (1);
	$cr->delete ("c");
	}
    $mw->update;
    } # countdown

sub tick_ok
{
    my ($w, $x, $y) = @_;

    if ($use_uni) {	# Use Unicode text
	$w->createText ($x, $y - 50, -text => "\x{2714}",	# v OK
	    -fill => "#00a040", -anchor => "c", -tag => "t",
	    -font => $fonts{correct});
	}
    else {		# Use Polygon
	my @p = ( 0, 0, 8, -10, 30, -35, 40, -40, 53, -40, 50, -35, 7, 20,
		 -3, 24, -13, 20, -18, -3, -10, -10, -3, -8, 0, 0);
	for (my $i = 0; $i < $#p; ) { $p[$i++] += $x, $p[$i++] += $y; }
	$w->createPolygon (@p, -tag => "t",
	    -fill      => "#00a000", -outline => "#a0ffa0",
	    -joinstyle => "round",   -smooth  => 1);
	}
    } # tick_ok

sub tick_wrong
{
    my ($w, $x, $y) = @_;
    $w->createText ($x, $y, -text => "\x{2718}",	# x Wrong
	-fill => "#a00000", -anchor => "c", -tag => "t",
	-font => $fonts{wrong});
    } # tick_wrong

# Bind the numeric keys (only once) to allow numeric input
my $input_cnt = 0;
my $input_num = 0;
{
#    $mw->bind ("<KeyPress>" => sub {
#	my $widget = shift;
#	my $e = $widget->XEvent;
#	my ($kname, $knum) = ($e->K, $e->N);
#	print STDERR "IM: key: $kname, $knum\n";
#	});
    for ([ 0, "<Key-0>", "<KP_Insert>"	],
	 [ 1, "<Key-1>", "<KP_End>"	],
	 [ 2, "<Key-2>", "<KP_Down>"	],
	 [ 3, "<Key-3>", "<KP_Next>"	],
	 [ 4, "<Key-4>", "<KP_Left>"	],
	 [ 5, "<Key-5>", "<KP_Begin>"	],
	 [ 6, "<Key-6>", "<KP_Right>"	],
	 [ 7, "<Key-7>", "<KP_Home>"	],
	 [ 8, "<Key-8>", "<KP_Up>"	],
	 [ 9, "<Key-9>", "<KP_Prior>"	],

         [ "+",        "<plus>",			"<KP_Add>"	],
	 [ "\x{2212}", "<minus>",			"<KP_Subtract>"	],
	 [ "\x{00d7}", "<Key-x>",	"<asterisk>",	"<KP_Multiply>"	],
	 [ "\x{00f7}", "<slash>",			"<KP_Divide>"	],
	 ) {
	my ($dig, @keys) = @$_;
	foreach my $key (@keys) {
	    $^O eq "MSWin32" && $key =~ m/^<KP_/ and next;
	    $mw->bind ($key => sub {
		if ($dig =~ m/^[0-9]/) {
		    $input_num = 10 * $input_num + $dig;
		    $input_cnt++;
		    }
		else {
		    $input_num = $dig;
		    $input_cnt = 1;
		    }
		$cr->delete ("input");
		$cr->createText (150, 150, -anchor => "c", -tag => "input",
		    -text => $input_num, -font => $fonts{input});
		$mw->update;
		});
	    }
	}

    foreach my $key ("<BackSpace>", "<Delete>") {
	$mw->bind ($key => sub {
	    if ($input_num =~ m/^[0-9]/) {
		$input_num = int ($input_num / 10);
		}
	    else {
		$input_num = "";
		}
	    $input_cnt and $input_cnt--;
	    $cr->delete ("input");
	    $cr->createText (150, 180, -anchor => "c", -tag => "input",
		-text => $input_num || "", -font => $fonts{input});
	    $mw->update;
	    });
	}
    }

my %stats;
{   # Laag Hoog

    use integer;

    sub blocks
    {
	my ($w, $n) = @_;

	for (@{$square{$n}}) {
	    my ($x, $y) = @{$place[$_]};
	    my ($W, $X, $Y) = ($dist / 3, map { ($_ + 1) * $dist } $y, $x);
	    $w->createRectangle ($X, $Y, $X + $W, $Y + $W,
		-tag => "n", -outline => "Gray60");
	    }
	$mw->update;
	} # blocks

    my @qbind;
    foreach my $i (0 .. 20) {
	$cr->bind ("q$i", "<Button-1>" => sub { $qbind[$i]->(); });
	}

    sub laaghoog
    {
	my $n = shift;

	my $m = $n - 1;
	my @set = (shuffle 1 .. 10)[0 .. $m];
	blocks ($cl, $n);
	countdown ();
	usleep (80000);
	foreach my $i ( 0 .. $m ) {
	    my ($x, $y) = @{$place[$square{$n}[$i]]};
    #	printf "%2d %2d [ %3d %3d ] %2d\n", $n, $i, $x, $y, $set[$i];
	    my ($W, $X, $Y) = ($dist / 6, map { ($_ + 1) * $dist } $y, $x);
	    $cl->createText ($X + $W, $Y + $W, -anchor => "c", -tag => "t",
		-text => $set[$i], -font => $fonts{digits});
	    }
	$cl->delete ("n");
	$mw->update;
	usleep ($n * $delay);
	$cl->delete ("t");
	blocks ($cl, $n);
	$mw->update;

	my @ans = sort { $a <=> $b } @set;
	my @q;
	my $g = 0;
	foreach my $i ( 0 .. $m ) {
	    my ($tag, $x, $y) = ("q$i", @{$place[$square{$n}[$i]]});
	    my ($W, $X, $Y) = ($dist / 3, map { ($_ + 1) * $dist } $y, $x);
	    $cr->createRectangle ($X, $Y, $X + $W, $Y + $W,
		-outline => "Gray60", -fill => "White", -tags => [ "n", $tag ]);
	    $qbind[$i] = sub {
		#print STDERR $g, " PRESS ", $i, " - ", $set[$i], "\n";
		my $err = 0;
		if ($set[$i] == $ans[$g]) {
		    $stats{Q}++;
		    my ($x, $y) = @{$place[$square{$n}[$i]]};
		    my ($W, $X, $Y) = ($dist / 6, map { ($_ + 1) * $dist } $y, $x);
		    $cr->createText ($X + $W, $Y + $W, -anchor => "c", -tag => "t",
			-text => $set[$i], -font => $fonts{digits});
		    $cr->delete ("q$i");
		    $mw->update;
		    }
		else {
		    $stats{F}++;
		    $cr->createText (150, 350,
			-text => "FOUT", -fill => "Red", -anchor => "c", -tag => "t",
			-font => $fonts{info});
		    $cl->delete ("n");
		    foreach my $I ( 0 .. $m ) {
			my ($x, $y) = @{$place[$square{$n}[$I]]};
			my ($W, $X, $Y) = ($dist / 6, map { ($_ + 1) * $dist } $y, $x);
			$cl->createText ($X + $W, $Y + $W, -anchor => "c", -tag => "t",
			    -text => $set[$I], -font => $fonts{digits});
			$i == $I or next;
			tick_wrong ($cr, $X + $W, $Y + $W);
			$cr->delete ("q$I");
			}
		    $err++;
		    $mw->update;
		    sleep 2;
		    }
		if ($err or ++$g >= $n) {
		    unless ($err) {
			$stats{N}++;
			tick_ok ($cr, 150, 150);
			$mw->update;
			usleep (500000);
			}
		    $cl->delete ("n");
		    $cr->delete ("n");
		    $cl->delete ("t");
		    $cr->delete ("t");
		    $mw->update;
		    if (++$stats{D} < 10) {
			my $next =
			    $err == 0 ||
			    $stats{F} == 0 ? $n + 1 :
			    $stats{F} == 1 ? $n < 7 ? $n + 1 : $n - 1 :
			    $stats{F} == 2 ? $n < 7 ? $n - 1 : $n - 2 :
					     $n - int rand $stats{D};
			    ;
			$next <  4 and $next =  4;
			$next > 10 and $next = 10;
			laaghoog ($next);
			}
		    else {
			# Done
			$stats{Q} -= $stats{N}; # You cannot have the last square wrong!
			$cr->createText (150, 250, -text => "$stats{N} goed",
			    -anchor => "c", -tag => "t", -font => $fonts{info});
			$cr->createText (150, 350, -text => "Score: $stats{Q}",
			    -anchor => "c", -tag => "t", -font => $fonts{score});
			}
		    }
		};
	    }
	} # laaghoog

    sub start_laaghoog
    {
	%stats = (
	    D => 0,	# Number of excersices done
	    N => 0,	# Number of exercises correct
	    F => 0,	# Number of mistakes
	    Q => 0,	# Number of squares correct
	    );
	laaghoog (4);
	} # start_laaghoog

    } # Laag Hoog

{   # Rekenen x 20 & rekenen x 100

    my (@r, $now, $err);

    sub getxy
    {
	my ($i, $j, $o, $R, $x, $y, $dubious) = @_;
	do {
	    $dubious = 0;
	    do {
		$x = int rand $i;
		do {
		    $y = int rand ($o == 1 ? $j * $x : $i);
		    } while ($o == 3 and $y == 0);
		} while ($x + $y == 0);
	    if ($R) {
		# Rule out combinations that can have more than one solution
		# 4 ? 0 = 4 : + -
		# 2 ? 2 = 4 : + x
		# 4 ? 2 = 2 : - /
		# 8 ? 1 = 8 : x /
		if    ($o == 0) {	# +
		    my $z = $x + $y;
		    if ($x - $y == $z or       $x * $y == $z) { $dubious++; }
		    }
		elsif ($o == 1) {	# -
		    my $z = $x - $y;
		    if ($x + $y == $z or $y && $x / $y == $z) { $dubious++; }
		    }
		elsif ($o == 2) {	# *
		    my $z = $x * $y;
		    if ($x + $y == $z or $y && $x / $y == $z) { $dubious++; }
		    }
		elsif ($o == 3 && $y) {	# /
		    my $z = $x / $y;
		    if ($x - $y == $z or       $x * $y == $z) { $dubious++; }
		    }
		}
	    } while ($dubious);
	($x, $y);
	} # getxy

    sub init_r
    {
	my ($N, $M, $R) = @_; # aantal, moeilijk, rekentekens
	@r = map {
	    my ($x, $o, $y);
	    $o = int rand $M;
	    if ($o == 0) {	# +
		($x, $y) = getxy (10, 10, $o, $R);
		[ $x, "+", $y, $x + $y ];
		}
	    elsif ($o == 1) {	# -
		($x, $y) = getxy (20, .8, $o, $R);
		[ $x, "\x{2212}", $y, $x - $y ];
		}
	    elsif ($o == 2) {	# *
		($x, $y) = getxy (10, 10, $o, $R);
		[ $x, "\x{00d7}", $y, $x * $y ];
		}
	    else {		# ÷
		($x, $y) = getxy (10, 10, $o, $R);
		[ $x * $y, "\x{00f7}", $x, $y ];
		}
	    } 1 .. $N;
	push @r, [ "", "", "", "" ];
	} # init_r

    sub pr_time
    {
	my $t = shift;
	$t < 60 and
	    return sprintf "%5.2f", $t;
	my $m = int ($t / 60);
	$t -= $m * 60;
	sprintf "%d:%02.2f", $m, $t;
	} # pr_time

    sub rekenen
    {
	my ($N, $M, $R) = @_;

	init_r ($N, $M, $R);

	my ($err, $now) = (0, time);

	my $ok = 1;
	for (0 .. ($N - 1)) {
	    my ($x, $o, $y, $a) = @{$r[$_]};
	    my ($prev_ex, $curr_ex, $next_ex);
	    if ($R) {
		$prev_ex = sprintf "%s %s %s = %s",       @{$r[$_ - 1]}[0..3];
		$next_ex = $r[$_+1][0] eq "" ? "" :
			   sprintf "%s \x{2b1a} %s = %s", @{$r[$_ + 1]}[0,2,3];
		$curr_ex = sprintf "%s \x{2b1a} %s = %s", $x, $y, $a;
		}
	    else {
		$prev_ex = sprintf "%s %s %s", @{$r[$_ - 1]}[0,1,2];
		$_ and $prev_ex .= " = $r[$_-1][3]";
		$next_ex = sprintf "%s %s %s", @{$r[$_ + 1]}[0,1,2];
		$curr_ex = sprintf "%d %s %d", $x, $o, $y;
		}

	    if ($_) {
		$cl->createText (20, 150, -anchor => "w", -tag => "c",
		    -text => $prev_ex, -font => $fonts{digits}, -fill => "Gray");
		$ok or
		$cl->createText (150, 150, -text => "   \x{2718}", # x Wrong
		    -fill => "#a00000", -anchor => "c", -tag => "c",
		    -font => $fonts{wrong});
		$ok = 1;
		}
	    $cl->createText (20, 250, -anchor => "w", -tag => "c",
		-text => $curr_ex, -font => $fonts{digits});
	    $cl->createText (20, 350, -anchor => "w", -tag => "c",
		-text => $next_ex, -font => $fonts{digits});
	    $mw->update;

	    $input_num = 0;
	    $input_cnt = 0;
	    while ($input_cnt == 0) {
		$cr->waitVariable (\$input_num);
		if ($R and $input_num !~ m{^[0-9]}) {
		    # print STDERR "$x $o $y $a $input_num\n";
		    $r[$_][1]  = $input_num;
		    $input_num = $input_num eq $o ? $a : 999;
		    last;
		    }
		unless ($input_num =~ m/^[0-9]/) {	# ignore non-numeric input
		    $input_num = 0;
		    $input_cnt = 0;
		    next;
		    }
		$a >= 10 && $input_num == int ($a / 10) and $cr->waitVariable (\$input_num);
		}
	    unless (($input_num || 0) == $a) {
		$R or $r[$_][3] = $input_num;
		$ok = 0;
		$err++;
		}
	    $cl->delete ("c");
	    $cr->delete ("input");
	    }

	my $d   = time - $now;

	my $s = $d + ($err * 5);
	my $info = sprintf "%s sec\n%s straftijd\n(%d fout x 5 sec)",
	    pr_time ($d), pr_time ($err * 5), $err;
	my $score = "Score: " . pr_time ($s);
	$cr->createText (50, 200, -anchor => "w", -tag => "c",
	    -text => $info , -font => $fonts{calc});
	$cr->createText (50, 350, -anchor => "w", -tag => "c",
	    -text => $score, -font => $fonts{score});
	} # rekenen

    sub start_rekenenx20
    {
	rekenen ( 20, 3, 0);
	} # start_rekenenx20

    sub start_rekenenx100
    {
	rekenen (100, 3 + $moeilijk, 0);
	} # start_rekenenx100

    sub start_rekentekens
    {
	rekenen ( 20, 4, 1);
	} # start_rekentekens
    }

{   # Huisbezoek

    my @person = (
	# Head
	10,  8,   8,  6,   8,  2,  10,  0,  13,  0,  15,  2,  15,  6,  13,  8,
	# Right arm
	20,  8,  23, 11,  23, 22,  22, 23,  20, 23,  18, 21,  18, 12,  17, 11,
	# Right torso and leg
	17, 22,  19, 24,  19, 35,  17, 37,  14, 37,  12, 35,  12, 24,
	# Left leg and torso
	11, 24,  11, 35,   9, 37,   6, 37,   4, 35,   4, 24,   6, 22,   6, 11,
	# Left arm
	 5, 12,   5, 21,   3, 23,   1, 23,   0, 22,   0, 11,   3,  8,
	);

    my %house = (
	house	=> [ 0,   0, 50, 50, 50, 100, -50, 100, -50, 50,		],
	roof	=> [ 0, -10, 55, 45, 50,  49,   0,  -1, -50, 49, -55, 45,	],
	chimney	=> [ 15,  4, 45, 34, 45,  -4,  15,  -4,				],
	top	=> [ 13, -4, 47, -4, 47, -10,  13, -10,				],
	window1	=> [  5, 55, 15, 55, 15,  65,   5,  65,				],
	window2	=> [ 16, 55, 26, 55, 26,  65,  16,  65,				],
	window3	=> [  5, 66, 15, 66, 15,  76,   5,  76,				],
	window4	=> [ 16, 66, 26, 66, 26,  76,  16,  76,				],
	);

    # Draw a person at (x, y) (top-left)
    sub put_person
    {
	my ($x, $y) = @_;
	my @p = @person;
	for (my $i = 0; $i < $#p; ) { $p[$i++] += $x, $p[$i++] += $y; }
	$cl->createPolygon (@p, -fill => "Black", -outline => "White", -tag => "hb_p");
	} # put_person

    sub put_house
    {
	my ($x, $y) = @_;
	foreach my $p (sort keys %house) {
	    my @p = @{$house{$p}};
	    for (my $i = 0; $i < $#p; ) { $p[$i++] += $x, $p[$i++] += $y; }
	    my @colors = ("Black", "White");
	    $p =~ m/^win/ and @colors = reverse @colors;
	    $cl->createPolygon (@p, -tag => "hb_h",
		-fill => $colors[0], -outline => $colors[1]);
	    }
	} # put_house

    sub show_people
    {
	my $N = shift;
	my @pos = (120, 300, 140, 300, 160, 300, 180, 300,
			130, 275, 150, 275, 170, 275,
			     140, 250, 160, 250,
				  150, 225);
	foreach my $n (reverse 0 .. ($N - 1)) {
	    put_person (@pos[2 * $n, 2 * $n + 1]);
	    }
	$cl->createText (150, 100, -text => $N, -anchor => "c", -tag => "t",
	    -font => $fonts{digits});
	$cl->update;
	} # show_people

    sub move_x_house
    {
	my ($N, $D) = @_;
	my @pos = $D ? (12 .. 30) : (-6 .. 10);
	# Move $N persons to in house position
	foreach my $cx (@pos) {
	    $cl->delete ("hb_p");
	    foreach my $n (0 .. ($N - 1)) {
		put_person ($n * 25 + 10 * $cx, 300);
		$cl->raise ("hb_h");
		}
	    $cl->update;
	    usleep ($delay / 2);
	    }
	} # move_x_house

    sub init_huisbezoek
    {
	my $N = shift;
	move_x_house ($N, 0);
	# Lower the house over the people
	foreach my $cy (0 .. 24) {
	    $cl->delete ("hb_h");
	    put_house (150, 10 * $cy); # Note, pos is top of roof!
	    $cl->update;
	    usleep (20_000);
	    }
	} # init_huisbezoek

    sub huisbezoek
    {
	my $N = 1 + int rand 4;
	init_huisbezoek ($N);

	for (0 .. 3) {
	    my $M;
	    my $out = $N == 0 ? 0 : $N == 9 ? 1 : int rand 2;
	    if ($out) {	# Move people out
		$M = min (4, 1 + int rand $N);
		move_x_house ($M, 1);
		$N -= $M;
		}
	    else {
		$M = min (4, 1 + int rand (9 - $N));
		move_x_house ($M, 0);
		$N += $M;
		}
	    $cl->delete ("hb_p");
	    $cl->update;
	    usleep (4 * $delay * $M);
	    }
	$cl->createText (150, 280, -text => "?", -anchor => "c", -tag => "t",
	    -fill => "Gray", -font => $fonts{digits});
	$cl->update;

	$input_num = 0;
	$input_cnt = 0;
	while ($input_cnt == 0) {
	    $cr->waitVariable (\$input_num);
	    unless ($input_num =~ m/^[0-9]/) {	# ignore non-numeric input
		$input_num = 0;
		$input_cnt = 0;
		next;
		}
	    }
	$cl->delete ("t");
	if (($input_num || 0) == $N) {
	    tick_ok ($cr, 150, 150);
	    }
	else {
	    $cr->createText (150, 150, -text => "\x{2718}",	# x Wrong
		-fill => "#a00000", -anchor => "c", -tag => "t",
		-font => $fonts{wrong});
	    }
	$cl->delete ("hb_h");
	show_people ($N);
	$mw->update;
	usleep (10 * $delay);
	$cl->delete ("hb_p");
	$cr->delete ("input");
	$cr->delete ("t");
	$cl->delete ("t");
	$mw->update;
	} # huisbezoek

    sub start_huisbezoek
    {
	huisbezoek () for 1 .. 5;
	} # start_huisbezoek
    }

my @games = (
    [ "Rekenen x 20",	\&start_rekenenx20	],
    [ "Rekenen x 100",	\&start_rekenenx100	],
    [ "Rekentekens",	\&start_rekentekens	],
    [ "Laag Hoog",	\&start_laaghoog	],
    [ "Huisbezoek",	\&start_huisbezoek	],
    );

my $gf;
foreach my $i (0 .. $#games) {
    $i % 4 == 0 and $gf = $mw->Frame->pack (p("ebt"));
    my ($title, $func) = @{$games[$i]};
    push @{$games[$i]}, $gf->Button (
	-text		=> " $title ",
	-command	=> sub {
	    $_->[2]->configure (-foreground => "Navy") for @games;
	    $games[$i][2]->configure (-foreground => "Maroon");
	    foreach my $tag ("c", "n", "t") {
		$_->delete ($tag) for $cl, $cr;
		}
	    $mw->update;
	    $func->();
	    },
	-font		=> $fonts{games},
	-foreground	=> "Navy",
	)->pack (p("ebl"));
    }

my $bf = $mw->Frame->pack (p("ebt"));
#$bf->Button (
#    -text	=> "E",
#    -command	=> sub { $delay = $delay{easy}; },
#    -font	=> $fonts{button},
#    -foreground	=> "#008000",
#    )->pack (p(".bl"));
#$bf->Button (
#    -text	=> "D",
#    -command	=> sub { $delay = $delay{dflt}; },
#    -font	=> $fonts{button},
#    -foreground	=> "#808000",
#    )->pack (p(".bl"));
#$bf->Button (
#    -text	=> "H",
#    -command	=> sub { $delay = $delay{hard}; },
#    -font	=> $fonts{button},
#    -foreground	=> "#FF8000",
#    )->pack (p(".bl"));
$bf->Button (
    -text	=> "Stoppen",
    -command	=> sub { exit ; },
    -font	=> $fonts{button},
    -foreground	=> "Navy",
    )->pack (p("ebl"));
$bf->Checkbutton (
    -text	=> "Moeilijk",
    -variable	=> \$moeilijk,
    -font	=> $fonts{button},
    -foreground	=> "#FF8000",
    )->pack (p(".bl"));


MainLoop;
