program gato;
uses crt;
var jug:array[1..2] of string;
procedure color(f,c:integer);
begin
 textbackground(f); textcolor(c);
end;
procedure tono(n,t:integer);
begin
 sound(n); delay(t*250); nosound
end;
procedure texto(x,y,f,c:integer;cad:string);
begin
 color(f,c); gotoxy(x,y); write(cad);
end;
procedure car(x,y:integer;cad:char);
begin
 gotoxy(x,y); write(cad);
end;
procedure marco(x1,y1,x2,y2,f,c:integer);
var x,y:integer;
begin
 color(f,c);
 car(x1,y1,chr(201)); car(x2,y1,chr(187));
 car(x1,y2,chr(200)); car(x2,y2,chr(188));
 for x:=x1+1 to x2-1 do
 begin
  car(x,y1,chr(205)); car(x,y2,chr(205));
 end;
 for y:=y1+1 to y2-1 do
 begin
  car(x1,y,chr(186)); car(x2,y,chr(186));
 end;
end;
procedure entrada(x,y,f,c:integer;var cad:string);
begin
 color(f,c); gotoxy(x,y); readln(cad);
end;
procedure nombres;
begin
 texto(30,10,1,14,'Jugador 1: '); entrada(45,10,4,14,jug[1]);
 texto(30,12,1,14,'Jugador 2: '); entrada(45,12,4,14,jug[2]);
 texto(30,10,0,15,'                             ');
 texto(30,12,0,15,'                             ');
end;
procedure rejilla;
var x,y:integer;
begin
 marco(33,4,43,14,10,8);
 for x:=1 to 3 do
  for y:=1 to 3 do
   marco(34+(x-1)*3,5+(y-1)*3,36+(x-1)*3,7+(y-1)*3,8,10);
end;
procedure juego;
var otro,tec:char;
    num,x,y,r,c,m,n,gan,w,z:integer;
    hueco:array[1..3,1..3] of integer;
    fin:boolean;
    let:array[1..2] of char;
begin
 repeat
  color(0,15);
  clrscr;
  for x:=1 to 3 do
   for y:=1 to 3 do
    hueco[x,y]:=0;
  marco(1,1,80,24,15,2);
  texto(33,2,15,9,'EL GRAN GATO');
  nombres;
  rejilla;
  marco(15,18,65,21,10,8);
  texto(25,20,1,14,'Realizando sorteo ... espera');
  tono(200,5);
  delay(1500);
  texto(25,20,0,15,'                            ');
  num:=random(2)+1;
  if num=1 then
  begin
    texto(31,20,1,30,'Inicia: '+jug[num]);
    let[1]:='X';
    let[2]:='O';
  end
  else
  begin
    texto(31,20,1,30,'Inicia: '+jug[num]);
    let[1]:='O';
    let[2]:='X';
  end;
  tono(500,5);
  r:=6;
  c:=35;
  y:=1;
  x:=1;
  fin:=false;
  gotoxy(c,r);
  gan:=0;
  z:=0;
  repeat
   repeat
    tec:=readkey
   until tec<>'';
   if tec=#0 then tec:=readkey;
   case tec of
    #72:begin
         dec(r,3);
         dec(y);
         if r<6 then
         begin
          r:=6;
          y:=1;
         end;
        end;
    #80:begin
         inc(r,3);
         inc(y);
         if r>12 then
         begin
          r:=12;
          y:=3
         end
        end;
    #75:begin
         dec(c,3);
         dec(x);
         if c<35 then
         begin
          c:=35;
          x:=1
         end
        end;
    #77:begin
         inc(c,3);
         inc(x);
         if c>41 then
         begin
          c:=41;
          x:=3
         end
        end;
    #13:begin
        if hueco[x,y]=0 then
         begin
          inc(z);
          texto(31,20,0,15,'                             ');
          if num=1 then
          begin
            car(c,r,let[1]);
            num:=2;
            hueco[x,y]:=1;
          end
          else
          begin
            car(c,r,let[2]);
            num:=1;
            hueco[x,y]:=2;
          end;
          n:=1;
          m:=1;
          w:=0;
          while (n<4) and (fin=false) and (hueco[m,n]<>0) do
          begin
           while m<3 do
           begin
            if hueco[m,n]=hueco[m+1,n] then inc(w);
            inc(m)
           end;
           if w=2 then
           begin
            fin:=true; gan:=hueco[m,n]
           end
           else
           begin
            w:=0;
           end;
           inc(n);
           m:=1;
          end;
          n:=1;
          m:=1;
          w:=0;
          while (m<4) and (fin=false) and (hueco[m,n]<>0) do
          begin
           while n<3 do
           begin
            if hueco[m,n]=hueco[m,n+1] then inc(w);
            inc(n)
           end;
           if w=2 then
           begin
            fin:=true; gan:=hueco[m,n]
           end
           else
           begin
            w:=0;
           end;
           inc(m);
           n:=1;
          end;
          m:=1;
          w:=0;
          while(m<3) and (hueco[m,m]<>0) do
          begin
           if hueco[m,m]=hueco[m+1,m+1] then inc(w);
           inc(m)
          end;
          if w=2 then begin fin:=true; gan:=hueco[m,m]; end;
          w:=0;
          m:=1;
          n:=3;
          while(m<3) and (hueco[m,n]<>0) do
          begin
           if hueco[m,n]=hueco[m+1,n-1] then inc(w);
           n:=n-1;
           inc(m);
          end;
          if w=2 then begin fin:=true; gan:=hueco[3,1];end;
          if fin=false then
            texto(31,20,1,30,'Turno: '+jug[num]);
         end;
        end;
   end;
   gotoxy(c,r);
  until (fin=true) or (z=9);
  if gan<>0 then
   texto(31,20,1,30,'Ganador: '+jug[gan])
  else
   texto(31,20,1,30,'E M P A T A D O S');
  texto(25,25,4,11,'Otro juego <S/N>? ');
  repeat
   gotoxy(45,25);
   otro:=readkey
  until upcase(otro) in ['S','N'];
 until upcase(otro)='N';
end;
procedure ventana;
var t,x,y,m,n,i,f:integer;
begin
 for t:=1 to 20 do
 begin
  m:=random(70)+5; n:=random(19)+5; i:=random(15)+1; f:=random(5)+1;
  color(random(15)+1,random(15)+1);
  for x:=i to m do
   for y:=f to n do
    car(x,y,chr(176));
  delay(250);
 end;
end;
begin
 clrscr; randomize; ventana;
 texto(23,12,0,14,'EL GRAN GATO -- BY REYES SOFT /99');
 readln; juego; clrscr; ventana;
 texto(15,12,4,14,'GRACIAS POR JUGAR CONMIGO -- DI NO A LA PIRATERIA');
 readln;  color(0,15);  clrscr;
end.