#!perl

use strict;
use warnings;
use Tk;
use constant SIN => sin(3.14159265/18);
use constant COS => cos(3.14159265/18);

my $color   = 'darkolivegreen';
my $score   = 0;
my @delay   = (30, 20, 15, 10, 5);
my @steps   = (7, 10, 15, 15, 20);

my $topText = "Keep your eye on the indicated box.\nPress Start to pla
+y.";
my $selFlag = 0;

my $mw = new MainWindow;
$mw->Label(-textvariable => \$topText,
       -font         => ['Times 14'],
       -height       => 2,
      )->pack(qw/-fill x/);

my $c  = $mw->Canvas(-bg     => '#CFCFCF',
             -width  => 500,
             -height => 400,
             )->pack;

my $id1 = $c->createRectangle(90, 190,
                  110, 210,
                  -fill    => $color,
                  -outline => $color,
                  );

my $id2 = $c->createRectangle(240, 190,
                  260, 210,
                  -fill    => $color,
                  -outline => $color,
                  );

my $id3 = $c->createRectangle(390, 190,
                  410, 210,
                  -fill    => $color,
                  -outline => $color,
                  );

my $chosen = ($id1, $id2, $id3)[rand 3];
my $arrow;
showArrow($chosen);

$c->bind($_, '<1>', [\&selectBox, $_]) for $id1, $id2, $id3;

my $msg = $c->createText(250, 300,
             -text    => '',
             -font    => ['Times 22 bold'],
             -justify => 'center',
             -fill    => 'red',
             -state   => 'hidden');

my $f = $mw->Frame->pack(qw/-fill x/);
$f->Label(-text         => 'Score: ')->pack(qw/-side left/);
$f->Label(-textvariable => \$score  )->pack(qw/-side left/);

my $b;
$b = $f->Button(-text    => 'Start',
        -bd      => 1,
        -height  => 2,
        -padx    => 10,
        -command => sub {
          $c->itemconfigure($_, -state => 'hidden') for $arrow, $msg;
          $b->configure(-state => 'disabled',
                -text  => 'Wait');

          for (1 .. $steps[$score]) {
            my @ids = ($id1, $id2, $id3);
            rotate(@ids, $delay[$score]);
          }
          $topText = "Click on the correct box.";
          $selFlag = 1;
          $b->configure(-state => 'normal',
                -text  => 'Start');
        })->pack(qw/-side right/);

MainLoop;

sub rotate {
  my ($id1, $id2, $id3, $delay) = @_;

  my @order;
  {
    my @l = ($id1, $id2, $id3);
    push @order => splice @l, int(rand @l), 1 while @l;
  }

  my @c = map [$c->coords($_)] => @order;

  my (@midx, @midy);
  for my $i (0 .. 2) {
    $midx[$i] = 0.5 * ($c[$i][2] + $c[$i][0]);
    $midy[$i] = 0.5 * ($c[$i][3] + $c[$i][1]);
  }

  my @offx;
  $offx[$_] = 0.5 * ($midx[$_] + $midx[($_+1)%3]) for 0 .. 2;
  my @offy = @midy;

  $midx[$_] -= $offx[$_] for 0 .. 2;
  $midy[$_] = 0 for 0 .. 2;

  my @dir = map {rand > .5 ? 1 : -1} 0 .. 2;  # direction

  for (1 .. 18) {
    my (@newx, @newy);
    for my $i (0 .. 2) {
      $newx[$i] = $midx[$i] * COS - $dir[$i] * $midy[$i] * SIN;
      $newy[$i] = $midy[$i] * COS + $dir[$i] * $midx[$i] * SIN;
    }

    @midx = @newx;
    @midy = @newy;

    for my $i (0 .. 2) {
      $c->coords($order[$i],
         $midx[$i] - 10 + $offx[$i], $midy[$i] - 10 + $offy[$i],
         $midx[$i] + 10 + $offx[$i], $midy[$i] + 10 + $offy[$i]);
    }

    $c->update;

    $c->after($delay);
  }
}

sub showArrow {
  my $id = shift;

  unless (defined $arrow) {
    $arrow = $c->createLine(0, 0, 0, 0,
                -fill  => 'red',
                -arrow => 'last',
               );
  }

  my @c = $c->coords($id);

  my $x = 0.5 * ($c[2] + $c[0]);
  my $y = $c[1];

  $c->coords($arrow => $x, $y - 20,
         $x, $y - 5);

  $c->itemconfigure($arrow, -state => 'normal');
}

sub selectBox {
  return unless $selFlag;

  my $id = pop;

  if ($id == $chosen) {
    $score++;
    $c->itemconfigure($msg, -text => "That's Correct!\nScore: $score."
+);
  } else {
    $c->itemconfigure($msg, -text => "Wrong Answer!\nTry again.");
  }

  $c->itemconfigure($msg, -state => 'normal');
  showArrow($chosen);

  if ($score == 5) {
    $score = 0;
    $topText = "Reached maximum score!\nResetting score to 0.";
  } else {
    $topText = "Keep your eye on the indicated box.\nPress Start to pl
+ay.";
  }
  $selFlag = 0;
}
[download]