Program napodobňuje hru milionár

{ MILION.PAS                Copyright (c) TrSek alias Zdeno Sekerak }
{ Program napodobnuje hru milionar.                                 }
{ Jednotlive otazky sa definuju v textovych suboroch.               }
{                                                                   }
{ Datum:19.01.2005                            http://www.trsek.com  }
 
program hra_milionar;
uses crt,dos,graph,mycrt;
 
const MENA='milion.txt';
 
      peniaze:array[1..10] of integer=
      (5,10,15,50,75,100,150,300,500,1000);
 
var grDriver:Integer;
      grMode:Integer;
           q:char;         { stlaceny klaves     }
 
 
{ kolko to je korun ma level }
function cena(level:integer):string;
begin
  if(level=0)then
    cena:='0'
  else
    cena:=Cislo(peniaze[level],4)+' 000';
end;
 
 
{ vykresli graf vysledkov }
procedure vysledky;
var meno:string;
   level:integer;
       f:text;
       i:integer;
begin
  grDriver := Detect;
  InitGraph(grDriver, grMode,' ');
  outtextxy(140,5,'Vysledkova listina jednotlivych hracov');
 
  { nakreslime os }
  line(80,18,80,450);
 
  { nastavime vzor vyplnovania }
  SetFillStyle(SolidFill, Green);
 
  { zacneme citat subor }
  assign(f,MENA);
  reset(f);
  i:=0;
 
  { vycitame vsetkych sutaziacich, ale maximalne 24 }
  while(not(eof(f)) and (i<24))do
  begin
    inc(i);
    readln(f,meno);
    readln(f,level);
 
    { meno hraca }
    outtextxy(5,i*18+6,meno);
 
    { jeho score }
    bar3d(80,i*18,80+level*55,(i+1)*18,0,TopOff);
    outtextxy(level*55+10,i*18+6,Cena(level));
  end;
 
  { zatvorime subor }
  close(f);
 
  { vypiseme spravu }
  outtextxy(140,465,'Pre navrat do menu stlac klaves <Enter>');
  readln;
 
  { zatvoriem grafiku }
  CloseGraph;
end;
 
 
{ vyberie zo suboru jednu otazku a tu vypise }
function VypisOtazku(level:integer):integer;
var f:text;
  otazka:string;
     odp:array[1..4] of string;
     por:array[1..4] of integer;
     x,i:integer;
begin
  { otvorime subor }
  assign(f,'level.'+ Cislo(level,0));
  reset(f);
 
  { nahodne vygeneruje otazku od 1-3 }
  x:=trunc(random(3));
 
  { precita subor az po otazku }
  for i:=1 to (x*6)+1 do
     readln(f,otazka);
 
  { vyprazdni pole poradi otazok }
  for i:=1 to 4 do por[i]:=0;
 
  { zamiesa odpovede }
  for i:=1 to 4 do begin
    x:=trunc(random(4))+1;
 
    { najde dalsieho vhodneho kandidata }
    while(por[x]<>0) do begin
      if(por[x]<>0)then x:=x+1;
      if(x>4)then x:=1;
    end;
 
    { nasiel }
    por[x]:=i
  end;
 
  { precita mozne odpovede }
  readln(f,odp[por[1]]);
  readln(f,odp[por[2]]);
  readln(f,odp[por[3]]);
  readln(f,odp[por[4]]);
 
  { zatvorime subor }
  close(f);
 
  { vypiseme otazku }
  writexy(10,10,otazka);
 
  { vypiseme odpovede }
  writexy(12,12,'a. '+ odp[1]);
  writexy(12,13,'b. '+ odp[2]);
  writexy(12,14,'c. '+ odp[3]);
  writexy(12,15,'d. '+ odp[4]);
  writexy(10,17,'Stlac a,b,c,d');
 
  { prva odpoved v subore je vzdy spravna }
  VypisOtazku:=por[1];
end;
 
 
{ vyopise ake je skore }
procedure VypisScore(level:integer);
var i:integer;
begin
  writexy(60,6,' Peniaze');
  writexy(60,7,'--------');
 
  for i:=1 to 10 do begin
    if(i=level)then farba(red,yellow)
               else farba(black,yellow);
 
    writexy(60,18-i,Cena(i));
  end;
 
  farba(black,yellow);
end;
 
 
{ hra milionar }
procedure milionar;
var odp:integer;
     ch:char;
  level:integer;
   konc:boolean;
   meno:string;
begin
  randomize;
  level:=0;
  konc:=false;
 
  { opytame sa ako sa vola }
  clrscr;
  write('Zadaj svoje meno:');
  readln(meno);
 
  repeat
    clrscr;
    writexy(30,2,'VEDOMOSTNY KVIZ');
    writexy(30,4,'hrac:'+meno);
    VypisScore(level);
 
    odp:=VypisOtazku(level+1);
 
    { cakaj na klaves }
    ch:=readkey;
 
    { klavesa ESC konci }
    if(ch=#27)then konc:=true;
 
    { neuhadol - konci, uhadol - dalsi level }
    if((ord(ch)-ord('a'))<>(odp-1))then
     begin
       konc:=true;
       writexy(10,17,'Zle spravna odpoved je: '+chr(odp+96));
     end
    else
     begin
      inc(level);            { dalsi level }
      VypisScore(level);     { vypis skore }
     end;
 
    { ak uhadol aj poslednu otazku konci }
    if(level=10)then
       konc:=true;
 
  until (konc);
 
  { skore zapiseme do suboru }
  Zapis(MENA,meno,level);
 
  { este ho nechame nech si to pozrie }
  writexy(10,18,'Vyhral si:'+cena(level)+' Sk');
  writexy(10,20,'Pre navrat do menu stlac klaves <Enter>');
  ch:=readkey;
end;
 
 
{ zaciatok programu }
BEGIN
 
  repeat
    clrscr;
 
    farba(black,red);
    writexy(26,10,'Ponuka cinnosti:');
 
    writexy(26,11,'1. Hra Milionar');
    writexy(26,12,'2. Prezriet vysledky');
    writexy(26,13,'3. Koniec');
 
    q:=readkey;                { precita stlaceni eklavesu }
    if(q='1') then milionar;   { spusti hru     }
    if(q='2') then vysledky;   { ukaze vysledky }
 
  until(q='3');                { q=3 koniec     }
END.