Pascal: Tres en raya

Juego de 3 en raya (TicTacToe) en modo consola con Pascal

Lenguaje: Pascal (compilador: FreePascal 2.4)

Categoría: Minijuegos

(* Fuente procedente de ErrorDeSintaxis.es *)

(* Juego de 3 en raya (TicTacToe) en modo consola *)

(*  con Pascal *)

(* Lenguaje: Pascal *)

(* Compilador: FreePascal 2.4 *)

(* Nivel: Básico *)

(* Disponible desde 04/03/2012 *)

(* Aportado por Nacho *)

(* Autor original: Nacho Cabanes *)

(* Web original: http://www.aprendeaprogramar.com/mod/forum/discuss.php?d=610 *)

(* Tres en raya basico en consola, por Nacho*)
 
program TresEnRaya1;
 
const
    (* Simbolos del tablero: blanco, jug.1, jug.2*)
    simbolo: array [0..2] of char  = (' ', 'O', 'X');
 
 
var
    tablero: array[1..3, 1..3] of integer; (* Tablero de juego*)
    terminado: boolean;
 
 
procedure DibujarTablero;
var
    fila, columna: integer;
begin
    WriteLn;
    WriteLn('-------------');
    for fila := 1 to 3 do
    begin
        Write('|');
        for columna := 1 to 3 do
            Write(' '+simbolo[tablero[fila,columna]]+' |');
        WriteLn;
        WriteLn('-------------');
    end
end;
 
 
(* ----- Pregunta donde mover y lo anota en el tablero ----- *)
procedure PreguntarPosicion( jugador: integer );  (* 1 := Jug.1, 2= Jug.2*)
var 
    fila, columna: integer;
begin   
    repeat
        WriteLn;
 
        (* Pido fila*)
        repeat
            Write('En que fila (1 a 3) ');
            ReadLn(fila);
        until fila in [1..3];
 
        (* Pido columna*)
        repeat
            Write('En que columna (1 a 3) ');
            ReadLn(columna);
        until columna in [1..3];
 
        if (tablero[fila,columna] <> 0) then
            WriteLn('Casilla ocupada!');
 
    until (tablero[fila,columna] = 0);
 
    (* Si todo es correcto, se la asigno*)
    tablero[fila,columna] := jugador;
end;
 
 
(* ----- Devuelve "true" si hay tres en raya ----- *)
function ComprobarGanador: boolean;
var
    hay3enRaya: boolean;
    fila, columna: integer;
begin
    hay3enRaya := false;
 
    (* Si en alguna fila todas las casillas son iguales y no vacías*)
    for fila := 1 to 3 do
        if ((tablero[fila, 1] = tablero[fila, 2]) 
                and (tablero[fila, 1] = tablero[fila, 3])
                and (tablero[fila, 1] <> 0))  then
            hay3enRaya := true;
 
    (* Lo mismo para las columnas*)
    for columna := 1 to 3 do
        if ((tablero[1,columna] = tablero[2,columna])
                and (tablero[1,columna] = tablero[3,columna])
                and (tablero[1,columna] <> 0))  then
            hay3enRaya := true;
 
    (* Y finalmente miro las dos diagonales*)
    if ((tablero[1, 1] = tablero[2, 2])
            and (tablero[1, 1] = tablero[3, 3])
            and (tablero[1, 1] <> 0))  then
        hay3enRaya := true;
    if ((tablero[1, 3] = tablero[2, 2])  
            and (tablero[1, 3] = tablero[3, 1])
            and (tablero[1, 3] <> 0))  then
        hay3enRaya := true;
 
    ComprobarGanador := hay3enRaya;
end;
 
 
(* ----- Devuelve "true" si hay empate ----- *)
function ComprobarEmpate: boolean;
var
    algunHueco: boolean;
    fila, columna: integer;
begin
    (* Si no quedan huecos donde mover, es empate*)
    algunHueco := false;
 
    for fila := 1 to 3 do
        for columna := 1 to 3 do
            if(tablero[fila,columna] = 0) then
                algunHueco := true;        
 
    ComprobarEmpate := not algunHueco;
end;
 
 
    (* ----- Cuerpo del programa ----- *)
 
 
begin
 
    begin
        terminado := false;
 
        (* Dibujar el tablero inicial*)
        DibujarTablero;
        repeat            
            (* Pedir al jugador 1*)
            PreguntarPosicion( 1 );
            (* Dibujar la casilla del jugador 1*)
            DibujarTablero;
            (* Comprobar si ha terminado la partida*)
            terminado := ComprobarGanador;
            if terminado then
                WriteLn('Gana jugador 1')
            else
                begin
                    terminado := ComprobarEmpate;
                    if terminado then
                        WriteLn('Empate!')
                    else
                    begin
                        (* Pedir al jugador 2*)
                        PreguntarPosicion( 2 );
                        (* Dibujar la casilla del jugador 2*)
                        DibujarTablero;
                        (* Comprobar si ha terminado la partida*)
                        terminado := ComprobarGanador;
                        if terminado then
                            WriteLn('Gana jugador 2');                
                    end
            end
        (* Repetir hasta 3 en raya o empate (tablero lleno)*)
        until terminado;
    end
 
end.
 

 
Resultado:

-------------
|   |   |   |
-------------
|   |   |   |
-------------
|   |   |   |
-------------

En que fila (1 a 3) 2
En que columna (1 a 3) 2

-------------
|   |   |   |
-------------
|   | O |   |
-------------
|   |   |   |
-------------

En que fila (1 a 3) 1
En que columna (1 a 3) 3

-------------
|   |   | X |
-------------
|   | O |   |
-------------
|   |   |   |
-------------

En que fila (1 a 3) 1
En que columna (1 a 3) 2

-------------
|   | O | X |
-------------
|   | O |   |
-------------
|   |   |   |
-------------

En que fila (1 a 3) 3
En que columna (1 a 3) 1

-------------
|   | O | X |
-------------
|   | O |   |
-------------
| X |   |   |
-------------

En que fila (1 a 3) 3
En que columna (1 a 3) 2

-------------
|   | O | X |
-------------
|   | O |   |
-------------
| X | O |   |
-------------
Gana jugador 1