#!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 $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/);

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

         for (1 .. 10) {
           my @ids = ($id1, $id2, $id3);
           my @s;
           push @s => splice @ids, int(rand @ids), 1 for 1 .. 2;
           rotate(@s, $delay[$score]);
         }
         $topText = "Click on the correct box.";
         $selFlag = 1;
       })->pack(qw/-side right/);

MainLoop;

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

  my @c1 = $c->coords($id1);
  my @c2 = $c->coords($id2);

  my $mid1x = 0.5 * ($c1[2] + $c1[0]);
  my $mid1y = 0.5 * ($c1[3] + $c1[1]);
  my $mid2x = 0.5 * ($c2[2] + $c2[0]);
  my $mid2y = 0.5 * ($c2[3] + $c2[1]);

  #my $offx  = $mid1x > $mid2x ? $mid1x - $mid2x : $mid2x - $mid1x;
  #my $offy  = $mid1y > $mid2y ? $mid1y - $mid2y : $mid2y - $mid1y;
  my $offx = 0.5 * ($mid1x + $mid2x);
  my $offy = $mid1y;

  $_ -= $offx for $mid1x, $mid2x;
  $_ -= $offy for $mid1y, $mid2y;

  my $dir = rand > .5 ? 1 : -1;  # direction

  for (1 .. 18) {
    my $new1x = $mid1x * COS - $mid1y * $dir * SIN;
    my $new1y = $mid1y * COS + $mid1x * $dir * SIN;
    my $new2x = $mid2x * COS - $mid2y * $dir * SIN;
    my $new2y = $mid2y * COS + $mid2x * $dir * SIN;

    $mid1x = $new1x;
    $mid1y = $new1y;
    $mid2x = $new2x;
    $mid2y = $new2y;

    $c->coords($id1,
           $mid1x - 10 + $offx, $mid1y - 10 + $offy,
           $mid1x + 10 + $offx, $mid1y + 10 + $offy);
    $c->coords($id2,
           $mid2x - 10 + $offx, $mid2y - 10 + $offy,
           $mid2x + 10 + $offx, $mid2y + 10 + $offy);
    $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]