Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Super Nibbles

by eric256 (Parson)
on Nov 14, 2005 at 14:26 UTC ( #508319=CUFP: print w/ replies, xml ) Need Help??

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]); }


___________
Eric Hodges $_='y==QAe=e?y==QG@>@?iy==QVq?f?=a@iG?=QQ=Q?9'; s/(.)/ord($1)-50/eigs;tr/6123457/- \/|\\\_\n/;print;

Comment on Super Nibbles
Download Code
Re: Super Nibbles
by zentara (Archbishop) on Nov 14, 2005 at 17:22 UTC
    Pretty good. I would add a "snake speed control" to speed up and slow down. Maybe have levels, where you start out slow, and it gradually speeds up as you start winning. You won't be able to change the repeat statement's time interval, but you could change the amount moved at each interval, so instead of moving 1 unit, move 100/$speed_select units.

    I'm not really a human, but I play one on earth. flash japh

      Yea that was on my todo list ;). Changing the amount moved wouldn't be in the spirit of nibbles. I'll have to find a different way ;) /me debates on adding speed control or moving food next. ;)


      ___________
      Eric Hodges $_='y==QAe=e?y==QG@>@?iy==QVq?f?=a@iG?=QQ=Q?9'; s/(.)/ord($1)-50/eigs;tr/6123457/- \/|\\\_\n/;print;
Re: Super Nibbles
by diotalevi (Canon) on Nov 14, 2005 at 18:28 UTC
    1 million demerits for mixing your top level executable code with your function defintions.

      Yea no kidding. ;) I'm working on cleaning it up. Several things became functions as I went and so I build the function in place and havn't done my house cleaning yet ;)


      ___________
      Eric Hodges $_='y==QAe=e?y==QG@>@?iy==QVq?f?=a@iG?=QQ=Q?9'; s/(.)/ord($1)-50/eigs;tr/6123457/- \/|\\\_\n/;print;
Re: Super Nibbles
by eric256 (Parson) on Nov 14, 2005 at 21:40 UTC

    Updated Version: This one has moving food, status bar, score, count down after clicking start, death doesn't leave game. It also adds Mouse control. Click and drag the mouse to stear your nibbler by hand for extra challenge!

    Update: Added MainLoop; which got lost in copy paste somehow.


    ___________
    Eric Hodges $_='y==QAe=e?y==QG@>@?iy==QVq?f?=a@iG?=QQ=Q?9'; s/(.)/ord($1)-50/eigs;tr/6123457/- \/|\\\_\n/;print;

      Two comments:

      1. You seem to have lost the MainLoop; from your code during pasting?
      2. This is now so ludicrously fast that death is near instantaneous.

        If you survive the first speed boost, you surely won't the second.

        But hey! It sure is fun tryin' :)


      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.

        Indeed I did loose the main loop. The speed is realy that fast? Its just perfect on mine. Must be something about the timing in Tk::After....guess i'll go read some documentation. Thanks for the feed back. BTW did the first version work better speed wise?


        ___________
        Eric Hodges $_='y==QAe=e?y==QG@>@?iy==QVq?f?=a@iG?=QQ=Q?9'; s/(.)/ord($1)-50/eigs;tr/6123457/- \/|\\\_\n/;print;
      First version worked fine. When I try to run this one it thinks for a second and then come back to the prompt.

      Turned on warnings with -w and I am not seeing anything that I am missing.

      Using active perl 5.8.7

        Yea it was missing MainLoop but I updated it now.


        ___________
        Eric Hodges $_='y==QAe=e?y==QG@>@?iy==QVq?f?=a@iG?=QQ=Q?9'; s/(.)/ord($1)-50/eigs;tr/6123457/- \/|\\\_\n/;print;
Re: Super Nibbles
by sanPerl (Friar) on Nov 15, 2005 at 13:08 UTC
    Very good script indeed, I can learn lot of things from your coding.
      unlike this:
      use Term::ReadKey;ReadMode 3;%v=qw{a -1 s 80 w -80};$f=print"\ec";{$d+ +=$ v{$c=ReadKey(-1)||$c}||1;p($d=$d>1600?$d-1600:$d<0?$d+1600:$d);$d-int$ +f? p(pop@s,$"):p($f=rand 800);9x1e7;map$d-$_||${ReadMode 0;exit},@s;@s=($ +d, @s);redo}sub p{printf"\e\[%d;%dH%s\e[20H",1+$_[0]/80,$_[0]%80,$_[1]||x +}
      from here oh yeah: w=up s=down a=left d=right
      a
      update: added key defs
Re: Super Nibbles
by eric256 (Parson) on Dec 03, 2005 at 05:42 UTC

    Now bloated to a grand 428 lines, it also comes with 4 food types (stationary, random jitter, random wander, and wander+evade), and 6 levels (though only 4 have different walls). Please feel free to make up new levels and send them in, currently i can't manage to get to level 6 and live more than a few seconds, I keep chasing the bastards right into walls.

    Also added some iffy features and fixed the speed issue hopefully. The iffy feature is letting each level start you at a specific spot, this can be quite disconerting the first 20 times it happens. Ideas, improvments, levels, and requests to stop posting these new versions all welcome! ;)

    #!/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()} )->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("<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($la +st_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 ran +d > .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_cou +nt => 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_l +evel->{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 - $s +tart)); } 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, -f +ill=> $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; }

    ___________
    Eric Hodges $_='y==QAe=e?y==QG@>@?iy==QVq?f?=a@iG?=QQ=Q?9'; s/(.)/ord($1)-50/eigs;tr/6123457/- \/|\\\_\n/;print;

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://508319]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (5)
As of 2014-08-31 07:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (294 votes), past polls