Juego de xo turbo pascal

En este ejemplo de turbo pascal mostrare un ejemplo interesante que encontré del el clásico juego de xo.
me imagino que lo conocen pero por si acaso aquí un poco de información del mismo:


El XO es un juego de estrategia para dos personas, cuyo objetivo es el exterminio total del enemigo que intentará por todos los medios exterminarte. La duración de la partida es de, aproximadamente, 1 hora y requiera altas dosis de concentración e inteligencia. De reglas sencillas le hace un juego ameno y entretenido.

Mas información:wiki


El cual se juega poniendo una x y un 0
quien logre poner tres símbolos
consecutivos en manera de fila gana

aqui el codigo:

program appletenhtml(input, output);

uses

 Crt;

const



 {teclas}

 ARRIBA = #72;

 ABAJO = #80;

 IZQUIERDA = #75;

 DERECHA = #77;

 ESC = #27;

 INTRO = #13;

 REINICIAR = 'R';



 {colores}

 fondo_tablero = white;

 ficha_uno = red;

 ficha_dos = blue;

 barras_tablero = green;

 c_ronda = white;

 instrucciones = 3;

 copyright = 2;



 {fichas}

 ficha_1 = 'X';

 ficha_2 = 'O';



 {coordenadas}

 CE = 62; {estadisticas X}

 CR = 1; {ronda Y}

 CJ1 = 2; {jugador 1 Y}

 CJ2 = 3; {jugador 2 Y}

 CTX = 20; {turno X}

 CTY = 1; {turno Y}

 CX = 30; {tabla X}

 CY = 6; {tabla Y}

 JGX = 8; {jugador ha ganado X}

 JGY = 12; {jugador ha ganado Y}





type

 Ttabla = array[1..3, 1..3] of Byte;

 Tceldas = array[0..9] of Byte;

 Cceldas = set of Byte;

var

 tecla: char;

 tabla: Ttabla;

 CursorI, CursorJ: Byte;

 FichaI, FichaJ: Byte;

 jugador: boolean;

 victorias_1, victorias_2: Byte;

 poner: boolean;

 ronda: Byte;

 ganador: Byte;

 empieza: boolean;

 bot: boolean;

 comprobar: boolean;



procedure escribir_tabla;

 var

  i, j: Byte;



 procedure posicion_tabla_X(pos: Byte);

  var i: Byte;

  begin

   for i := 1 to pos do

    write(' ');

  end;



 begin

  Textbackground(7);

  TextColor(black);

  write(' Turno del jugador ');

  Textbackground(black);

  TextColor(c_ronda);

  writeln('                                  Ronda: ');

  TextColor(red);

  writeln('                                        Victorias jugador 1: ');

  TextColor(blue);

  writeln('                                        Victorias jugador 2: ');

  TextColor(7);

  writeln;

  writeln;



  posicion_tabla_X(CX);

  TextColor(barras_tablero);

  Textbackground(fondo_tablero);

  writeln(' --- ');

  for i := 1 to 3 do begin

   Textbackground(black);

   posicion_tabla_X(CX);

   Textbackground(fondo_tablero);

   write('|');

   for j := 1 to 3 do

    write(' ');

   writeln('|');

  end;

  Textbackground(black);



  posicion_tabla_X(CX);

  Textbackground(fondo_tablero);

  writeln(' --- ');

  Textbackground(black);

  writeln;

  writeln;

  writeln;

  writeln;

  TextColor(instrucciones);

  writeln('Teclado:');

  writeln('     Flechas: Te ayudan a moverte por el tablero');

  writeln('     Intro: Introduce una nueva ficha (o quita si el jugador tiene ya 3)');

  writeln('     R: Reiniciar');

  writeln('     Escape: Salir');

  writeln;

  writeln;

  TextColor(copyright);

  write('                                                         echo por   JoniJnm ',chr(184),' 2009');

 end;



procedure modificar_tabla(CursorI, CursorJ: Byte; tabla: Ttabla; ronda: Byte; jugador: boolean);

 var

  i, j: Byte;

 begin

  gotoxy(CTX, CTY);

  Textbackground(7);

  if (jugador) then begin

   TextColor(blue);

   write('2');

  end

  else begin

   TextColor(red);

   write('1');

  end;



  Textbackground(black);

  TextColor(c_ronda);

  gotoxy(CE, CR);

  write(ronda, ' ');



  gotoxy(CE, CJ1);

  TextColor(red);

  write(victorias_1);



  gotoxy(CE, CJ2);

  TextColor(blue);

  write(victorias_2);



  Textbackground(fondo_tablero);

  for i := 1 to 3 do

   for j := 1 to 3 do begin

    gotoxy(CX+1 + j, CY + i);

    if (i = CursorI) and (j = CursorJ) then

     Textbackground(green);



    if (tabla[i][j] = 1) then begin

     TextColor(ficha_uno);

     write(ficha_1);

     end

    else if (tabla[i][j] = 2) then begin

     TextColor(ficha_dos);

     write(ficha_2);

     end

    else

     write(' ');

    Textbackground(fondo_tablero);

    TextColor(7);

   end;

  Textbackground(black);

 gotoxy(1, 25);

end;



function modo_de_juego: boolean;

 var

  c: char;

 begin

  clrscr;

  gotoxy(15, 7);

  write('Elige modo de juego');

  gotoxy(20, 9);

  write('a) Un jugador');

  gotoxy(20, 10);

  write('b) Dos jugadores');

  repeat begin

   gotoxy(1, 11);

   clreol;

   read(c);

   c := upcase(c);

  end;

  until (c = 'A') or (c = 'B');

  if (c = 'A') then

   modo_de_juego := true

  else

   modo_de_juego := false;

  clrscr;

 end;



function m(i, j: Byte): Byte;

 begin

  m := i*10+j;

 end;



function celda(v: Byte; b: boolean): Byte;

 begin

  if (b) and (v <> 3) then

   celda := 3

  else if (not(b)) and (v <> 1) then

   celda := 1

  else

   celda := 2;

 end;



procedure rellena(tabla: Ttabla; var c: Tceldas; i, j: Byte);



 begin

  c[0] := tabla[celda(i, false), celda(j, true)];

  c[1] := tabla[i, j];

  c[2] := tabla[i, celda(j, false)];

  c[3] := tabla[i, celda(j, true)];

  c[4] := tabla[celda(i, false), j];

  c[5] := tabla[celda(i, true), j];

  c[6] := celda(i, false);

  c[6] := tabla[c[6], c[6]];

  c[7] := celda(i, true);

  c[7] := tabla[c[7], c[7]];

  c[8] := tabla[celda(i, false), celda(j, true)];

  c[9] := tabla[celda(i, true), celda(j, false)];

 end;





function check(tabla: Ttabla; jugador: Byte; i, j: Byte): boolean;

 var

  c: Tceldas;

 begin

  if (tabla[i, j] = jugador) then

   tabla[i, j] := 0;



  rellena(tabla, c, i, j);



  check :=



   (((c[1] = 0) and (((c[2] = c[3]) and (c[2] = jugador)) or ((c[4] = c[5]) and (c[4] = jugador)))) or



   ((tabla[i, j] = 0)  and (((i = 2) and (j = 2)) or (abs(i-j)=2))

    and (c[8] = c[9])

    and (c[0] = jugador)) or



   ((i = j) and (tabla[i, i] = 0) and (c[6] = c[7]) and (c[6] = jugador)));

 end;



function fichas_en_tablero(tabla: Ttabla): Byte;

 var

  i, j: Byte;

  aux: byte;

 begin

  aux := 0;

  for i := 1 to 3 do

   for j := 1 to 3 do

    if (tabla[i, j] <> 0) then

     aux := aux + 1;



  fichas_en_tablero := aux;

 end;



procedure bot_hace_con(tabla: Ttabla; var a1, b1: Byte; a2, b2: Byte; tipo: Byte);

 (*

  Case tipo of salida: a1, b1 - entradas: a1-b1, a2-b2      ficha_b|jugador

   1: Buscar celda vacia que haga que el j1 gane (activar entrada2 a 1)  0|1

   2: Buscar celda del j2 que hace ganar (activar entrada2 a 2)    2|2

   3: Buscar celda del j2 que no sea ninguna de las entradas     2|2

 *)

 var

  i, j: Byte;

  encontrado: boolean;

  ficha_b, jugador: Byte;

  celdas: Cceldas;



 begin

  if (tipo = 1) then begin

   ficha_b := 0;

   jugador := 1;

  end

  else begin

   if (tipo = 3) then

    celdas := [m(a1, b1), m(a2, b2)];

   ficha_b := 2;

   jugador := 2;

  end;



  if (tipo <> 3) then

   tabla[a2, b2] := jugador;

  a1 := 0;

  encontrado := false;

  i := 1;

  while (not encontrado) and (i <= 3) do begin

   j := 1;

   while (not encontrado) and (j <= 3) do begin

    if (tabla[i, j] = ficha_b)

      and ((tipo = 1) and (check(tabla, jugador, i, j)))

      or ((tipo = 2) and (check(tabla, jugador, i, j)))

      or ((tipo = 3) and (not(m(i, j) in celdas))) then  begin

     encontrado := true;

     a1 := i;

     b1 := j;

    end;

    j := j + 1;

   end;

   i := i + 1;

  end;

 end;



procedure bot_aleatorio(tabla: Ttabla; var CursorI: Byte; var CursorJ: Byte; celdas: Cceldas);

 var

  i, j: Byte;

  aux, aux2: Byte;

  opciones: Tceldas;



 begin

  aux2 := 0;

  for i := 1 to 3 do

   for j := 1 to 3 do begin

    aux := m(i, j);

    if (tabla[i, j] = 0) and (not(aux in celdas)) then begin

     opciones[aux2] := aux;

     aux2 := aux2 + 1;

    end;

   end;



  aux := opciones[random(aux2)];



  CursorI := aux div 10;

  CursorJ := aux mod 10;

 end;



procedure bot_check(tabla: Ttabla; jugador: Byte; var a: Byte; var b: Byte; celdas: Cceldas);

 var

  i, j: Byte;

 begin

  a := 0;

  i := 1;

  while (a = 0) and (i <= 3) do begin

   j := 1;

   while (a = 0) and (j <= 3) do begin

    if (not(m(i, j) in celdas)) and (check(tabla, jugador, i, j)) then begin

     a := i;

     b := j;

    end;

    j := j + 1;

   end;

   i := i + 1;

  end;

 end;



procedure bot_conjunto(tabla: Ttabla; a, b: Byte; var CursorI, CursorJ: Byte);

 var

  c: Tceldas;

  celdas: Cceldas;

  modificado: boolean;

  i, j, aux: Byte;

 begin

  rellena(tabla, c, a, b);

  modificado := false;



  if (c[1] = 0) and (c[2] = c[3]) and (c[2] = 2) then

   celdas := [m(a, celda(b, false)), m(a, celda(b, true))]

  else if (c[1] = 0) and (c[4] = c[5]) and (c[4] = 2) then

   celdas := [m(celda(a, false), b), m(celda(a, true), b)]

  else if (tabla[a, b] = 0) and (((a = 2) and (b = 2)) or (abs(a-b)=2)) then

   celdas :=  [m(celda(a, false), celda(b, true)), m(celda(a, true), celda(b, false))]

  else

   celdas := [m(celda(a, false), celda(a, false)), m(celda(a, true), celda(a, true))];



  i := 1;

  while (not modificado) do begin

   j := 1;

   while (not modificado) and (j <= 3) do begin

    if (tabla[i, j] = 2) then begin

     aux := m(i, j);

     if not(aux in celdas) then begin

      modificado := true;

      CursorI := i;

      CursorJ := j;

     end;

    end;

    j := j + 1;

   end;

   i := i + 1;

  end;

 end;



procedure bot_anticipa_f(tabla: Ttabla; i, j, jugador: Byte; celdas: Cceldas;

      var a1, b1, a2, b2: Byte; dos: boolean);

 begin

  a1 := 0;

  tabla[i, j] := jugador;

  bot_check(tabla, jugador, a1, b1, celdas);

  if (dos) and (check(tabla, jugador, a1, b1)) then begin

   celdas := celdas + [m(a1, b1)];

   bot_check(tabla, jugador, a2, b2, celdas);

   if (not check(tabla, jugador, a2, b2)) then

    a1 := 0;

  end

  else if (not dos) and (not check(tabla, jugador, a1, b1)) then

   a1 := 0;

 end;



function bot_anticipa_b(tabla: Ttabla; i, j: byte; jugador: Byte; celdas: Cceldas; dos: boolean): boolean;

 var

  a1, b1, a2, b2: Byte;

 begin

  bot_anticipa_f(tabla, i, j, jugador, celdas, a1, b1, a2, b2, dos);

  bot_anticipa_b := (a1 <> 0);

 end;



procedure bot_anticipa_p(tabla: Ttabla; jugador: Byte; var a, b: Byte; celdas: Cceldas; dos: boolean);

 var

  i, j: Byte;

  encontrado: boolean;

  a1, b1, a2, b2: Byte;

 begin

  encontrado := false;

  a := 0;

  i := 1;

  while (not encontrado) and (i <= 3) do begin

   j := 1;

   while (not encontrado) and (j <= 3) do begin

    if (tabla[i, j] = 0) and (not(m(i, j) in celdas)) then begin

     bot_anticipa_f(tabla, i, j, jugador, celdas, a1, a2, b1, b2, dos);

     if (a1 <> 0) then begin

      encontrado := true;

      a := i;

      b := j;

     end;

    end;

    j := j + 1;

   end;

   i := i + 1;

  end;

 end;



procedure bot_anticipa_q(tabla: Ttabla; var a, b: Byte);

 var

  i, j: Byte;

  encontrado: boolean;

  a1, b1, a2, b2: Byte;

 begin

  encontrado := false;

  a := 0;

  i := 1;

  while (not encontrado) and (i <= 3) do begin

   j := 1;

   while (not encontrado) and (j <= 3) do begin

    if (tabla[i, j] = 0) then begin

     bot_anticipa_f(tabla, i, j, 2, [], a1, b1, a2, b2, true);

     if (a1 <> 0) then begin

      bot_hace_con(tabla, a, b, a1, b1, 2);

      bot_hace_con(tabla, a1, b1, a2, b2, 2);

      bot_hace_con(tabla, a, b, a2, b2, 3);

      if check(tabla, 1, a, b) then

       a := 0;

     end;

    end;

    j := j + 1;

   end;

   i := i + 1;

  end;

 end;



procedure bot_quitar(tabla: Ttabla; var a, b: Byte);

 var

  i, j: Byte;

  aux: Byte;

  aux1, aux2, aux3: boolean;

 procedure rellenar(var a, b: Byte; var aux: Byte; i, j: Byte; r: Byte);

  begin

   a := i;

   b := j;

   aux := r;

  end;

 begin

  a := 0;

  aux := 0;

  i := 1;

  while (aux = 0) and (i <= 3) do begin

   j := 1;

   while (aux = 0) and (j <= 3) do begin

    if (tabla[i, j] = 2) then begin

     tabla[i, j] := 0;

     aux1 := (not check(tabla, 1, i, j));

     aux2 := (not bot_anticipa_b(tabla, i, j, 1, [], true));

     aux3 := (not bot_anticipa_b(tabla, i, j, 1, [], false));



     if (aux1) and (aux2) and (aux3) then

      rellenar(a, b, aux, i, j, 3)

     else if (aux < 2) and (aux1) and (aux2) then

      rellenar(a, b, aux, i, j, 2)

     else if (aux < 1) and (aux1) then

      rellenar(a, b, aux, i, j, 1)

     else if (a = 0) then

      rellenar(a, b, aux, i, j, 0);



     tabla[i, j] := 2;

    end;

    j := j + 1;

   end;

   i := i + 1;

  end;

 end;



procedure anticipar_n(tabla: Ttabla; var CursorI, CursorJ: Byte; celdas: Cceldas; var modificado: boolean; n: boolean);

 var

  a, b, a2, b2: Byte;

 begin

  a2 := 0;

  bot_anticipa_p(tabla, 2, a, b, celdas, n);

  if (a = 0) then begin

   if (n) and (a2 = 0) then

    bot_anticipa_p(tabla, 2, a2, b2, [], n);

   bot_anticipa_p(tabla, 1, a, b, celdas, n);

  end;

  if (a <> 0) then begin

   modificado := true;

   CursorI := a;

   CursorJ := b;

  end

  else if (n) and (a2 <> 0) then begin

   modificado := true;

   tabla[a2, b2] := 2;

   bot_hace_con(tabla, CursorI, CursorJ, a2, b2, 1);

  end;

 end;



procedure bot_centro_o_esquina(tabla: Ttabla; var a, b: Byte; var modificado: boolean; fichas: Byte);

 var

  celdas: Tceldas;

  i, j, c: Byte;

  tipo: Byte;



 procedure post_del_j1(tabla: Ttabla; var a, b: Byte);

  var

   i, j: Byte;

  begin

   a := 0;

   i := 1;

   while (a = 0) and (i <= 3) do begin

    j := 1;

    while (a = 0) and (j <= 3) do begin

     if (tabla[i, j] = 1) then begin

      a := i;

      b := j;

     end;

     j := j + 1;

    end;

    i := i + 1;

   end;

  end;



 begin

  (*

   case tipo of

    1: En una esquina

    2: En un lado

    3: En el centro

    4: No puesto

  *)

  modificado := true;

  c := 0;

  tipo := 0;

  if (fichas = 1) then begin

   post_del_j1(tabla, a, b);

   if (abs(a-b) = 2) or ((a = b) and (a <> 2)) then begin {en esquina}

    tipo := 1;

    if (a = 1) then begin

     if (b = 1) then

      c := m(3, 3)

     else

      c := m(3, 1);

    end

    else begin

     if (b = 1) then

      c := m(1, 3)

     else

      c := m(1, 1);

    end;

   end

   else if (abs(a-b) = 1) then {un lado}

    tipo := 2;

  end;



  if (tipo = 0) then {centro y no puesto}

   for i := 1 to 3 do

    for j := 1 to 3 do

     if (tabla[i, j] = 0) and ((abs(i-j) = 2) or ((i = j) and (i <> 2))) then begin

      celdas[c] := m(i, j);

      c := c + 1;

     end;



  if ((random(2) = 1) or (tipo = 2)) and (tabla[2, 2] = 0) then begin {poner en centro}

   a := 2;

   b := 2;

  end

  else begin {poner en esquina}

   if (tipo <> 1) then

    c := celdas[random(c)];

   a := c div 10;

   b := c mod 10;

  end;

 end;



procedure bot_f(tabla: Ttabla; poner: boolean; var CursorI: Byte; var CursorJ: Byte; celdas: Cceldas);

 var

  a, b: Byte;

  modificado: boolean;

  aux: Byte;

 begin



  modificado := false;

  if (poner) then begin

   {anticipar 1 movimiento}

   bot_check(tabla, 2, a, b, celdas);

   if a = 0 then

    bot_check(tabla, 1, a, b, celdas);

   if a <> 0 then begin

    modificado := true;

    CursorI := a;

    CursorJ := b;

   end

   else {anticipar 2 movimientos}

    anticipar_n(tabla, CursorI, CursorJ, celdas, modificado, true);

   if (not modificado) then begin {anticipar 3 movimientos}

    aux := fichas_en_tablero(tabla);

    if (aux < 2) then

     bot_centro_o_esquina(tabla, CursorI, CursorJ, modificado, aux)

    else

     anticipar_n(tabla, CursorI, CursorJ, celdas, modificado, false);

   end;



   if (not modificado) then

    bot_aleatorio(tabla, CursorI, CursorJ, celdas);

  end

  else begin



   {hay una celda para que el j2 gane en 1 paso}

   bot_check(tabla, 2, a, b, []);

   if (a <> 0) then begin

    bot_conjunto(tabla, a, b, CursorI, CursorJ);

    modificado := true;

   end

   else begin

    {hay una celda para que el jugador 1 gane en 1 paso...}

    {buscar ficha para quitar que no haga que el j1 gane con 1 ni con 2 pasos}



    bot_anticipa_q(tabla, a, b);

    if (a <> 0) then begin

     modificado := true;

     CursorI := a;

     CursorJ := b;

    end

    else

     bot_quitar(tabla, CursorI, CursorJ);



   end; {1 paso directo}

  end; {poner}

 end; {subprograma}



procedure accion(var jugador: boolean; var poner: boolean; CursorI, CursorJ: Byte; var tabla: Ttabla; var ronda:Byte;

   var FichaI: Byte; var FichaJ: Byte);

 var

  v_jugador_celda: Byte;

 begin

  if (((FichaI <> CursorI) or (FichaJ <> CursorJ))) and (poner) and (tabla[CursorI, CursorJ] = 0) then begin

   if (jugador) then

    tabla[CursorI, CursorJ] := 2

   else

    tabla[CursorI, CursorJ] := 1;



   if (jugador <> empieza) then

    ronda := ronda + 1;

   if (ronda > 3) then

    poner := false;

   jugador := (not(jugador));



   end

  else if (not(poner)) then begin

   if (jugador) then

    v_jugador_celda := 2

   else

    v_jugador_celda := 1;

   if (tabla[CursorI, CursorJ] = v_jugador_celda) then begin

    FichaI := CursorI;

    FichaJ := CursorJ;

    tabla[CursorI, CursorJ] := 0;

    poner := true;

   end;

  end;

 end;



function comprobar_ganador(tabla: Ttabla): Byte;

 var

  i, j: Byte;

  aux, tmp: Byte;

 begin

  aux := 0;

  i := 1;

  while (aux = 0) and (i <= 3) do begin

   j := 1;

   while (aux = 0) and (j <= 3) do begin

    tmp := tabla[i, j];

    if (tmp <> 0) and (check(tabla, tmp, i, j)) then

     aux := tmp;

    tabla[i, j] := tmp;

    j := j + 1;

   end;

   i := i + 1;

  end;

  comprobar_ganador := aux;

 end;



procedure iniciar(var tabla: Ttabla; var FichaI, FichaJ, CursorI, CursorJ, ronda: Byte;

     var poner, empieza: boolean; jugador: boolean);

 var

  i, j: Byte;

 begin

  FichaI := 0;

  FichaJ := 0;

  CursorI := 2;

  CursorJ := 2;

  ronda := 1;

  poner := true;

  empieza := jugador;

  for i := 1 to 3 do

    for j := 1 to 3 do

     tabla[i][j] := 0;

 end;



begin

 randomize;



 bot := modo_de_juego;

 jugador := false;

 iniciar(tabla, FichaI, FichaJ, CursorI, CursorJ, ronda, poner, empieza, jugador);

 victorias_1 := 0;

 victorias_2 := 0;



 escribir_tabla;



 modificar_tabla(CursorI, CursorJ, tabla, ronda, jugador);



 repeat begin



  if (bot) and (jugador) then

   bot_f(tabla, poner, CursorI, CursorJ, [FichaI*10 + FichaJ])

  else begin

   tecla := readkey;

   if (tecla = #0) then

    tecla := readkey;

  end;



  if ((bot) and (jugador)) or (tecla = INTRO) then begin

   comprobar := poner;

   accion(jugador, poner, CursorI, CursorJ, tabla, ronda, FichaI, FichaJ);

   if (comprobar) then begin

    ganador := comprobar_ganador(tabla);

    if (ganador = 1) then

     victorias_1 := victorias_1 + 1

    else if (ganador = 2) then

     victorias_2 := victorias_2 + 1;

    if not(ganador = 0) then begin

     modificar_tabla(0, 0, tabla, ronda, jugador);

     gotoxy(JGX, JGY);

     write('El jugador ', ganador, ' ha ganado. Pulse una tecla para seguir jugando');

     jugador := not(empieza);

     iniciar(tabla, FichaI, FichaJ, CursorI, CursorJ, ronda, poner, empieza, jugador);

     readkey;

     gotoxy(JGX, JGY);

     clreol;

    end;

   end;

  end

  else if (tecla = ABAJO) and (CursorI < 3) then

   CursorI := CursorI + 1

  else if (tecla = ARRIBA) and (CursorI > 1) then

   CursorI := CursorI - 1

  else if (tecla = IZQUIERDA) and (CursorJ > 1) then

   CursorJ := CursorJ - 1

  else if (tecla = DERECHA) and (CursorJ < 3) then

   CursorJ := CursorJ + 1

  else if (upcase(tecla) = REINICIAR) then begin

   jugador := false;

   iniciar(tabla, FichaI, FichaJ, CursorI, CursorJ, ronda, poner, empieza, jugador);

   victorias_1 := 0;

   victorias_2 := 0;

  end;

  gotoxy(1, 1);

  modificar_tabla(CursorI, CursorJ, tabla, ronda, jugador);



 end;

 until (tecla = ESC);

end.

Descargar ejemplo:

Juego de xo pascal