#!/usr/bin/perl
use strict;
use Tk;
use Data::Dumper;
use Time::HiRes qw ( time);

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

my ($score, $start, $speed, $last_time, $dead);
$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()} )->pack(-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("<Up>"   , sub { set_direction(1) });
$mw->bind("<Right>", 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($last_y - $y)) {
                             set_direction( $last_x > $x ? 0 : 2)
                          } elsif ($pressed) {
                             set_direction( $last_y > $y ? 1 : 3);
                          }
                          ($last_x, $last_y, $skip) = ($x,$y, 0);
                       }, Ev('x'), Ev('y')]);

my $timer = Tk::After->new($mw,100,'repeat',
          sub {
            my $time = time();
            next unless $time - $last_time > $speed;
            $last_time = $time;
            move() unless $dead;
          });

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

my $moves = [ [-1, 0], [ 0,-1],[ 1, 0], [ 0, 1] ];
my $food  = [  ];
my ($l,$r,$t,$b) = (0,59,0,39);
my $blocks;
my $snake;
my $level;
my $cur_level;



my $foods = {
          'grass' => { food  => 1, color => 'green', },
          'jitter bug' => {
               food    => 4,  color   => 'orange',
               on_move => sub {
                             my $block = shift;
                             return unless rand > .1;
                             my $move = $moves->[int rand 4];
                             my $new_pos = [ $block->[0] + $move->[0], $block->[1] + $move->[1] ];
                             if ( ! collide(@$new_pos) ) {
                                 $block->[0] = $new_pos->[0];
                                 $block->[1] = $new_pos->[1];
                             }
                          },
          },
          'wander' => {
               food    => 5,  color   => 'blue',
               on_move => sub {
                             my $block = shift;
                             my $dir = $block->[3] || rand int 4;
                             $dir += rand(int(2)) -1 if rand > .2;
                             $dir = direction_norm($dir);
                             move_unless_collide($block,$dir);
                             $block->[3] = $dir;
                          },
          },
          'evade' => {
               food    => 6,  color   => 'red',
               on_move => sub {
                             my ($block, $snake) = @_;
                             my $dir = $block->[3] || rand int 4;
                             my $head = $snake->{blocks}->[0];
                             my @choices;
                             if (distance(@$head, @$block) < 7 and rand > .3) {
                               push @choices, ($head->[0] > $block->[0]) ? 0 : 2;
                               push @choices, ($head->[1] > $block->[1]) ? 1 : 3;
                               $dir = pick(@choices);
                             } else {
                               $dir += rand(int(2)) - 1;
                             }
                             move_unless_collide($block,$dir);
                             $block->[3] = $dir;
                          },
          },

};

my $levels = {
             1 =>  {
                   name    => "Grassy Knoll",
                   layout  => [],
                   food    => ['grass'], food_count => 3,
                   speed   => .2,
                   victory => sub { return 1 if $score > 5 },
                   },
             2 =>  {
                   name    => "Mice will play while the cats away!",
                   layout  => [],
                   start_at => [30,20],
                   food    => [('grass') x 3, 'jitter bug' ], food_count => 5,
                   speed   => .175,
                   victory => sub { $score > 20 },
                   },
             3 =>  {
                   name    => "Jittery little buggers!",
                   start_at => [30,2],
                   layout  => [ line( 0, $t+$b/2, $l+$r/2 - 5, $t+$b/2),
                                line( $l+$r/2 + 5, $t+$b/2, $r, $t+$b/2) ],  # horz line (middle gap)
                   food    => ['jitter bug' ], food_count => 2,
                   speed   => .15,
                   victory => sub { $score > 30 },
                   },
             4 =>  {
                   name    => "Watch out for the walls (they have ears)!",
                   start_at => [30,2],
                   layout  => [ line( $l+$r/2 - 10, $t+$b/2, $l+$r/2 + 10, $t+$b/2) ],
                   food    => [ 'grass', 'jitter bug','wander' ], food_count => 3,
                   speed   => .16,
                   victory => sub { $score > 40 },
                   },

             5 =>  {
                   name    => "Care to Wander away?",
                   start_at => [30,20],
                   layout  => [ line($l,$t, $l + 10, $t + 10) , line($r - 10 , $t + 10, $r, $t),
                                line($l,$b, $l + 10 ,$b - 10) , line($r - 10 , $b - 10, $r, $b) ], # corners
                   food    => ['jitter bug','wander' ], food_count => 5,
                   speed   => .14,
                   victory => sub { $score > 50 },
                   },
             6 =>  {
                   name    => "Run for it!",
                   layout  => [ line($l,$t, $l + 10, $t + 10) , line($r - 10 , $t + 10, $r, $t),
                                line($l,$b, $l + 10 ,$b - 10) , line($r - 10 , $b - 10, $r, $b) ], # corners
                   food    => ['evade'], food_count => 5,
                   speed   => .10,
                   victory => sub { $score > 62 },
                   },


             };

show_blocks();

MainLoop;

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

sub load_level {
    $level = shift;
    next unless exists $levels->{$level};
    $cur_level = $levels->{$level};
    $mw->configure(title => "Super Nibbles - Level $level - " . $cur_level->{name});
    $board->delete('food');
    if ($cur_level->{start_at}) {
        $board->delete('snake');
        $snake->{direction} = (int rand 4);
        $snake->{food}      = scalar @{$snake->{blocks}};
        $snake->{blocks}    = [$cur_level->{start_at}];
        show_snake();
    }


    $blocks    = $cur_level->{layout};
    show_blocks();
    $food      = [];

    place_food() for (1.. ($cur_level->{food_count} || 5));
    show_food();
}

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) = @_; ($x>=0 and $x<=59 and $y>=0 and $y<=39); }

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

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

# check for all collisions
sub collide { !in_bounds(@_)    or
               hit_snake(@_)    or
               hit_food (@_, 1) or
               hit_block(@_)
}

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

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

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


sub direction_norm {
   my $dir = shift;
   $dir = 0 if $dir > 3;
   $dir = 3 if $dir < 0;
   return $dir;
}

sub move_unless_collide {
    my ($block, $dir)  = @_;
    my $move = $moves->[$dir];
    my $new_pos = [ $block->[0] + $move->[0], $block->[1] + $move->[1] ];
    if ( ! collide(@$new_pos) ) {
       $block->[0] = $new_pos->[0];
       $block->[1] = $new_pos->[1];
       return 1;
    }
    return 0;
}

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

    for my $block (@$food) {
        my $food_obj = $foods->{$block->[2]};
        $food_obj->{on_move}->($block, $snake) if defined $food_obj->{on_move};
    }
    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) && !hit_block(@$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 ($snake->{food} > 0) {
          $snake->{food}--;
       } else {
          pop   @{$snake->{blocks}};
       }
       show_snake();
    } else {
       status("Ouch! You died");
       $dead = 1;
    }
    if ( $cur_level->{victory}->() ) {
       load_level(++$level);
    }
    update_score_board();
}

# display functions. draw the playing field
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], $foods->{$block->[2]}->{color}, 'food');
    }
}

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

#Tk display functions (normalized to our play grid)

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, -fill=> $color, -tags => [$tag]);
}


## Util Functions

sub round { int( $_[0] + ( $_[0] < 0 ? -.5 : .5 ) ); }
sub distance {
    my ($x1,$y1, $x2,$y2) = @_;
    sqrt( ($x1 - $x2)**2 + ($y1 - $y2)**2 );
}
sub pick  { @_[rand @_] };

sub line {
    my ($x1,$y1,$x2,$y2) = @_;
    my $x_diff = $x2 - $x1;
    my $y_diff = $y2 - $y1;
    my @out;
    if (abs($x_diff) >= abs($y_diff)) {
       my $y_step = $y_diff / $x_diff;
       my $y = $y1;
       for my $x ( $x1 .. $x2) {
           push @out, [$x, round($y)];
           $y += $y_step;
       }
    } else {
       my $x_step = $x_diff / $y_diff;
       my $x = $x1;
       for my $y ( $y1 .. $y2) {
           push @out, [round($x), $y];
           $x += $x_step;
       }
    }
    return @out;
}