Version initiale faite par Marcellin Buisson!

1 files changed, 956 insertions, 0 deletions

diff --git a/Perl/demos/Tk/demos/zinc_lib/Zetris.pl b/Perl/demos/Tk/demos/zinc_lib/Zetris.pl
new file mode 100644
index 0000000..3a83bf7
--- /dev/null
+++ b/Perl/demos/Tk/demos/zinc_lib/Zetris.pl
@@ -0,0 +1,956 @@
+#!/usr/bin/perl
+
+#------------------------------------------------------------------------------
+#
+#  Zetris - A Zinc Toy-Appli based on cool TkTetris from Slaven Rezic
+#
+#  $Id$
+#
+#  Copyright (C) 2002 Centre d'Etudes de la Navigation Aérienne
+#  Author: Marcellin Buisson <buisson@cena.fr>
+#
+#  Hacked from Original Code to adapt to Tk::Zinc Widget :
+#
+#------------------------------------------------------------------------------
+#
+#  Author: Slaven Rezic
+#
+#  Copyright (C) 1997, 1999, 2000, 2002 Slaven Rezic. All rights reserved.
+#  This program is free software; you can redistribute it and/or
+#  modify it under the same terms as Perl itself.
+#
+#  Mail: slaven.rezic@berlin.de
+#  WWW:  http://www.rezic.de/eserte/
+#
+#------------------------------------------------------------------------------
+
+#------------------------------------------------------------------------------
+#  What are the differences with the original TkTetris ?
+#------------------------------------------------------------------------------
+#
+#  - This TkTetris-like uses a tk widget similar to the canvas
+#    and called "Zinc". Zinc bring to Tk widgets openGL features
+#    like transparency, color gradiants, scaling.
+#    So to use Zetris you need openGL capability.
+#    Zinc comes with other features like grouping and clipping.
+#
+#  - A color gradiant is used for Zetris background,
+#
+#  - Zetris balls are filled with transparently color gradiants,
+#    (transparency is visible when balls fall over TkZinc logo)
+#
+#  - Zetris balls have a little transparent shadow,
+#
+#  - The TkZinc logo is animated by rotation and scaling effects,
+#
+#  - Introducing of groups provided by Zinc for grouping items
+#    This feature is particularly useful for applying transformations,
+#
+#  - The TkZinc logo over background isn't an image but only curves
+#    and color gradiants (made by <vinot@cena.fr>)
+#
+#  - Please feel free to provide any feedback to <buisson@cena.fr>
+#
+#
+#------------------------------------------------------------------------------
+
+#------------------------------------------------------------------------------
+# ToDos :
+#
+#  - Complete this basic version in a full playable game like tktetris.
+#  - Review conception through Zinc features.
+#    (using groups capabilities for drawing blocks for instance)
+#  - Adding special effects when completing a line or changing level.
+#
+#------------------------------------------------------------------------------
+use Tk;
+use Tk::Zinc;
+use strict;
+use LogoZinc;
+
+package main;
+
+use Getopt::Long;
+
+use vars qw($VERSION);
+
+$VERSION = sprintf("%d.%00d", q$Revision$ =~ /(\d+)\.(\d+)/);
+
+my $max_size     = 4;
+my $nmbr_blks    = 7;
+my $width        = 12;
+my $height       = 20;
+my $geometry;
+
+my $level;
+my $just_started = 1;
+my $speed;
+my $base_speed = 500;
+
+my $last_resize;
+my $fontheight   = 0;
+
+my $basefont
+  = sub { sprintf "-*-helvetica-medium-r-normal--%s-*", $_[0] };
+my $base2font
+  = sub { sprintf "-*-courier-medium-r-normal--%s-*", $_[0] };
+
+my $blocks = 0;
+my $lines = 0;
+my $mylines = 0;
+
+my $pause = undef;
+my $pause_w;
+my $freefall = 0;
+my $points = 0;
+my $flat = 0;
+my $moveable_drop = 0;
+
+my $old_win_height;
+my $draw_shadow = 1;
+
+# Animation constants
+my $afterdelay = 1;
+my $stepsnumber = 10;
+my $zoomrate = 1.1;
+
+my $active_block    = undef;
+my $active_block_nr = undef;
+my $active_dir      = undef;
+my $next_block      = undef;
+my $next_block_nr   = undef;
+my $next_dir        = undef;
+my $posx = undef;
+my $posy = undef;
+
+my $n = 0;
+
+my(%color_dark, %color_very_dark);
+my %color_bright =
+  (2 => 'red',
+   3 => 'green',
+   4 => 'blue',
+   5 => 'cyan',
+   6 => 'yellow',
+   7 => 'orange',
+   8 => 'pink',
+  );
+
+# Blocks matrix
+my $block =
+  [[[qw(0 0 0 0)],
+    [qw(0 2 0 0)],
+    [qw(0 2 2 0)],
+    [qw(0 2 0 0)]],
+   [[qw(0 0 0 0)],
+    [qw(3 3 0 0)],
+    [qw(0 3 0 0)],
+    [qw(0 3 0 0)]],
+   [[qw(0 0 0 0)],
+    [qw(0 4 4 0)],
+    [qw(0 4 0 0)],
+    [qw(0 4 0 0)]],
+   [[qw(0 0 0 0)],
+    [qw(0 5 0 0)],
+    [qw(0 5 5 0)],
+    [qw(0 0 5 0)]],
+   [[qw(0 0 0 0)],
+    [qw(0 6 0 0)],
+    [qw(6 6 0 0)],
+    [qw(6 0 0 0)]],
+   [[qw(0 7 0 0)],
+    [qw(0 7 0 0)],
+    [qw(0 7 0 0)],
+    [qw(0 7 0 0)]],
+   [[qw(0 0 0 0)],
+    [qw(0 0 0 0)],
+    [qw(8 8 0 0)],
+    [qw(8 8 0 0)]],
+  ];
+
+my $playfield;
+reset_playfield();
+
+my $step_x = 20;
+my $step_y = 20;
+my $boxsize_x    = $step_x-2;
+my $boxsize_y    = $step_y-2;
+my $block_border = int($boxsize_x/10);
+my $help_top;
+
+my $top = MainWindow->new();
+$top->minsize(181, 83);
+$top->title('Zetris');
+
+{
+  my $width_height_set = 0;
+  if ($geometry)
+    {
+      if ($geometry =~ /^(=?(\d+)x(\d+))?(([+-]\d+)([+-]\d+))?$/)
+	{
+	  if (defined $2 and defined $3)
+	    {
+	      my($width, $height) = ($2, $3);
+	      $top->GeometryRequest($width, $height);
+	      $width_height_set++;
+	    }
+	  if (defined $5 and defined $6)
+	    {
+	      my($x, $y) = ($5, $6);
+	      $top->geometry("$x$y");
+	    }
+	}
+      else
+	{
+	  die "Can't parse geometry: $geometry";
+	}
+    }
+    if (!$width_height_set)
+      {
+	$top->GeometryRequest($top->screenwidth,
+			      $top->screenheight);
+      }
+}
+
+my $base_level = 1;
+
+$level = level();
+$speed = speed();
+
+resize_calc();
+
+while(my($k, $v) = each %color_bright)
+  {
+    $color_dark{$k} = $top->Darken($v, 80);
+    $color_very_dark{$k} = $top->Darken($v, 60);
+  }
+
+
+# Zinc Widget (openGl rendering option set to 1)
+my $tetris = $top->Zinc(-width  => $step_x*($width-2),
+			-height => $step_y*($height-1),
+			-backcolor => '#707070',
+			-lightangle => 130,
+			-render => 1,
+		       )->pack;
+die "no openGL rendering on this X server" unless $tetris->cget(-render);
+
+my $shadow_group = $tetris->add('group',1, -visible => 1);
+
+my $pause_group = $tetris->add('group',1, -visible => 1);
+
+my $topgroup = 1;
+
+$tetris->pack(-fill => 'both',
+	    -expand=> 1);
+
+$tetris->add('rectangle',
+	     1, # Zinc group
+	     [0, 0,$step_x*($width-2) ,$step_y*($height-1)] ,
+	     -filled => 1,
+	     -linewidth => 0,
+	     -fillcolor  => "black:40|gray80:60/90",
+	     -visible => 1);
+
+my $group = $tetris->add('group', 1, );
+my $logo = $tetris->LogoZinc(-parent => $group,
+			     -position => [$step_x*($width-2)/2-200, $step_y*($height-1)/2],
+			    );
+
+$tetris->lower($group);
+
+my $score_group = $tetris->add('group',1, -visible => 1);
+my $new = $tetris->add('text',$score_group,
+		       -text => "    $lines Line\n",
+		       #-anchor => 'e',
+		       -position => [$width-2,10],
+		      );
+
+$tetris->lower($score_group);
+
+my $timer = $top->after(speed(), sub {
+			  $old_win_height = $top->height;
+			  $just_started = 0;
+			  action();
+			});
+
+make_key_bindings($top);
+
+print "\n***********************************************\n\n   For help on the game toggle pause with 'p'\n\n***********************************************\n\n";
+
+MainLoop;
+
+#------------------------------------------------------------------------
+sub reset_playfield
+  {
+    my $i;
+    # $fake_height: mit negativen Indices können die n-letzten Elemente
+    # angesprochen werden...
+    my $fake_height = $height+$max_size+1;
+    for $i (0 .. $fake_height-1)
+      {
+	$playfield->[$i][0] = 1;
+	my $j;
+	for $j (1 .. $width-2)
+	  {
+	    $playfield->[$i][$j] = 0;
+	  }
+	$playfield->[$i][$width-1] = 1;
+      }
+    for $i (0 .. $width-1)
+      {
+	$playfield->[$height-1][$i] = 1;
+      }
+  }
+
+sub speed
+  {
+    my $speed = $base_speed - ($base_speed*$level)/20;
+    if ($speed <= 5) { $speed = 5 }
+    $speed;
+  }
+
+sub level
+  {
+    int($lines / 10) + 1 + $base_level
+  }
+
+sub resize_calc
+  {
+    $last_resize = time();
+    my $win_height;
+    if ($just_started)
+      {
+	$win_height = $top->reqheight;
+      }
+    else
+      {
+	$win_height = $top->height;
+      }
+    $step_x = $step_y = int($win_height/($height+3));
+    my $gap = ($step_x > 10 ? 2 : 1);
+    $boxsize_x    = $step_x-$gap;
+    $boxsize_y    = $step_y-$gap;
+    $block_border = int($boxsize_x/10);
+    if ($block_border < 1) { $block_border = 1 }
+    my @font_height = (10, 11, 12, 14, 17, 18, 20, 24, 25, 34);
+    my $req_fontheight = $win_height/30;
+    $fontheight = 0;
+    foreach (@font_height)
+      {
+	if ($_ > $req_fontheight)
+	  {
+	    $fontheight = $_;
+	    last;
+	  }
+      }
+    if (!$fontheight) { $fontheight = $font_height[$#font_height] }
+    $top->optionAdd("*font" => $basefont->($fontheight));
+  }
+
+sub make_key_bindings
+  {
+    my $top = shift;
+    $top->bind('<Escape>' => \&quit_game);
+    $top->bind('<q>'      => \&quit_game);
+    $top->bind('<Control-c>' => \&quit_game);
+    $top->bind('<Left>'   => sub { move('left')  });
+    $top->bind('<Right>'  => sub { move('right') });
+    $top->bind('<Up>'     => sub { move('antiturn')  });
+    $top->bind('<Down>'   => sub { move('turn')  });
+    $top->bind('<j>'      => sub { move('left')  });
+    $top->bind('<l>'      => sub { move('right') });
+    $top->bind('<k>'      => sub { move('turn')  });
+    foreach (qw/space KP_Enter/) {
+      $top->bind("<$_>"  => sub { move('freefall') });
+    }
+    $top->bind('<p>'      => sub { toggle_pause() });
+    $top->bind('<n>'      => \&stop_and_new_game);
+    $top->bind('<h>'      => \&help);
+    #$top->bind('all', '<F1>'     => \&help); # don't pause
+    $top->bind('all', '<F2>'     => \&lost); 
+    #XXX Leave und Enter herausnehmen
+    $top->bind('<FocusOut>' => sub { inc_pause(1) });
+    #    $top->bind('<Leave>'    => sub { inc_pause(1) });
+    $top->bind('<FocusIn>'  => sub { dec_pause(1) });
+    #$top->bind('<ButtonRelease>'  => sub {  toggle_pause()});
+    #$top->bind('<Key-space>'  => sub {  toggle_pause()});
+    #    $top->bind('<Enter>'    => sub { dec_pause(1) });
+  }
+
+
+sub inc_pause
+  {
+    my $quiet = shift;
+    $pause++;
+    if (!$quiet && !Tk::Exists($pause_w))
+      {
+	my $width  = $top->width;
+	my $height = $top->height;
+	$pause_w = $tetris->add('text',$pause_group,
+				   -text => "PAUSE MODE :\n Type p to continue\n
+\n\n\nHELP : \n\n- 'p' toggle pause\n\n- 'q' or 'F2' to quit game\n\n- Arrow keys to move blocks\n\n- 'n' to start a new game\n\n  ",
+				   -position => [30,50],
+				   -anchor => 'nw',
+
+       );
+    }
+}
+
+sub dec_pause
+  {
+    if ($pause)
+      {
+	$pause--;
+	if ($pause < 1)
+	  {
+	    $tetris->remove($pause_w);
+	    undef $pause;
+	  }
+      }
+  }
+
+sub toggle_pause
+  {
+    my $quiet = shift;
+    if ($pause)
+      {
+	$tetris->remove($pause_w);# if Tk::Exists($pause_w);
+	undef $pause;
+      }
+    else
+      {
+	
+	inc_pause($quiet);
+      }
+  }
+
+
+sub action
+  {
+    if (!$pause)
+      {
+	if (!defined $active_block_nr)
+	  {
+	    if (!defined $next_block_nr)
+	      {
+		get_next_block();
+	      }
+	    $active_block_nr = $next_block_nr;
+	    $blocks++;
+	    $active_block = [];
+	    copyblock($next_block, $active_block);
+	    $active_dir      = $next_dir;
+	    get_next_block();
+	  }
+	if (defined $posx)
+	  {
+	    # erstes Zeichnen
+	    if (testblock($active_block, $posx, $posy+1))
+	      {
+		drawblock($posx, $posy, 0);
+		$posy++;
+		drawblock($posx, $posy, 1);
+	      }
+	    else
+	      {
+		array_update(($level+1) * int(($height-$posy+5)/5),
+			     $posx, $posy);
+		return;
+	      }
+	  }
+	else
+	  {
+	    $posx = int($width / 2) - 1;
+	    $posy = -$max_size;
+	  }
+      }
+    $timer = $top->after($freefall ? 1 : speed(), \&action);
+  }
+
+sub get_next_block
+  {
+    $next_block_nr = int(rand()*$nmbr_blks);
+    $next_dir      = int(rand()*4);
+    $next_block    = $block->[$next_block_nr];
+    for (0 .. $next_dir)
+      {
+	turn($next_block_nr, $next_block);
+      }
+  }
+
+sub turn
+  {
+    my($number, $block) = @_;
+    my($i, $j, $help_block);
+    if ($number != 6)
+      {
+	if ($number < 5)
+	  {
+	    for $i (1 .. $max_size-1)
+	      {
+		for $j (0 .. $max_size-2)
+		  {
+		    $help_block->[$max_size-1-$j][$i-1] = $block->[$i][$j];
+		  }
+	      }
+	    for $i (1 .. $max_size-1)
+	      {
+		for $j (0 .. $max_size-2)
+		  {
+		    $block->[$i][$j] = $help_block->[$i][$j];
+		  }
+	      }
+	  }
+	else
+	  {
+	    for $i (0 .. $max_size-1)
+	      {
+		for $j (0 .. $max_size-1)
+		  {
+		    $help_block->[$max_size-1-$j][$i] = $block->[$i][$j];
+		  }
+	      }
+	    copyblock($help_block, $block);
+	  }
+      }
+  }
+
+sub copyblock
+  {
+    my($from, $to) = @_;
+    die if ref $from ne 'ARRAY' || ref $to ne 'ARRAY';
+    my($i, $j);
+    for $i (0 .. $max_size-1)
+      {
+	for $j (0 .. $max_size-1)
+	  {
+	    $to->[$i][$j] = $from->[$i][$j];
+	  }
+      }
+  }
+sub rectangle
+  {
+    my($x, $y, $mode, $zinc) = @_;
+    $zinc->remove("$x-$y");         # Zinc command for deleting items
+    $zinc->remove("ombre$x-$y");
+    if ($mode)
+      {
+	my($xx, $yy);
+	($xx, $yy) = (($x-1)*$step_x, $y*$step_y);
+	my $dark_color;
+	$dark_color = $color_dark{$mode};
+	my $color = $color_bright{$mode};
+	my $center_ball_x = $xx+0.5*$boxsize_x;
+	my $center_ball_y = $yy+0.5*$boxsize_y;
+	my $center_for_ball_x = $xx+0.5*0.5*$boxsize_x;
+	my $center_for_ball_y = $yy+0.5*0.5*$boxsize_y;
+	my $corner_x = $xx+$boxsize_x;
+	my $corner_y = $yy+$boxsize_y;
+	# Adding new Zinc item : ball shadow
+	my $ombre=$zinc->add(
+			     'arc',$shadow_group,[$xx+10,$yy+10,$xx+$boxsize_x+10,$yy+$boxsize_y+10],
+			     -visible=>1,
+			     -filled=>1,
+			     -fillcolor => "black:100 0|black:80 20|black:10 100[$corner_x $corner_y", # color gradiant
+			     -linewidth => 0,
+			     -linecolor => 'yellow',
+			     -tags => ["ombre$x-$y"]);
+	
+	$zinc->itemconfigure($shadow_group, -priority => 2);
+	
+	# Adding new Zinc item : ball
+	my $cercle=$zinc->add(
+			      'arc',$topgroup,[$xx,$yy,$xx+$boxsize_x,$yy+$boxsize_y],
+			      -visible=>1,
+			      -filled=>1,
+			      -fillcolor => "white:120|$color:80($center_for_ball_x $center_for_ball_y" ,
+			      -linewidth => 1,
+			      -linecolor => "$color:80",
+			      -tags => ["$x-$y"]);
+      }
+  }
+
+sub testblock
+  {
+    my($active_block, $posx, $posy) = @_;
+    for(my $i = 0; $i <= $max_size-1; $i++)
+      {
+	for(my $j = 0; $j <= $max_size-1; $j++)
+	  {
+	    if ($active_block->[$i][$j])
+	      {
+		if ($playfield->[$posy+$i][$posx+$j])
+		  {
+		    return 0;
+		  }
+	      }
+	  }
+      }
+    1;
+  }
+
+sub drawblock
+  {
+    my($posx, $posy, $mode, $zinc) = @_;
+    my $y = $posy;
+    $zinc = $tetris if !$zinc;
+    for(my $i = 0; $i <= $max_size-1; $i++)
+      {
+	my $x = $posx;
+	for(my $j = 0; $j <= $max_size-1; $j++)
+	  {
+	    if ($active_block->[$i][$j])
+	      {
+		if (!$mode)
+		  {
+		    rectangle($x, $y, 0, $zinc);
+		  }
+		else
+		  {
+		    rectangle($x, $y, $active_block->[$i][$j], $zinc);
+		  }
+	      }
+	    $x++;
+	  }
+	$y++;
+      }
+  }
+
+
+
+sub new_game {
+    reset_playfield();
+    renew_field();
+    reset_block();
+    $next_block_nr = undef;
+    reset_game_param();
+    action();
+}
+
+sub stop_and_new_game {
+    stop_game();
+    new_game(),
+  }
+
+sub quit_game {
+
+    print "Bye!\n";
+    exit;
+}
+
+sub lost {
+  $top->destroy;
+  print "You lost :o( !\n";
+  exit;
+ }
+
+sub reset_game_param {
+    $points = $blocks = $lines = 0;
+    $level = level();
+    $speed = speed();
+    $pause = undef;
+}
+
+sub stop_game {
+    undef_timer();
+    undef $active_block;
+}
+
+sub delete_line
+  {
+    my($y) = @_;
+    my $yy = $y*$step_y;
+    my $x;
+    for $x (1 .. $width-2)
+      {
+	my $xx = ($x-1)*$step_x;
+	$tetris->add
+	  ('rectangle',1,
+	   [$xx, $yy, $xx+$boxsize_x, $yy+$boxsize_y],
+	   -filled => 1,
+	   -fillcolor => 'orange:50',
+	   -tags => ['delline'],
+	  );
+      }
+    $tetris->idletasks;
+    short_sleep(0.05);
+    $tetris->remove('delline');
+    my $deuxpi = 3.1416;
+    my $i = 1;
+    my $angle = 360;
+    # special effect on TkZinc logo
+    rotation($deuxpi*$angle/360);
+    $mylines++;
+    $tetris->itemconfigure($new,-text => "    $mylines Lines\n");
+  }
+
+sub rotation
+  {
+    my ($angle, $cnt) = @_;
+    # first step of animation
+    if ($cnt == $stepsnumber)
+      {
+	inflation(); # scaling effect
+	return;
+      }
+    $cnt++;
+    # use 'rotation' Zinc method.
+    my $stepi = 360/$stepsnumber;
+    $angle = $stepi*2*3.1416/360;
+    $tetris->rotate($group, $angle, 250, 450 );
+    # process the animation using the 'after' Tk defering method
+    $tetris->after($afterdelay, sub {rotation($angle, $cnt)});
+  }
+
+sub inflation
+  {
+    my ($cnt) = @_;
+    my @pos = $tetris->coords($group);
+    my $zf;
+    # last step of animation
+    if ($cnt == 6)
+      {
+	return;
+	# event steps : wheel grows
+      }
+    elsif ($cnt % 2 == 0)
+      {
+	$zf = 4*$zoomrate;
+	# odd steps : wheel is shrunk
+      }
+    else
+      {
+	$zf = 1/(4*$zoomrate);
+      }
+    $cnt++;
+    # Now, we apply scale transformation to the Group item, using the 'scale'
+    # Zinc method. Note that we reset group coords before scaling it, in order
+    # that the origin of the transformation corresponds to the center of the
+    # wheel. When scale is done, we restore previous coords of group.
+    $tetris->coords($group, [0, 0]);
+    $tetris->scale($group, $zf, $zf);
+    $tetris->coords($group, \@pos);
+    # process the animation using the 'after' Tk defering method
+    $tetris->after(100, sub {inflation($cnt)});
+  }
+
+sub game_over {
+  stop_game();
+  #    insert_highscore();
+  #    show_highscore('Game over');
+  #    save_highscore();
+  #toggle_pause();
+  my $width  = $top->width;
+  my $height = $top->height;
+  my $new = $tetris->add('text',$pause_group,
+			 -text => "You lost ! :o)\ntype 'n' to try again !",
+			 -position => [20,100],
+			);
+  $top->update('idletasks');
+  short_sleep(1);
+  $tetris->remove($new);
+ }
+
+sub move {
+    my($dir) = @_;
+    if (!$active_block || !defined $posx || $pause) {
+	$top->bell;
+	return;
+    }
+    if ($dir eq 'right' and testblock($active_block, $posx+1, $posy)) {
+	drawblock($posx, $posy, 0);
+	$posx++;
+	drawblock($posx, $posy, 1);
+    } elsif ($dir eq 'left' and testblock($active_block, $posx-1, $posy)) {
+	drawblock($posx, $posy, 0);
+	$posx--;
+	drawblock($posx, $posy, 1);
+    } elsif ($dir eq 'turn') {
+	my $help_block = [];
+	copyblock($active_block, $help_block);
+	turn($active_block_nr, $help_block);
+	if (testblock($help_block, $posx, $posy)) {
+	    drawblock($posx, $posy, 0);
+	    copyblock($help_block, $active_block);
+	    drawblock($posx, $posy, 1);
+	}
+    } elsif ($dir eq 'antiturn') {
+	my $help_block = [];
+	copyblock($active_block, $help_block);
+	anti_turn($active_block_nr, $help_block);
+	if (testblock($help_block, $posx, $posy)) {
+	    drawblock($posx, $posy, 0);
+	    copyblock($help_block, $active_block);
+	    drawblock($posx, $posy, 1);
+	}
+    } elsif ($dir eq 'freefall') {
+	if ($moveable_drop) {
+	    $freefall = 1;
+	    undef_timer();
+	    action();
+	} else {
+	    my $free_fall = 0;
+	    while (testblock($active_block, $posx, $posy+1)) {
+		drawblock($posx, $posy, 0);
+		$posy++;
+		$free_fall++;
+		drawblock($posx, $posy, 1);
+		$top->idletasks;
+	    }
+	    array_update(($level+1)*int(($free_fall+$height-$posy+5)/5),
+			 $posx, $posy);
+	}
+    }
+  }
+
+sub array_update
+  {
+    my($plus, $posx, $posy) = @_;
+    my($i, $j);
+    undef_timer();
+    delete_shadow();
+    for $i (0 .. $max_size-1)
+      {
+	for $j (0 .. $max_size-1) {
+	    if ($active_block->[$i][$j] and $posy+$i >= 0) {
+		$playfield->[$posy+$i][$posx+$j] = $active_block->[$i][$j];
+	    } else {
+		if ($active_block->[$i][$j]) {
+		    game_over();
+		    return;
+		}
+	    }
+	}
+    }
+    $points += $plus;
+
+    if ($posy >= 0) {
+	for $i ($posy .. $height-2) {
+	    if (to_del_line($i)) {
+		delete_line($i);
+		$lines++;
+		$points += 10*($level+1);
+		for $j (reverse(0 .. $i-1)) {
+		    my $k;
+		    for $k (1 .. $width-2) {
+			$playfield->[$j+1][$k] = $playfield->[$j][$k];
+		    }
+		}
+		renew_field($i);
+	    }
+	}
+    }
+
+    my $oldlevel = $level;
+    $level = level();
+    if ($oldlevel != $level) {
+	my $width  = $top->width;
+	my $height = $top->height;
+	my $newlevel = $tetris->add('text',$pause_group,
+				    -text => 'NEW LEVEL',
+				    -position => [20,20],
+				  );
+	$top->update('idletasks');
+	short_sleep(0.5);
+	$tetris->remove($newlevel);
+    }
+    
+    reset_block();
+    action();
+}
+
+sub anti_turn
+  {
+    my($number, $block) = @_;
+    for (1 .. 3) { turn($number, $block) }
+}
+
+sub undef_timer {
+    if ($timer) {
+	$timer->cancel;
+	undef $timer;
+    }
+}
+
+sub delete_shadow {
+    return if !$draw_shadow;
+    for(my $x = 1; $x <= $width-1; $x++) {
+#	rectangle($x, 0, 0, $shadow);
+    }
+}
+
+sub to_del_line {
+    my($posy) = @_;
+    my $i;
+    
+    for $i (1 .. $width-2) {
+	if ($posy >= 0 and !$playfield->[$posy][$i]) {
+	    return 0;
+	}
+    }
+    1;
+}
+sub reset_block {
+    undef $active_block_nr;
+    undef $posx;
+    $freefall = 0;
+}
+
+sub short_sleep {
+    my $sleep = shift;
+    if ($^O =~ /win/i) {
+	$top->Busy;
+	my $wait = 0;
+	$top->after($sleep*1000, sub { $wait = 1 });
+	$top->waitVariable(\$wait);
+	$top->Unbusy;
+    } else {
+	eval { select(undef, undef, undef, $sleep) };
+    }
+}
+
+sub renew_field {
+    my($max_y) = @_;
+    $max_y = $height-2 if !defined $max_y;
+    my($i, $j);
+    for $i (0 .. $max_y) {
+	for $j (1 .. $width-2) {
+	    if ($playfield->[$i][$j]) {
+		rectangle($j, $i, $playfield->[$i][$j], $tetris);
+	    } else {
+		rectangle($j, $i, 0, $tetris);
+	    }
+	}
+    }
+}
+
+sub help
+  {
+    inc_pause();
+    if (defined $help_top and Tk::Exists($help_top))
+      {
+	$help_top->raise;
+	return;
+      }
+    require Tk::ROText;
+    my $firebutton = 'Button';
+    eval { require Tk::FireButton; Tk::FireButton->VERSION(1.04); };
+    $help_top = $top->Toplevel(-title => 'Tetris Help');
+    make_key_bindings($help_top);
+    my $ti = "Zetris help :\n  - truc 1\n  - truc 2\n  - truc 3\n \n";
+    my $create_but = sub {
+	my($t, $command, $fire) = @_;
+	my $button = ($fire ? $firebutton : 'Button');
+	my $but = $tetris->add('text',$pause_group,
+			       -text => $ti,
+			       -font => $base2font->(12),
+			       -position => [20,20],
+				);
+    };
+
+    my $cb = $help_top->Button(-text => 'Close',
+			       -font => $base2font->(12),
+			       -command => sub { $help_top->destroy })->pack;
+    $help_top->bind('<Escape>' => sub { $cb->invoke });
+}