Super Nibbles ;)

Needs some work still, just dies when you loose, so you can't restart. Kinda fun though, my first real Tk app and my first implementation of nibbles. It is quite rough around the edges and makes heavy use of globals.../me is considering ways to add levels with baracades, moving food, enemies etc. ;)

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

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

my $score = 0;
my $start = time;

my $score_board = $mw->Label()->pack();
$score_board->configure(-text => "Score: $score");
my $board = $mw->Canvas(-width => 600, -height => 400)->pack();
$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) });


Tk::After->new($mw,150,'repeat', sub { 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,5];
my $food_color = {
                 1 => 'green',
                 3 => 'yellow',
                 5 => 'purple' };



place_food() for (1..5);

my $snake = {
          direction => 0,
          blocks    =>[ [10,5], [11,5], [12,5] ],
          food      => 0,
};

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

sub set_direction {
    my $dir = shift;
    my $cur = $snake->{direction};
    move() if ($dir == $cur);
    unless ( ($cur == 1 and $dir == 0) or
             ($cur == 0 and $dir == 1) or
             ($cur == 2 and $dir == 3) or
             ($cur == 3 and $dir == 2) ) {
                 $snake->{new_direction} = $dir ;
    }
}

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) = @_;
    for my $block (@$food) {
        if ($x == $block->[0] and $y == $block->[1]) {
           my $hits = $block->[2];
           $block = undef;
           $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;
}

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

sub move {
    if (exists $snake->{new_direction}) {
        $snake->{direction} = $snake->{new_direction};
        delete $snake->{new_direction};
    }
    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) {
          warn "Place new food ($hits)";
          place_food();
          show_food();
          $snake->{food} += $hits;
          $score += $hits;
       }

       if ($snake->{food} > 0) {
          $snake->{food}--;
       } else {
          pop   @{$snake->{blocks}};
       }
       show_snake();
    } else {
       $mw->destroy;
       die "You died";
    }
    update_score_board();
}



sub show_snake {
    $board->delete('snake');
    for my $block (@{$snake->{blocks}}) {
        block($board, $block->[0], $block->[1], 'red', 'snake');
    }
}

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

show_snake();
show_food();


MainLoop;

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]