{ 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.