#!/usr/bin/perl
use strict;
use Tk;
use Data::Dumper;

my $mw = MainWindow->new(-title=>"Super Nibbles!");

my $score = 0;
my $step  = 0;
my $start = time;
my $speed = 120;
my $dead  = 1;

my $menu_bar    = $mw      ->Canvas()->pack(-side => 'top', -fill => '
+both');
my $score_board = $menu_bar->Label() ->pack(-side=>'right');
$menu_bar->Button(-text => 'Start', -command => sub {restart()} )->pac
+k(-side=>'left');

my $board = $mw->Canvas(-width => 600, -height => 400)->pack();
my $status      = $mw->Label(-text=> "Click 'Start' To Being" )->pack(
+-side=>'bottom');
$mw->bind("<Left>" , sub { set_direction(0) });
$mw->bind("<Right>", sub { set_direction(1) });
$mw->bind("<Up>"   , sub { set_direction(2) });
$mw->bind("<Down>" , sub { set_direction(3) });

# enable mouse control.
my ($skip, $pressed, $last_x,$last_y) = 0;
$mw->bind("<ButtonPress-1>",   sub { $pressed = 1;  });
$mw->bind("<ButtonRelease-1>", sub { $pressed = 0; });
$mw->bind("<Motion>" ,[sub {
                          my ($e,$x,$y) = (@_);
                          return unless $skip++ > 10;
                          if ( $pressed && abs($last_x - $x) > abs($la
+st_y - $y)) {
                             set_direction( $last_x > $x ? 0 : 1)
                          } elsif ($pressed) {
                             set_direction( $last_y > $y ? 2 : 3);
                          }
                          ($last_x, $last_y, $skip) = ($x,$y, 0);
                       }, Ev('x'), Ev('y')]);

my $timer = Tk::After->new($mw,$speed,'repeat',
                                 sub {
                                   return if $dead;
                                   move();
                                 });

$board->createGrid(0,0,10,10 );

my $moves = [ [-1, 0], [ 1, 0], [ 0,-1], [ 0, 1] ];
my $food  = [  ];
my $food_size = [1,1,1,1,1,3,3,5];
my $food_color = {
                 1 => 'green',
                 3 => 'yellow',
                 5 => 'purple' };
my $snake;
MainLoop;

sub restart {
  $board->delete('snake');
  $board->delete('food');
  $snake = {
            direction => (int rand 4),
            blocks    =>[ [30,20]],
            food      => 2, };
  status("Ready!");
  $score = 0;
  $speed = 150;
  $step  = 0;
  $food = [];
  place_food() for (1..5);
  show_food();
  Tk::After->new($mw,1000,'once', sub {
     status("Set");
     show_snake();
  });
  Tk::After->new($mw,2000,'once', sub {
      status("Go gobble up food!!!");
      $timer->time($speed);
      $dead  = 0;
      $start = time;
  });
}

sub set_direction {
    my $dir = shift;
    my $cur = $snake->{direction};
    
    # speed up in same direction
    move() && return if ($dir == $cur);

    # don't allow to reverse direction into self and die
    my $cur_move = $moves->[$cur];
    my $new_move = $moves->[$dir];
    unless ( ($cur_move->[0] + $new_move->[0]) == 0
         and ($cur_move->[1] + $new_move->[1]) == 0)
    {
      $snake->{new_direction} = $dir ;
    }
}


# colission detection
sub in_bounds {
    my ($x,$y) = @_;
    return 1 if ($x >= 0 and $x <= 59 and $y >= 0 and $y <= 39);
    return 0;
}

sub hit_food {
    my ($x,$y, $dont_consume) = @_;
    for my $block (@$food) {
        if ($x == $block->[0] and $y == $block->[1]) {
           my $hits = $block->[2];
           unless ($dont_consume) {
             $block = undef; #hit it, remove it.
             $food = [ grep { defined $_ } @$food ];
           }
           return $hits;
        }
    }
    return 0;
}

sub hit_snake {
    my ($x,$y) = @_;
    for my $block (@{$snake->{blocks}}) {
        if ($x == $block->[0] and $y == $block->[1]) {
           return 1;
        }
    }
    return 0;
}

# place food randomly
sub place_food {
    my $x = undef;
    my $y;
    while ( !defined   $x or
            !in_bounds($x,$y) or
             hit_food ($x,$y, 1)   or
             hit_snake($x, $y)
          )
    {
        $x = int(rand 60);
        $y = int(rand 40);
    }
    push @$food, [$x,$y, $food_size->[int(rand @$food_size)]];
}


# message update commands
sub status {
    my $message = shift;
    $status->configure(-text => $message);
}

sub change_speed {
   my $inc = shift;
   $speed += $inc;
   $speed = 1 if $speed < 1;
   $timer->time($speed);
}

sub update_score_board {
  $score_board->configure(-text => "Score: $score Time: " . (time - $s
+tart));
}

sub move {
    return if $dead;
    if (exists $snake->{new_direction}) {
        $snake->{direction} = $snake->{new_direction};
        delete $snake->{new_direction};
    }

    for my $block (@$food) {
        if ($block->[2] == 5) {
            next unless rand > .3;
            my $move    = $moves->[int rand 4];
            my $new_pos = [ $block->[0] + $move->[0], $block->[1] + $m
+ove->[1] ];
            if (in_bounds( @$new_pos ) && !hit_snake(@$new_pos) && !hi
+t_food(@$new_pos, 1)) {
               $block->[0] = $new_pos->[0];
               $block->[1] = $new_pos->[1];
               show_food();
            }
        }
    }

    my ($xc,$yc) = @{$moves->[ $snake->{direction} ] };
    my $last_pos = $snake->{blocks}->[0];
    my $new_pos  =[$last_pos->[0] + $xc, $last_pos->[1] + $yc];

    if (in_bounds( @$new_pos ) && !hit_snake(@$new_pos) ) {
       unshift  @{$snake->{blocks}}, $new_pos;
       my $hits = hit_food(@$new_pos);
       if ($hits) {
          place_food();
          show_food();
          $snake->{food} += $hits;
          $score += $hits;
          if ($hits == 3) {
                      change_speed(-100);
                      status("*** 10 second SPEED BOOST ***");
                      Tk::After->new($mw,10000,'once', sub {
                                change_speed(100);
                                status("You survived the speed boost")
+;
                      } );
          }
       }

       if ($snake->{food} > 0) {
          $snake->{food}--;
       } else {
          pop   @{$snake->{blocks}};
       }
       show_snake();
    } else {
       $status->configure(-text=>"Ouch! You died");
       $dead = 1;
    }
    update_score_board();
}

sub show_snake {
    $board->delete('snake');
    my $inc  = 3 / (@{ $snake->{blocks} || [] } || 1);
    my $size = 5;
    for my $block (@{$snake->{blocks}}) {
        $size -= $inc;
        circle($board, $block->[0], $block->[1], $size,  'red', 'snake
+', 'circle');
    }
}

sub show_food {
    $board->delete('food');
    for my $block ( @$food ) {
        block($board, $block->[0], $block->[1], $food_color->{$block->
+[2]}, 'food');
    }
}

sub circle {
    my ($canvas,$x,$y,$size, $color, $tag) = @_;
    $color ||= 'red';
    $size  ||= 0;
    $x = ($x * 10) + 5;
    $y = ($y * 10) + 5;
    $canvas->createOval($x-$size,$y-$size,$x+$size, $y+$size , -fill=>
+ $color, -tags => [$tag]);
}

sub block {
    my ($canvas,$x,$y,$color, $tag) = @_;
    $color ||= 'red';
    $canvas->createRectangle($x*10,$y*10,($x+1) * 10, ($y + 1) *10, -f
+ill=> $color, -tags => [$tag]);
}
[download]