program memorama;
uses crt,graph;
type fig=array[1..16] of pointer;
     nfi=array[1..16] of integer;
var d,dib:fig;
procedure inigraf;
var d,m:integer;
begin
 d:=detect;
 initgraph(d,m,'c:\tp6');
end;
procedure fingraf;
begin
 closegraph;
end;
procedure dibuja;
var p,k,i:integer;
begin
 cleardevice;
 setcolor(14);
 for i:=1 to 8 do
 begin
  setfillstyle(1,random(11)+2);
  bar(100,100,150,150);
  case i of
   1:begin
          for k:=1 to 5 do
           circle(125,125,20-k);
     end;
   2:begin
          for k:=1 to 5 do
           rectangle(105+k,105+k,145-k,145-k);
     end;
   3:begin
          for k:=1 to 5 do
          begin
           line(125,105+k,145-k,125);
           line(145-k,125,125,145-k);
           line(125,145-k,105+k,125);
           line(105+k,125,125,105+k);
          end;
     end;
   4:begin
          for k:=1 to 5 do
          begin
           line(125,105+k,145-k,145-k);
           line(145-k,145-k,105+k,145-k);
           line(105+k,145-k,125,105+k);
          end;
     end;
   5:begin
          for k:=1 to 5 do
          begin
           line(105+k,105+k,145-k,105+k);
           line(145-k,105+k,125,145-k);
           line(125,145-k,105+k,105+k);
          end;
     end;
   6:begin
       for k:=1 to 5 do
           rectangle(105+k,115+k,145-k,135-k);
     end;
   7:begin
          for k:=1 to 5 do
           ellipse(125,125,0,360,20-k,10-k);
     end;
   8:begin
          for k:=1 to 5 do
           ellipse(125,125,0,360,10-k,20-k);
     end;
   end;
   p:=imagesize(99,99,151,151);
   getmem(d[i],p);
   getimage(99,99,151,151,d[i]^);
  end;
end;
procedure presenta;
var i,k:integer;
begin
 setbkcolor(1);
 cleardevice;
 for i:=1 to 5 do
  for k:=1 to 8 do
  begin
   IF I<>3 THEN
   putimage(50+(k-1)*70,50+(i-1)*70,d[k]^,xorput);
  end;
 settextstyle(3,0,6);
 SETCOLOR(10);
 outtextxy(100,180,'M E M O R A M A');
 settextstyle(1,0,3);
 OUTTEXTXY(300,400,'Por: V¡ctor Reyes /1998');
 readln
end;
procedure asigna(var e:fig;var nfig:nfi);
var k,i,n:integer;
    m:array[1..16] of boolean;
begin
 for i:=1 to 16 do m[i]:=false;
 for i:=1 to 8 do
 begin
  for k:=1 to 2 do
  begin
   repeat
    n:=random(16)+1;
   until m[n]=false;
   m[n]:=true;
   e[n]:=d[i];
   nfig[n]:=i;
  end;
 end;
end;
procedure muestra;
var i,j,num:integer;
    cad:string[3];
begin
 setfillstyle(1,2);
 setcolor(4);
 num:=0;
 for i:=1 to 4 do
  for j:=1 to 4 do
  begin
   bar(200+(j-1)*70,100+(i-1)*70,250+(j-1)*70,150+(i-1)*70);
   num:=num+1;
   str(num,cad);
   outtextxy(220+(j-1)*70,120+(i-1)*70,cad);
  end;
end;
procedure juego;
var m:char;
    i1,j1,i2,j2,q,t,c1,c2,x1,x2:integer;
    n1,n2,nom:string[15];
    cad,num:string[3];
    v1,v2:boolean;
    nfig:nfi;
    r:array[1..16] of boolean;
begin
 repeat
  settextstyle(11,0,2);
  setbkcolor(1);
  setcolor(14);
  cleardevice;
  asigna(dib,nfig);
  for q:=1 to 16 do r[q]:=false;
  muestra;
  t:=0; c1:=0; c2:=0;
  setcolor(14);
  outtextxy(30,50,'Nombre jugador #1: ');
  setfillstyle(2,10);
  bar(180,45,310,65);
  gotoxy(24,4); textcolor(11);readln(n1);
  outtextxy(330,50,'Nombre jugador #2: ');
  bar(480,45,610,65);
  gotoxy(62,4); textcolor(11);readln(n2);
  outtextxy(210,370,'Carta #1: ');
  outtextxy(370,370,'Carta #2: ');
  q:=random(2)+1;
  outtextxy(250,440,'Juega:  ');
  v1:=false; v2:=false;
  if q=1 then
  begin
   nom:=n1;
   v1:=true
  end
  else
  begin
   nom:=n2;
   v2:=true
  end;
  outtextxy(50,200,n1);
  outtextxy(50,230,'lleva: ');
  outtextxy(490,200,n2);
  str(c1,num);
  outtextxy(70,250,num);
  outtextxy(490,230,'lleva: ');
  str(c2,num);
  outtextxy(510,250,num);
  repeat
   setfillstyle(0,0);
   bar(320,430,400,450);
   setcolor(15);
   outtextxy(320,440,nom);
   setfillstyle(2,10);
   repeat
    bar(290,365,315,380);
    bar(450,365,475,380);
    gotoxy(38,24);
    readln(x1);
   until r[x1]=false;
   i1:=x1 div 5+1;if x1>12 then i1:=4;if x1=9 then i1:=3;
   j1:=x1 mod 4; if j1=0 then j1:=4;
   putimage(200+(j1-1)*70,100+(i1-1)*70,dib[x1]^,xorput);
   repeat
    bar(450,365,475,380);
    gotoxy(58,24);
    readln(x2);
   until (x2<>x1) and (r[x2]=false);
   i2:=x2 div 5+1;if x2>12 then i2:=4;if x2=9 then i2:=3;
   j2:=x2 mod 4; if j2=0 then j2:=4;
   putimage(200+(j2-1)*70,100+(i2-1)*70,dib[x2]^,xorput);
   if nfig[x1]<>nfig[x2] then
   begin
    sound(80);delay(10000);nosound;
    setfillstyle(1,2);
    bar(200+(j1-1)*70,100+(i1-1)*70,250+(j1-1)*70,150+(i1-1)*70);
    str(x1,cad);
    setcolor(4);
    outtextxy(220+(j1-1)*70,120+(i1-1)*70,cad);
    bar(200+(j2-1)*70,100+(i2-1)*70,250+(j2-1)*70,150+(i2-1)*70);
    str(x2,cad);
    outtextxy(220+(j2-1)*70,120+(i2-1)*70,cad);
    if v1=true then
    begin
     v1:=false;
     v2:=true;
     nom:=n2
    end
    else
    begin
     v1:=true;
     v2:=false;
     nom:=n1
    end;
   end
   else
    begin
     sound(800);delay(500);sound(600);delay(500);
     nosound;
     t:=t+1;
     r[x1]:=true;
     r[x2]:=true;
     setfillstyle(0,0);
     if v1=true then
     begin
      bar(70,250,100,270);
      c1:=c1+1;
      str(c1,num);
      outtextxy(70,250,num);
     end
     else
     begin
      bar(510,250,540,270);
      c2:=c2+1;
      str(c2,num);
      outtextxy(510,250,num);
     end;
    end;
  until t=8;
  setfillstyle(0,0);
  bar(250,440,400,460);
  settextstyle(3,0,4);
  if c1=c2 then
   outtextxy(250,400,'EMPATADOS')
  else
   if c1>c2 then outtextxy(200,400,'GANADOR: '+n1)
   else outtextxy(200,400,'GANADOR: '+n2);
  readln;
  cleardevice;
  settextstyle(11,0,2);
  outtextxy(200,200,'Deseas otro juego <s/n>? ');
  gotoxy(51,13);readln(m);
 until m<>'s';
end;
procedure adios;
var i:integer;
begin
 cleardevice;
 for i:=2 to 14 do
 begin
  setcolor(i);
  settextstyle(1,0,i);
  outtextxy(10+(i-1)*12,5+(i-1)*25,'ADIOS...');
 end;
 readln
end;
begin
 randomize;
 inigraf;
 dibuja;
 presenta;
 juego;
 adios;
 fingraf
end.