Tetris: Difference between revisions

From Rosetta Code
Content added Content deleted
No edit summary
No edit summary
Line 47: Line 47:


See [[Tetris/Microsoft_Small_Basic|Tetris/Microsoft Small Basic]].
See [[Tetris/Microsoft_Small_Basic|Tetris/Microsoft Small Basic]].


=={{header|Perl}}==
Very basic tetris. Use arrow keys for left and right (or 'h' and 'l'), up arrow for rotate (or 'r'),
and down arrow for instant drop (or 'j').
<lang perl>#!/usr/bin/perl

use strict;
use warnings;
use Curses;
use Term::ReadKey;
use Time::HiRes qw( time );
use IO::Select;

my $delay = 1;
my $width = 12;
my $oneshort = $width - 1;
my $g3 = qr/(..{$oneshort})/s;
my $g4 = qr/(.{$oneshort})/s;
my $below = qr/....{$oneshort}/s;
my $height = 20;
my $well = ( '|' . ' ' x $width . "|\n" ) x $height . '-' x($width + 2) . "\n";
my $piece;
my $nexttime = time + $delay;
my $sel = IO::Select->new( *STDIN );

sub transpose
{
local $_ = $well;
$well = '';
$well .= "\n" while s/^./ $well .= $&; ''/gem;
}

sub place
{
substr $well, $width / 2 - 1 + ($width + 3) * $_, 4, shift for 0 .. 3;
}

my %shape =
(
I => [' O ', ' O ', ' O ', ' O '],
J => [' ', ' ', 'OOO ', ' O '],
L => [' ', ' ', ' OOO', ' O '],
O => [' ', ' ', ' OO ', ' OO '],
S => [' ', ' ', ' OO ', 'OO '],
T => [' ', ' ', ' O ', 'OOO '],
Z => [' ', ' ', ' OO ', ' OO'],
);

sub add
{
if( $well =~ /^(. *.\n){4}/ )
{
place $shape{$piece}->@*;
$piece = (keys %shape)[rand keys %shape];
}
else
{
die "end of game\n";
}
}

sub rotate
{
s/ ${g3}OO $g3 OO/ O$1 OO$2 O / or # Z
s/ O$g3 OO$g3 O / $1OO $2 OO/ or

s/ $g3 OO${g3}OO / O $1 OO$2 O/ or # S
s/ O $g3 OO$g3 O/ $1 OO$2OO / or

s/ ${g3}OOO${g3}O /OO $1 O $2 O / or # L
s/OO $g3 O $g3 O / $1 O$2OOO/ or
s/ $g3 O${g3}OOO/ O $1 O $2 OO/ or
s/ O $g3 O $g3 OO/ $1OOO$2O / or

s/ ${g3}OOO$g3 O/ O $1 O $2OO / or # J
s/ O $g3 O ${g3}OO / $1O $2OOO/ or
s/ ${g3}O ${g3}OOO/ OO$1 O $2 O / or
s/ OO$g3 O $g3 O / $1OOO$2 O/ or

s/ $g3 O ${g3}OOO/ O $1 OO$2 O / or # T
s/ O $g3 OO$g3 O / $1OOO$2 O / or
s/ ${g3}OOO$g3 O / O $1OO $2 O / or
s/ O ${g3}OO $g3 O / $1 O $2OOO/ or

s/ $g4 $g4 ${g4}OOOO/ O $1 O $2 O $3 O / or # I
s/ O $g4 O $g4 O $g4 O / $1 $2 $3OOOO/ or
s/O ${g4}O ${g4}O ${g4}O / $1 $2 $3OOOO/ or
s/ O$g4 O$g4 O$g4 O/ $1 $2 $3OOOO/

for $well;
}

sub step
{
if( $well =~ s/(?<=\|)#{$width}(?=\|)/ '=' x $width /e ) # full row?
{
transpose();
$well =~ s/(.*)=/ $1/g; # remove full row
transpose();
}
elsif( $well !~ /O/ ) # any O ?
{
add();
}
elsif( not down() ) # can't move down
{
$well =~ tr/O/#/; # convert to #
}
}

sub down
{
$well !~ /O/ || $well =~ /O$below[#-]/ and return 0;
transpose();
$well =~ s/(O+) / $1/g;
transpose();
return 1;
}

sub drop { 1 while down() }

sub right { $well =~ /O[#|]/ or $well =~ s/(O+) / $1/g }

sub left { $well =~ /[#|]O/ or $well =~ s/ (O+)/$1 /g }

sub draw
{
addstr( 2, 0, ($well . "\n\n") =~ s/^/' ' x 20 /gmer);
my $row = 4;
addstr( $row++, 10, $_ ) for @{ $shape{$piece} };
addstr( 22, 0, ' ' );
refresh;
};

sub eventloop
{
while( 1 )
{
my $time = time;
my $delta = $nexttime - $time;
if( $delta <= 0 )
{
step();
$nexttime = time + $delay;
}
else
{
draw();
for ( $sel->can_read( $delta ) )
{
sysread *STDIN, $_, 1024;
for ( /\e(?:\[M...|[O\[][0-9;]*[A-~])|./gs ) # keep esc seq together
{
/^(?:q|\e)\z/i ? die "quit\n" :
/^(?:h|\e\[D)\z/ ? left() :
/^(?:l|\e\[C)\z/ ? right() :
/^(?:r|\e\[A)\z/ ? rotate() :
/^(?:[j ]|\e\[B)\z/ ? drop() :
0;
}
}
}
}
}

$piece = (keys %shape)[rand keys %shape];
initscr();
clear;
ReadMode 'cbreak';
eval { eventloop() };
my $errormsg = $@;
ReadMode 'restore';
endwin();
print $errormsg;</lang>



=={{header|Phix}}==
=={{header|Phix}}==

Revision as of 18:49, 24 February 2021

Tetris is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
Task

Create a playable Tetris game.

Requirements
  • a left / right key
  • a hard drop key (the current piece will be dropped and locked at once)
  • a rotation key
  • a preview piece
  • full set of 7 kinds of shapes (ITOSZJL)



Applesoft BASIC

See Tetris/Applesoft BASIC.

Bash

See Tetris/BASH.

Ansi94 Forth

See Tetris/Ansi94 Forth.

Go

See Tetris/Go

Java

See Tetris/Java.

JavaScript

See Tetris/JavaScript.

Julia

See Tetris/Julia.

Mathematica

See Tetris/Mathematica.

Microsoft Small Basic

See Tetris/Microsoft Small Basic.


Perl

Very basic tetris. Use arrow keys for left and right (or 'h' and 'l'), up arrow for rotate (or 'r'), and down arrow for instant drop (or 'j'). <lang perl>#!/usr/bin/perl

use strict; use warnings; use Curses; use Term::ReadKey; use Time::HiRes qw( time ); use IO::Select;

my $delay = 1; my $width = 12; my $oneshort = $width - 1; my $g3 = qr/(..{$oneshort})/s; my $g4 = qr/(.{$oneshort})/s; my $below = qr/....{$oneshort}/s; my $height = 20; my $well = ( '|' . ' ' x $width . "|\n" ) x $height . '-' x($width + 2) . "\n"; my $piece; my $nexttime = time + $delay; my $sel = IO::Select->new( *STDIN );

sub transpose

 {
 local $_ = $well;
 $well = ;
 $well .= "\n" while s/^./ $well .= $&; /gem;
 }

sub place

 {
 substr $well, $width / 2 - 1 + ($width + 3) * $_, 4, shift for 0 .. 3;
 }

my %shape =

 (
 I => [' O  ', ' O  ', ' O  ', ' O  '],
 J => ['    ', '    ', 'OOO ', '  O '],
 L => ['    ', '    ', ' OOO', ' O  '],
 O => ['    ', '    ', ' OO ', ' OO '],
 S => ['    ', '    ', ' OO ', 'OO  '],
 T => ['    ', '    ', ' O  ', 'OOO '],
 Z => ['    ', '    ', ' OO ', '  OO'],
 );

sub add

 {
 if( $well =~ /^(. *.\n){4}/ )
   {
   place $shape{$piece}->@*;
   $piece = (keys %shape)[rand keys %shape];
   }
 else
   {
   die "end of game\n";
   }
 }

sub rotate

 {
 s/   ${g3}OO $g3 OO/  O$1 OO$2 O / or # Z
 s/  O$g3 OO$g3 O /   $1OO $2 OO/ or
 s/   $g3 OO${g3}OO / O $1 OO$2  O/ or # S
 s/ O $g3 OO$g3  O/   $1 OO$2OO / or
 s/   ${g3}OOO${g3}O  /OO $1 O $2 O / or # L
 s/OO $g3 O $g3 O /   $1  O$2OOO/ or
 s/   $g3  O${g3}OOO/ O $1 O $2 OO/ or
 s/ O $g3 O $g3 OO/   $1OOO$2O  / or
 s/   ${g3}OOO$g3  O/ O $1 O $2OO / or # J
 s/ O $g3 O ${g3}OO /   $1O  $2OOO/ or
 s/   ${g3}O  ${g3}OOO/ OO$1 O $2 O / or
 s/ OO$g3 O $g3 O /   $1OOO$2  O/ or
 s/   $g3 O ${g3}OOO/ O $1 OO$2 O / or # T
 s/ O $g3 OO$g3 O /   $1OOO$2 O / or
 s/   ${g3}OOO$g3 O / O $1OO $2 O / or
 s/ O ${g3}OO $g3 O /   $1 O $2OOO/ or
 s/    $g4    $g4    ${g4}OOOO/ O  $1 O  $2 O  $3 O  / or # I
 s/ O  $g4 O  $g4 O  $g4 O  /    $1    $2    $3OOOO/ or
 s/O   ${g4}O   ${g4}O   ${g4}O   /    $1    $2    $3OOOO/ or
 s/   O$g4   O$g4   O$g4   O/    $1    $2    $3OOOO/
   for $well;
 }

sub step

 {
 if( $well =~ s/(?<=\|)#{$width}(?=\|)/ '=' x $width /e ) # full row?
   {
   transpose();
   $well =~ s/(.*)=/ $1/g; # remove full row
   transpose();
   }
 elsif( $well !~ /O/ ) # any O ?
   {
   add();
   }
 elsif( not down() ) # can't move down
   {
   $well =~ tr/O/#/; # convert to #
   }
 }

sub down

 {
 $well !~ /O/ || $well =~ /O$below[#-]/ and return 0;
 transpose();
 $well =~ s/(O+) / $1/g;
 transpose();
 return 1;
 }

sub drop { 1 while down() }

sub right { $well =~ /O[#|]/ or $well =~ s/(O+) / $1/g }

sub left { $well =~ /[#|]O/ or $well =~ s/ (O+)/$1 /g }

sub draw

 {
 addstr( 2, 0, ($well . "\n\n")  =~ s/^/' ' x 20 /gmer);
 my $row = 4;
 addstr( $row++, 10, $_ ) for @{ $shape{$piece} };
 addstr( 22, 0, ' ' );
 refresh;
 };

sub eventloop

 {
 while( 1 )
   {
   my $time = time;
   my $delta = $nexttime - $time;
   if( $delta <= 0 )
     {
     step();
     $nexttime = time + $delay;
     }
   else
     {
     draw();
     for ( $sel->can_read( $delta ) )
       {
       sysread *STDIN, $_, 1024;
       for ( /\e(?:\[M...|[O\[][0-9;]*[A-~])|./gs ) # keep esc seq together
         {
         /^(?:q|\e)\z/i ? die "quit\n" :
           /^(?:h|\e\[D)\z/ ? left() :
           /^(?:l|\e\[C)\z/ ? right() :
           /^(?:r|\e\[A)\z/ ? rotate() :
           /^(?:[j ]|\e\[B)\z/ ? drop() :
           0;
         }
       }
     }
   }
 }

$piece = (keys %shape)[rand keys %shape]; initscr(); clear; ReadMode 'cbreak'; eval { eventloop() }; my $errormsg = $@; ReadMode 'restore'; endwin(); print $errormsg;</lang>


Phix

See Tetris/Phix.

Python

See Python implementation of Tetris included with Raspbian