Foro - Perl en Español

por **Progra_GC** » 2012-03-26 11:09 @506

Hola..!
Soy nuevo en esto del foro, además un novato en Perl.

Mi pregunta es si me pueden ayudar un poco en mi proyecto que se trata de hacer un 4 en raya, obviamente en Perl.

He empezado a buscar ejemplos para ir aprendiendo. Igual cualquier ayuda se les agradece.

Bienvenido a los foros de Perl en Español, Progra_GC.

Claro que te ayudaremos.

Cuando te bloquees con algún código, publícalo por aquí y te daremos pistas de cómo solventarlo.

Lo primero que deberías aclarar es qué ámbito vas a desarrollar el programa: sistema operativo, versión de Perl, el programa se ejecutará solo en consola, o será gráfico, etc...

por **Progra_GC** » 2012-03-27 19:49 @868

He estado investigando pero aún me cuesta un poco este lenguaje.
Agradecería su ayuda, hasta el momento tengo este poco de código.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
 
print "\n  ---Cuatro  En  Línea--- \n \n";
 
my @matriz6= ( '6-',' ',' ',' ',' ',' ',' ',' ','F');
my @matriz5= ( '5-',' ',' ',' ',' ',' ',' ',' ','I');
my @matriz4= ( '4-',' ',' ',' ',' ',' ',' ',' ','L');
my @matriz3= ( '3-',' ',' ',' ',' ',' ',' ',' ','A');
my @matriz2= ( '2-',' ',' ',' ',' ',' ',' ',' ','S');
my @matriz=  ( '1-',' ',' ',' ',' ',' ',' ',' ',' ');
 
my @arr =    ("----------------------- ");
 
#////////////////////////////////////////////////////////////
 
my $string = join('][',@matriz);
my $string2= join('][',@matriz2);
my $string3= join('][',@matriz3);
my $string4= join('][',@matriz4);
my $string5= join('][',@matriz5);
my $string6= join('][',@matriz6);
 
#////////////////////////////////////////////////////////////
 
print "$string6 \n";
print "@arr \n";
print "$string5 \n";
print "@arr \n";
print "$string4 \n";
print "@arr \n";
print "$string3 \n";
print "@arr \n";
print "$string2 \n";
print "@arr \n";
print "$string \n";
print "  --1--2--3--4--5--6--7-- \n";
   print "\n";
 
print " Bienvenido al juego Cuatro en Línea \n";
 
print " Digite la posición que desea jugar \n";
 
$x = <STDIN>;
 
 
 
  if ( $x <= 7) {
             @matriz[$x]='X'; 
              
         }
 
print"\n";
#print @matriz2;
my $string= join('][',@matriz,);
 
print "$string6 \n";
print "@arr \n";
print "$string5 \n";
print "@arr \n";
print "$string4 \n";
print "@arr \n";
print "$string3 \n";
print "@arr \n";
print "$string2 \n";
print "@arr \n";
print "$string \n";
print "  --1--2--3--4--5--6--7-- \n"; 
print"\n";
 
Coloreado en 0.005 segundos,  usando GeSHi 1.0.8.4

Tal vez el código sea muy simple para lo que tengo que hacer, pero aún está en progreso.

por **explorer** » 2012-03-28 03:51 @202

Hay un "error" en la línea 48:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

             @matriz[$x]='X';
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Es mejor escribirlo como

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

             $matriz[$x] = 'X';
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

La razón es esta: el carácter que va delante del nombre de la variable (el sigilo) indica el tipo de dato que queremos obtener de ella o el que le vamos a asignar. Así, cuando ponemos una '@' quiere decir que estamos hablando de una lista de valores, mientras que si ponemos un '$', estamos hablando de un solo valor.

Es el mismo caso de @arr; solo contiene un valor: '----------------------- ', así que quizás sea mejor declarar y usarla así:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

my $arr = '----------------------- ';
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Piensa también que, cuando algo estás repitiendo muchas veces, es que seguro que se puede escribir de una forma más abreviada.

En este caso, si usaras una matriz bidimensional, te ahorrarías mucho código...

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

my @matriz = (
    [ '6-',' ',' ',' ',' ',' ',' ',' ','F'],
    [ '5-',' ',' ',' ',' ',' ',' ',' ','I'],
    [ '4-',' ',' ',' ',' ',' ',' ',' ','L'],
    [ '3-',' ',' ',' ',' ',' ',' ',' ','A'],
    [ '2-',' ',' ',' ',' ',' ',' ',' ','S'],
    [ '1-',' ',' ',' ',' ',' ',' ',' ',' '],
);
 
# Acceso a la línea 2, columna 4:
$matriz[6-2][4] = '*';              # Hay que hacer la resta porque numeras las líneas al revés
 
# Impresión de toda la tabla
for my $linea (@matriz) {
    print join('][', @{$linea}), "\n";    # Cada $linea es una referencia a un array, por lo que lo desreferenciamos
                                          # para tomar los valores de ese array
}
 
Coloreado en 0.002 segundos,  usando GeSHi 1.0.8.4

por **Progra_GC** » 2012-03-28 12:30 @563

Excelente, muchas gracias, por la diferencia entre '$' y '@'.

He cambiado el código, quedará de la siguiente manera.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
 
     my @matriz = (
    [ '6-',' ',' ',' ',' ',' ',' ',' ','F'],
    [ '5-',' ',' ',' ',' ',' ',' ',' ','I'],
    [ '4-',' ',' ',' ',' ',' ',' ',' ','L'],
    [ '3-',' ',' ',' ',' ',' ',' ',' ','A'],
    [ '2-',' ',' ',' ',' ',' ',' ',' ','S'],
    [ '1-',' ',' ',' ',' ',' ',' ',' ',' '],
);
 
 my $arr =    ("----------------------- ");
 
#////////////////////////////////////////////////////////////
 
print " Bienvenido al juego \n Cuatro en Linea \n";
for my $linea (@matriz) {
    print join('][', @{$linea}), "\n";
    print "$arr \n";
    }
print "  --1--2--3--4--5--6--7-- \n";
   print "\n";
#//////////////////////////////////////////////////////////////////////////////
 
print " Jugador 1 \n";
print " Digite la posición que desea jugar \n";
 
$x = <STDIN>;
 if ($x >=1 && $x <= 7) {  #verifica la posición
             $matriz[6-1][$x]='0';   }  # asigna la  'X'
 else {
    print "Digite Otra vez \n";
    print " Digite la posición que desea jugar \n";
    $x = <STDIN>;
 if ($x >=1 && $x <= 7) {
             $matriz[6-1][$x]='0';   }
                                       }
 print "\n";
 for my $linea (@matriz) {
    print join('][', @{$linea}), "\n";
    print "$arr \n";              #imprime línea cada salto de línea
    }
print "  --1--2--3--4--5--6--7-- \n";
   print "\n";
 
#///////////////////////////////////////////////////////////////////////////////
print "Jugador 2 \n";
print " Digite la posición que desea jugar \n";
 
$x = <STDIN>;
 if ($x >=1 && $x <= 7) {
             $matriz[6-1][$x]='*';   }
 else {
    print "Digite Otra vez \n";
    print " Digite la posición que desea jugar \n";
    $x = <STDIN>;
 if ($x >=1 && $x <= 7) {
             $matriz[6-1][$x]='*';   }
                                       }
print "\n";
 for my $linea (@matriz) {
    print join('][', @{$linea}), "\n";
    print "$arr \n";              #imprime línea cada salto de línea
    }
print "  --1--2--3--4--5--6--7-- \n";
   print "\n";
Coloreado en 0.003 segundos,  usando GeSHi 1.0.8.4

Pues bien, sé que esto no es todo; ahora trataré en que la matriz si la primera línea está llena ponga el símbolo en la línea 2, o en que el jugador2 ó jugadorPC no pueda sobreponer en la posición que ya está utilizada.

por **explorer** » 2012-03-28 19:52 @869

En CPAN hay una distribución llamada Games::ConnectFour, que es este mismo juego.

por **Progra_GC** » 2012-04-04 14:19 @638

El que me has recomendado, parece que está hecho con otro editor que genera varios archivos, pues bien he encontrado este para compartirlo con la comunidad...

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
package Games::ConnectFour;
our $VERSION = 0.012;
use strict;
use warnings;
if ( $^O eq "MSWin32" ) {
    system "color 07";
    require Win32::Console::ANSI;
}
use IO::Socket;
 
our %c = (
    d  => "\e[0;37;40m",
    b  => "\e[1;34;40m",
    0  => "\e[1;31;40m",
    1  => "\e[1;33;40m",
    w0 => "\e[0;30;41m",
    w1 => "\e[0;30;43m",
 
    save    => "\e[s",
    restore => "\e[u",
    clear   => "\e[0J",
);
 
sub input {
    my ( $message, $default, @accepted ) = @_;
    print $message;
    while (1) {
        ( my $in = <STDIN> ) =~ s/^\s+|\s+$//g;
        return $in if grep $in eq $_, @accepted or @accepted == 0;
        return $default if $in eq "" and defined $default;
        print "$c{d}Por favor introduce uno de los siguientes: ", join( ", ", @accepted ), ". ";
    }
}
 
init();
 
sub init {
    print "\n$c{d}Bienvenido al 4 en Linea!\n";
    print "Control-C para salir.\n\n";
    while (1) {
        my $play = input(
            "[1]: Jugar en la PC
2 : Internet play
3 : localhost (127.0.0.1) play
4 : Local play
", 1, 1 .. 4
        );
        my $c_number;
        my $g_number;
        my $server;
        my $player;
        my ( $connect, $w, $h );
        if ( $play > 1 ) {
            my $host = "nitrogen.mine.nu";
            my $port = 1262;
            $host = "localhost" if $play == 3;
            if ( $play == 4 ) {
                $host = input("Enter host address: ");
            }
 
            $server->autoflush(1);     # so output gets there right away
            chomp( $c_number = <$server> );
            print "Connected to $host on $port as client number $c_number.\n";
            chomp( $player = <$server> );
            $player++;
            chomp( $g_number = <$server> );
            print "Joined game number $g_number.\n";
            if ( $player == 1 ) {
                print "Awaiting another player...\n";
                <$server>;
            }
            else {
                print "Waiting for player 1 to set game settings...\n";
                ( $connect, $w, $h ) = split " ", <$server>;
                print "Settings are: connect:$connect; width:$w; height:$h.\n";
            }
        }
        if ( !$server or $player == 1 ) {
            $connect = input( "How many do you want to connect (3, [4], 5, 6)? ", 4, 3 .. 6 );
            ( $w, $h )
                = @{ ( [ 7, 6 ], [ 8, 7 ], [ 9, 7 ] )
                    [ input( "What size board do you want ([1], 2, 3, 4)? ", 1, 1 .. 4 ) - 1 ] };
            print $server join( " ", $connect, $w, $h ), "\n" if $server;
        }
        my $turn = 0;
        my @board = ( map [ (" ") x $w ], 1 .. $h );
        print "\n$c{b}";
        print "|", join( "|", @$_ ), "|\n" for @board;
        print "-" x ( $w * 2 + 1 ), "\n";
        print " ", join( " ", 1 .. $w ), "\n\n\n\e[1A";
        while (1) {
            my $in;
            if ( !fork ) {
                print "$c{$turn}Jugador " . ( $turn + 1 ) . ", Elija columna: ";
                exit;
            }
            else {
                wait;
                print $c{save};
                while (1) {
                    if ( !$server or $player - 1 == $turn ) {
                        ( $in = <STDIN> ) =~ s/^\s+|\s+$//g;
                        print "$c{restore}$c{clear}";
                        if ( grep $in eq $_, 1 .. $w and $board[0][ --$in ] eq " " ) {
                            print $server $in, "\n" if $server;
                            last;
                        }
                        else {
 
                            #play error sound
                        }
                    }
                    else {
                        chomp( $in = scalar <$server> );
                        last;
                    }
                }
            }
            my $up    = $h + 4 . "A";
            my $right = 1 + $in * 2 . "C";
            print "\r\e[$up\e[$right";
            my $row = -1;
            do {
                if (fork) {
                    $row++;
                    select undef, undef, undef, 0.04;
                    wait;
                }
                else {
                    print " \b";
                    print "\e[1B";
                    print "o\b";
                    exit;
                }
            } while $row + 1 < $h and $board[ $row + 1 ][$in] eq " ";
            $board[$row][$in] = $turn;
            print "$c{restore}\r";
            my @all;
            for ( [ 1, 0 ], [ 0, 1 ], [ 1, 1 ], [ -1, 1 ] ) {
                my ( $xdir, $ydir ) = @$_;
                my @mine = [ $in, $row ];
                for ( 1, -1 ) {
                    my ( $x, $y ) = ( $in, $row );
                    while ( ( $x -= $xdir * $_ ) >= 0
                        and $x < $w
                        and ( $y -= $ydir * $_ ) >= 0
                        and $y < $h
                        and $board[$y][$x] eq $turn ) {
                        push @mine, [ $x, $y ];
                    }
                }
                push @all, @mine if @mine >= $connect;
            }
            if (@all) {
                for (@all) {
                    my ( $x, $y ) = @$_;
                    my $up    = $h - $y + 3 . "A";
                    my $right = 1 + $x * 2 . "C";
                    print "\e[$up\e[$right";
                    print "$c{'w'.$turn}o$c{restore}\r";
                }
                print "$c{$turn}Player " . ( $turn + 1 ) . " wins!$c{clear}\n\n";
                print $c{d};
                print $server "end\n" if $server;
                last;
            }
            if ( not grep $_ eq " ", map @$_, @board ) {
                print "$c{d}The game is a tie!$c{clear}\n\n";
                last;
            }
            $turn = ( 0, 1 )[ $turn - 1 ];
        }
    }
}
 
Coloreado en 0.005 segundos,  usando GeSHi 1.0.8.4

Al igual lo estoy trabajando aparte para hacerlo que juegue contra la PC y solamente en la misma PC, no en línea o por sockets, porque no lo necesito.

Cualquier sugerencia o idea, ahí está la base en la que estoy trabajando.

por **explorer** » 2012-04-04 14:42 @654

Hummm... no me gusta mucho esto que has publicado...

Habría que poner al principio, que se trata de una variación de la versión 0.012 de Games::ConnectFour.

Es decir, aunque en la primera línea pone Games::ConnectFour, NO tiene relación con el archivo original.

No entiendo lo que dices de que genera varios archivos.

por **Progra_GC** » 2012-04-04 19:15 @843

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
use strict;
use warnings;
if ( $^O eq "MSWin32" ) {
    system "color 07";
    require Win32::Console::ANSI;
}
use IO::Socket;
 
our %c = (
    d  => "\e[0;37;40m",
    b  => "\e[1;34;40m",
    0  => "\e[1;31;40m",
    1  => "\e[1;33;40m",
    w0 => "\e[0;30;41m",
    w1 => "\e[0;30;43m",
 
    save    => "\e[s",
    restore => "\e[u",
    clear   => "\e[0J",
);
 
sub input {
    my ( $message, $default, @accepted ) = @_;
    print $message;
    while (1) {
        ( my $in = <STDIN> ) =~ s/^\s+|\s+$//g;
        return $in if grep $in eq $_, @accepted or @accepted == 0;
        return $default if $in eq "" and defined $default;
        print "$c{d}Por favor introduce uno de los siguientes: ", join( ", ", @accepted ), ". ";
    }
}
 
init();
 
sub init {
    print "\n$c{d}Bienvenido al 4 en Linea!\n";
    print "Control-C para salir.\n\n";
    while (1) {
        my $play = input(
            "[1]: Jugar en la PC
2 : Internet play
3 : localhost (127.0.0.1) play
4 : Local play
", 1, 1 .. 4
        );
        my $c_number;
        my $g_number;
        my $server;
        my $player;
        my ( $connect, $w, $h );
        if ( $play > 1 ) {
            my $host = "nitrogen.mine.nu";
            my $port = 1262;
            $host = "localhost" if $play == 3;
            if ( $play == 4 ) {
                $host = input("Enter host address: ");
            }
 
            $server->autoflush(1);     # so output gets there right away
            chomp( $c_number = <$server> );
            print "Connected to $host on $port as client number $c_number.\n";
            chomp( $player = <$server> );
            $player++;
            chomp( $g_number = <$server> );
            print "Joined game number $g_number.\n";
            if ( $player == 1 ) {
                print "Awaiting another player...\n";
                <$server>;
            }
            else {
                print "Waiting for player 1 to set game settings...\n";
                ( $connect, $w, $h ) = split " ", <$server>;
                print "Settings are: connect:$connect; width:$w; height:$h.\n";
            }
        }
        if ( !$server or $player == 1 ) {
            $connect = input( "Cuantos desea conectar (3, [4], 5, 6)? ", 4, 3 .. 6 );
            ( $w, $h )
                = @{ ( [ 7, 6 ], [ 8, 7 ], [ 9, 7 ] )
                    [ input( "Tamaño del tablero ([1], 2, 3, 4)? ", 1, 1 .. 4 ) - 1 ] };
            print $server join( " ", $connect, $w, $h ), "\n" if $server;
        }
        my $turn = 0;
        my @board = ( map [ (" ") x $w ], 1 .. $h );#pinta la matriz
        print "\n$c{b}";
        print "|", join( "|", @$_ ), "|\n" for @board;
        print "-" x ( $w * 2 + 1 ), "\n";
        print " ", join( " ", 1 .. $w ), "\n\n\n\e[1A";
        while (1) {
            my $in;
            if ( !fork ) {
                print "$c{$turn}Jugador " . ( $turn + 1 ) . ", Elija columna: ";
                exit;
            }
            else {
                wait;
                print $c{save};
                while (1) {
                    if ( !$server or $player - 1 == $turn ) {
                        ( $in = <STDIN> ) =~ s/^\s+|\s+$//g;
                        print "$c{restore}$c{clear}";
                        if ( grep $in eq $_, 1 .. $w and $board[0][ --$in ] eq " " ) {
                            print $server $in, "\n" if $server;
                            last;
                        }
                        else {
 
                            #play error sound
                        }
                    }
                    else {
                        chomp( $in = scalar <$server> );
                        last;
                    }
                }
            }
            my $up    = $h + 4 . "A";
            my $right = 1 + $in * 2 . "C";
            print "\r\e[$up\e[$right";
            my $row = -1;
            do {
                if (fork) {
                    $row++;
                    select undef, undef, undef, 0.04;
                    wait;
                }
                else {
                    print " \b";
                    print "\e[1B";
                    print "o\b";
                    exit;
                }
            } while $row + 1 < $h and $board[ $row + 1 ][$in] eq " ";
            $board[$row][$in] = $turn;
            print "$c{restore}\r";
            my @all;
            for ( [ 1, 0 ], [ 0, 1 ], [ 1, 1 ], [ -1, 1 ] ) {
                my ( $xdir, $ydir ) = @$_;
                my @mine = [ $in, $row ];
                for ( 1, -1 ) {
                    my ( $x, $y ) = ( $in, $row );
                    while ( ( $x -= $xdir * $_ ) >= 0
                        and $x < $w
                        and ( $y -= $ydir * $_ ) >= 0
                        and $y < $h
                        and $board[$y][$x] eq $turn ) {
                        push @mine, [ $x, $y ];
                    }
                }
                push @all, @mine if @mine >= $connect;
            }
            if (@all) {
                for (@all) {
                    my ( $x, $y ) = @$_;
                    my $up    = $h - $y + 3 . "A";
                    my $right = 1 + $x * 2 . "C";
                    print "\e[$up\e[$right";
                    print "$c{'w'.$turn}o$c{restore}\r";
                }
                print "$c{$turn}Jugador " . ( $turn + 1 ) . " ha ganado.!$c{clear}\n\n";
                print $c{d};
                print $server "end\n" if $server;
                last;
            }
            if ( not grep $_ eq " ", map @$_, @board ) {
                print "$c{d}El juego esta empate.!$c{clear}\n\n";
                last;
            }
            $turn = ( 0, 1 )[ $turn - 1 ];
        }
    }
}
Coloreado en 0.005 segundos,  usando GeSHi 1.0.8.4

Esto es lo que tengo, el que tiene varios archivos y no me funciona del todo bien es el ejemplo de CPAN.

por **explorer** » 2012-04-04 19:27 @852

La línea 170 se puede simplificar un poco más:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

            $turn = ( 1, 0 )[ $turn ];
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

Sigo sin ver los problemas del ejemplo. De hecho, aún no sé de qué ejemplo estás hablando, porque en la página de Games::ConnectFour no viene ninguno, solo la forma de arrancarlo.

De todas maneras, como sigues con tu proyecto, da igual.

Foro - Perl en Español

Ayuda para proyecto 4 en raya

Ayuda para proyecto 4 en raya

Publicidad

Re: Ayuda para proyecto 4 en raya

Re: Ayuda para proyecto 4 en raya

Re: Ayuda para proyecto 4 en raya

Re: Ayuda para proyecto 4 en raya

Re: Ayuda para proyecto 4 en raya

Re: Ayuda para proyecto 4 en raya

Re: Ayuda para proyecto 4 en raya

Re: Ayuda para proyecto 4 en raya

Re: Ayuda para proyecto 4 en raya

¿Quién está conectado?