Program simuluje hru kameň-papier-nožnice

{ KPN.PAS                   Copyright (c) TrSek alias Zdeno Sekerak }
{ Program simuluje hru kamen-papier-noznice.                        }
{ Hraci zadavaju svoju volbu pismenami k-kamen, p-papier, n-noznice }
{ Program vyhodnocuje ich uspesnost a uklada si jednotlive hry do   }
{ suboru. Po skonceni zobrazi graf uspesnosti jednotlivych hracov.  }
{                                                                   }
{ Datum:28.01.2005                            http://www.trsek.com  }
 
program kpn;
uses crt,dos,graph,mycrt;
 
const SCORE='score.txt';
      MAX=10;
 
var   q:char;                           { question }
   mena:array[1..MAX] of string;        { uchova mena hracov }
   scor:array[1..MAX,1..2] of integer;  { uchova score hracov }
 
 
{ hra: kamen, papier, noznice }
procedure hra;
var meno1,meno2:string;
    v1,v2:string;
    s:char;
    i:integer;
    w:integer;
    f:text;
begin
  clrscr;
  textcolor(yellow);
 
  { opyta sa na mena hracov }
  write('Prosim hraca cislo 1 aby zadal svoje meno:');
  readln(meno1);
  write('Prosim hraca cislo 2 aby zadal svoje meno:');
  readln(meno2);
 
  { bude opakovat az pokial nepovie n }
  repeat
    textcolor(lightgray);
    writeln('Zaciname hru, prosim premyslite si svoju volbu.');
 
    for i:=1 to 2 do writeln;
 
    zvuk(200,800);
    zvuk(  0,250);
    zvuk(300,600);
    zvuk(  0,300);
    zvuk(400,800);
    zvuk(  0,200);
    nosound;
 
    textcolor(green);
    write(meno1 ,' zadaj svoju volbu [k-kamen, p-papier, n-noznice]:');
    v1:=readkey;
    WriteLn;
 
    write(meno2 ,' zadaj svoju volbu [k-kamen, p-papier, n-noznice]:');
    v2:=readkey;
    WriteLn;
 
    for i:=1 to 2 do writeln;
 
    { nespravne typy }
    textcolor(red);
    if (v1)=(v2)then
       writeln('Vase typy boli rovnake, prosim opakujte hru.');
 
    if(v1<>'k') and (v1<>'p') and (v1<>'n')then
       writeln(meno1, ' nestlacil si pozadovany klaves skus znova');
 
    if(v2<>'k')and (v2<>'p')and (v2<>'n')then
       writeln(meno2, ' nestlacil si pozadovany klaves skus znova.');
 
    { vyhodnotenie kto to vyhral }
    w:=0;
    textcolor(white);
    if(v1='p') and (v2='k')then w:=1;
    if(v1='n') and (v2='p')then w:=1;
    if(v1='k') and (v2='n')then w:=1;
    if(v1='k') and (v2='p')then w:=2;
    if(v1='p') and (v2='n')then w:=2;
    if(v1='n') and (v2='k')then w:=2;
 
    { vypiseme ze vyhral 1 a ulozime do suboru }
    if(w=1)then
    begin
      writeln('Gratulujem ',meno1 ,' vyhral si!');
 
      { otvori subor na zapis, zapise, zatvori }
      assign(f,SCORE);
      append(f);
      writeln(f,'1',meno1);
      writeln(f,'0',meno2);
      close(f);
    end;
 
    { vypiseme ze vyhral 2 a ulozime do suboru }
    if(w=2)then
    begin
      writeln('Gratulujem ',meno2 ,' vyhral si!');
 
      { otvori subor na zapis, zapise, zatvori }
      assign(f,SCORE);
      append(f);
      writeln(f,'1',meno2);
      writeln(f,'0',meno1);
      close(f);
    end;
 
    zvuk(200,250);
    zvuk(300,300);
    zvuk(400,200);
    nosound;
 
    textcolor(green);
    writeln('Prajete si hru opakovat? [a/n]');
    s:=readkey;
  until(s<>'a');
 
  textcolor(red);
  writeln('Koniec hry');
end;
 
 
{ zisti to aky v poradi v poli je hrac }
{ ak nieje urci posledne volne pole    }
function Poradie(meno:string):integer;
var i:integer;
begin
  Poradie:=0;
 
  for i:=MAX downto 1 do
  begin
    if(UpWord(mena[i])=UpWord(meno))then Poradie:=i;
    if(mena[i]='')then Poradie:=i;
  end;
end;
 
 
{ otvori subor score a spocita score }
procedure CalcScore;
var f:text;
    i:integer;
 meno:string;
  bod:integer;
begin
  assign(f,SCORE);
  reset(f);
 
  { precita vsetky mena }
  repeat
    Readln(f,meno);
 
    bod:=ord(meno[1])-ord('0');
    meno:=copy(meno,2,length(meno));
 
    { zisti poradie }
    i:=Poradie(meno);
 
    { ak je medzi prvymi 10 }
    if(i<>0)then begin
      mena[i]:=meno;
 
      { ak vyhral tak pripocitame }
      if(bod=1)then scor[i,1]:=scor[i,1]+1;
      if(bod=0)then scor[i,2]:=scor[i,2]+1;
    end;
 
  until(eof(f));
 
  close(f);
end;
 
 
{ zisti maximalnu hodnotu }
function CalcMax:integer;
var m,i:integer;
begin
  m:=scor[1,1];         { pociatocna hodnota }
 
  for i:=1 to MAX do
  begin
    { ak je hodnota vacsia ako doterajsie maximum }
    if(scor[i,1]>m)then m:=scor[i,1];
    if(scor[i,2]>m)then m:=scor[i,2];
  end;
 
  CalcMax:=m;
end;
 
 
{ zmaze pole score }
procedure ClrScore;
var i:integer;
begin
  for i:=1 to MAX do
  begin
    scor[i,1]:=0;
    scor[i,2]:=0;
    mena[i]:='';
  end;
end;
 
 
{ vykresli graf funkcie }
procedure graf;
var i:integer;
    m:integer;
    y:integer;
begin
  ClrScore;     { zmaze pole score }
  CalcScore;    { vypocita ake maju score }
  m:=CalcMax;   { zisti maximalnu hodnotu }
 
  OpenGraph;
 
  { nakreslime osi }
  line(40,20,40,450);
  line(30,440,620,440);
 
  { pocet na osi y }
  for i:=1 to 10 do begin
    line(35,440-i*40,45,440-i*40);
    outtextxy(5,437-i*40,ToStr(i*10)+'%');
  end;
 
  { mena na osi x }
  for i:=1 to MAX do
    outtextxy(i*55,450,mena[i]);
 
  { nastavime pre vyhral vzor vyplnovania }
  SetFillStyle(XHatchFill, Green);
  { popis }
  bar3d(550,20,570,30,0,TopOff);
  outtextxy(575,20,'vyhral');
 
  { vykreslime jednotlive hodnoty vyhral }
  for i:=1 to MAX do begin
    y:=round((400*scor[i,1])/m);
    { stlpec a cislo nad nim }
    bar3d(i*55,440-y,i*55+20,440,0,TopOff);
    outtextxy(i*55+4,430-y,ToStr(scor[i,1]));
  end;
 
  { nastavime pre prehral vzor vyplnovania }
  SetFillStyle(XHatchFill, Red);
  { popis }
  bar3d(550,40,570,50,0,TopOff);
  outtextxy(575,40,'prehral');
 
  { vykreslime jednotlive hodnoty prehral }
  for i:=1 to MAX do begin
    y:=round((400*scor[i,2])/m);
    { stlpec a cislo nad nim }
    bar3d(i*55+20,440-y,i*55+40,440,0,TopOff);
    outtextxy(i*55+24,430-y,ToStr(scor[i,2]));
  end;
 
  readln;
  CloseGraph;
end;
 
 
{ hlavne menu programu }
BEGIN
  TestFile(SCORE);    { otestuje subor }
 
  repeat
    clrscr;
    textcolor(green);
    writexy(26, 7,'Ponuka cinnosti:');
 
    textcolor(red);
    writexy(26, 8,'1. Hrat kamen,papier,noznice');
    writexy(26, 9,'2. Prezriet graf');
    writexy(26,10,'3. Koniec');
 
    q:=readkey;           { precita stlaceni eklavesu }
    if(q='1') then hra;   { spusti hru }
    if(q='2') then graf;  { ukaze graf }
 
  until(q='3');    {  if(q=3) then koniec;}
END.