#!/usr/bin/perl -w

use strict;
use Tk;

########################################################
# Constants

  my $width  = 30;  # number of boxes wide
  my $height = 30;  # number of boxes high
  my $scale  = 15;  # size of boxes in pixels
  my $freq   = 50;  # update every 50 milliseconds

########################################################
# Variables

  my @board;
  my $dir;
  my $x;
  my $y;
  my $stop;

########################################################
# Set up board

my $m = MainWindow->new;
$m->repeat($freq => \&run);

my $c = $m->Canvas(-width => $width*$scale, -height => $height*$scale)
+;

&initBoard;

$m->MainLoop;  # <-- never exits

########################################################
# board utilities

sub loc {
  my ($x, $y) = @_;
  return ($x*$scale+1, $y*$scale+1, $x*$scale+$scale-1, $y*$scale+$sca
+le-1);
}

sub on {
  my ($x, $y) = @_;
  box($x,$y,"black");
  $board[$x][$y] = 1;
}

sub off {
  my ($x, $y) = @_;
  box($x,$y,"white");
  $board[$x][$y] = 0;
}

sub box {
  my ($x, $y, $color) = @_;
  $c->create('rectangle', loc($x,$y), -fill => $color);
}

sub initBoard {
  print "Initializing board...";
for my $i (0 .. $width) {
    for my $j (0 .. $height) {
      off($i, $j);
      print ".";
    }
    print "x";
  }
  $c->pack;
  print "...done\n";
}

########################################################
# main callback code

my $initFlag;

sub initVars {
  $dir = 0;
  $stop = 0;
  $initFlag++;
  $x = int($width/2);
  $y = int($height/2);
  $board[$x][$y]=1;
  on($x,$y);
  print "Initialized\n";
}

sub move {
  for ("$dir") {
    /0/ && do {
      if(($y-1)>=0) {
        $y--;
        &turn;
      }
      else {
        $stop = 1;
      }
      last;
    };
    /1/ && do {
      if(($x+1)<=$width) {
        $x++;
        &turn;
      }
      else {
        $stop = 1;
      }
      last;
    };
    /2/ && do {
      if(($y+1)<=$height) {
        $y++;
        &turn;
      }
      else {
        $stop = 1;
      }
      last;
    };
    /3/ && do {
      if(($x-1)>=0) {
        $x--;
        &turn;
      }
      else {
        $stop = 1;
      };
      last;
    }
  }
}

sub turn {
  if($board[$x][$y]==0) {
    $dir+=3;
    $dir%=4;
    on($x,$y);
  }
  else {
    $dir+=1;
    $dir%=4;
    off($x,$y);
  }
}

sub run {
  return if $stop;
  &initVars unless $initFlag;
  &move;
}
[download]