Vyčíslování aritmetických výrazů, řešení rovnic s jednou neznámou, využití elementárních matematických funkcí, paměť mezivýsledků

{ SOLVER.PAS                               Copyright (c) Petr Koupy }
{                                                                   }
{ Interpreter vyrazu a iteracni reseni rovnic.                      }
{                                                                   }
{ Vyčíslování aritmetických výrazů, řešení rovnic s jednou neznámou,}
{ využití elementárních matematických funkcí, paměť mezivýsledků.   }
{ Je možné nastavit počet desetinných míst a prohledávaný rozsah    }
{ proměnné při řešení rovnice. Pro řešení rovnic jsou implementovány}
{ různé numerické metody, které se liší svojí časovou složitostí.   }
{ Pro snadnější používání je v menu obsažena nápověda. Program není }
{ zcela dokončen a vlastní implementace některých elementárních     }
{ funkcí není dostatečně přesná. Především při použití vnořených    }
{ goniometrických funkcí je třeba brát výsledky hodně s rezervou.   }
{ Program vznikl v rámci přípravy na maturitu.                      }
{                                                                   }
{ Datum:01.05.2007                             http://www.trsek.com }
 
program solver;
uses crt, math, dos;
const maxzasobnik=50; {maximalni pocet prvku ulozenych v zasobniku}
type zasobnik1=record   {ciselny zasobnik bude datoveho typu zaznam a obsahuje:}
       obsah:array[1..maxzasobnik] of real;    {- jednotlive prvky typu real}
       pozice:word;                            {- pozici posledniho prvku}
     end;
     zasobnik2=record   {operatorovy zasobnik bude datoveho typu zaznam a obsahuje:}
       obsah:array[1..maxzasobnik] of integer; {- jednotlive prvky typu integer}
       pozice:word;                            {- pozici posledniho prvku}
     end;
var vstup:string; {hlavni program - retezec od uzivatele}
    chyba:integer; {globalni promenna pro chybove hlaseni}
    promenne:array['A'..'Z'] of real; {pole promennych, do kterych bude mozne ukladat mezivypocty}
    pruseciky:array[1..50] of real;
    pocetkorenu:integer;
    preteceni:boolean;
    i:char; {pomocna promenna pro cyklus}
    x:real; {vysledek celeho zpracovani}
    volba:byte; {promenna pro vyber uzivatele}
 
{zacatek - chybove hlaseni}
 
function ChyboveHlaseni(ch:integer):string; {prevadi chybovy kod na srozumitelny textovy retezec}
var retezec:string; {promenna na docasne ulozeni daneho chyboveho hlaseni}
begin
  case ch of
    2: retezec:='Deleni nulou';
    3: retezec:='Chybny parametr';
    4: retezec:='Chybny operator';
    5: retezec:='Chybne cislo';
    6: retezec:='Chybna promenna';
    7: retezec:='Nedefinovano v R'
  end;
  ChyboveHlaseni:=retezec; {prirazeni retezce funkci}
end;
 
procedure Selhani(s:integer); {pri selhani ruzneho druhu se hodnota chyboveho hlaseni priradi promenne}
begin
  chyba:=s; {prirazeni chyboveho hlaseni globalni promenne}
end;
 
{konec - chybove hlaseni}
 
{zacatek - zasobniky}
 
procedure Inicializovat1(var z:zasobnik1); {vymazani zasobniku pred zpracovanim}
begin
  z.pozice:=0; {at je uvnitr cokoliv, pozice posledniho prvku jde na nulu}
end;
 
procedure Inicializovat2(var z:zasobnik2); {vymazani zasobniku pred zpracovanim}
begin
  z.pozice:=0; {at je uvnitr cokoliv, pozice posledniho prvku jde na nulu}
end;
 
procedure Vlozit1(var z:zasobnik1;prvek:real); {vlozeni prvku na posledni misto zasobniku}
begin
  if z.pozice<maxzasobnik then {pokud neni zasobnik plny, muze se vkladat}
    begin
      inc(z.pozice); {zasobnik bude vzapeti o jeden prvek plnejsi}
      z.obsah[z.pozice]:=prvek; {fyzicke vlozeni prvku do zasobniku}
    end;
end;
 
procedure Vlozit2(var z:zasobnik2;prvek:integer); {vlozeni prvku na posledni misto zasobniku}
begin
  if z.pozice<maxzasobnik then {pokud neni zasobnik plny, muze se vkladat}
    begin
      inc(z.pozice); {zasobnik bude vzapeti o jeden prvek plnejsi}
      z.obsah[z.pozice]:=prvek; {fyzicke vlozeni prvku do zasobniku}
    end;
end;
 
function Vyjmout1(var z:zasobnik1):real; {vraci hodnotu posledniho prvku zasobniku a zaroven posledni prvek vyjme}
begin
  if z.pozice>0 then {pokud zasobnik neni prazdny, muze se vyjimat}
    begin
      Vyjmout1:=z.obsah[z.pozice]; {prirazeni hodnoty posledniho prvku funkci}
      dec(z.pozice); {zasobnik se vyjmutim zmensuje o jeden prvek}
    end;
end;
 
function Vyjmout2(var z:zasobnik2):integer; {vraci hodnotu posledniho prvku zasobniku a zaroven posledni prvek vyjme}
begin
  if z.pozice>0 then {pokud zasobnik neni prazdny, muze se vyjimat}
    begin
      Vyjmout2:=z.obsah[z.pozice]; {prirazeni hodnoty posledniho prvku funkci}
      dec(z.pozice); {zasobnik se vyjmutim zmensuje o jeden prvek}
    end;
end;
 
function Nacist1(var z:zasobnik1):real; {vraci hodnotu posledniho prvku zasobniku}
begin
  if z.pozice>0 then {pokud zasobnik neni prazdny, muze se nacitat}
    begin
      Nacist1:=z.obsah[z.pozice]; {prirazeni hodnoty posledniho prvku funkci}
    end;
end;
 
function Nacist2(var z:zasobnik2):integer; {vraci hodnotu posledniho prvku zasobniku}
begin
  if z.pozice>0 then {pokud zasobnik neni prazdny, muze se nacitat}
    begin
      Nacist2:=z.obsah[z.pozice]; {prirazeni hodnoty posledniho prvku funkci}
    end;
end;
 
function Prazdny1(z:zasobnik1):boolean; {zjisteni prazdnosti zasobniku}
begin
  if z.pozice=0 then Prazdny1:=true {prirazeni logicke hodnoty funkci}
  else Prazdny1:=false;
end;
 
function Prazdny2(z:zasobnik2):boolean; {zjisteni prazdnosti zasobniku}
begin
  if z.pozice=0 then Prazdny2:=true {prirazeni logicke hodnoty funkci}
  else Prazdny2:=false;
end;
 
function Plny1(z:zasobnik1):boolean; {zjisteni plnosti zasobniku}
begin
  if z.pozice=maxzasobnik then Plny1:=true {prirazeni logicke hodnoty funkci}
  else Plny1:=false;
end;
 
function Plny2(z:zasobnik2):boolean; {zjisteni plnosti zasobniku}
begin
  if z.pozice=maxzasobnik then Plny2:=true {prirazeni logicke hodnoty funkci}
  else Plny2:=false;
end;
 
{konec - zasobniky}
 
 
{zacatek - zpracovani retezce}
 
procedure OdstranitMezery(var retezec:string); {odstraneni uvodnich mezer ze vstupniho vyrazu}
begin
  while retezec[1]=' ' do retezec:=copy(retezec,2,255); {dokud jsou na zacatku mezery, retezec se sam do sebe kopiruje vzdy od druheho mista az do konce}
end;
 
function VelkeZnaky(var retezec:string):string; {vsechny znaky ve vstupnim retezci prevede na jejich velke varianty}
var opakovani:integer; {promenna pro cyklus rizeny promennou}
begin
  for opakovani:=1 to length(retezec) do retezec[opakovani]:=upcase(retezec[opakovani]); {vsechny znaky postupne prevest na velke varianty}
  VelkeZnaky:=retezec; {prirazeni prevedeneho retezce funkci}
end;
 
function ZacinaPodretezcem(podretezec:string; var retezec:string):boolean; {testuje, jestli retezec zacina podretezcem, a zaroven podretezec vyjme pryc}
begin
  if VelkeZnaky(podretezec)=copy(VelkeZnaky(retezec),1,length(podretezec)) then {pokud se podretezec na zacatku retezce nachazi, tak pokracuje - ke zvetsovani dochazi kvuli vyhodnoceni funkci}
    begin
      retezec:=copy(retezec,length(podretezec)+1,255); {vyjmuti podretezce tim, ze se zbytek retezce sam do sebe zkopiruje od konce podretezce}
      ZacinaPodretezcem:=true; {prirazeni logicke hodnoty funkci}
    end
  else ZacinaPodretezcem:=false; {prirazeni logicke hodnoty funkci}
end;
 
{konec - zpracovani retezce}
 
 
{zacatek - slozitejsi matematicke operace}
 
function Umocneni(a,b:real):real; {spocita a^b}
var opakovani:integer; {pomocna promenna pro cyklus}
    vysledek:real; {promenna na ulozeni mezivysledku postupneho nasobeni zakladem mocniny}
begin
  vysledek:=1; {pojistka, kdyby se exponent rovnal nule}
  if int(b)=b then {pokud je exponent cele cislo, bude jiny postup pri umocnovani}
    begin
      for opakovani:=1 to abs(trunc(b)) do vysledek:=vysledek*a; {pocet nasobeni se rovna absolutni hodnote z exponentu}
      if b<0 then vysledek:=1/vysledek; {pokud byl exponent zaporny, je nutne vratit prevracenou hodnotu vysledku}
    end
  else
    begin
      if a>0 then vysledek:=exp(ln(a)*b) else  {pokud je zaklad mocniny kladny, muze se ihned spocitat vysledek}
        begin
          if a<0 then {pokud je zaklad mocniny zaporny, je nutne rozhodnout o 2 vecech:}
            begin {1) jestli je exponent tvaru 1/x --- 2) jestli je prevracena hodnota exponentu licha --- pokud jsou tyto podminky splneni, lze odmocnit zaporne cislo, jinak je vracena chyba}
              if ((abs(round(1/b)-(1/b))<0.00000001) and ((round(1/b) mod 2)<>0)) then vysledek:=-1*exp(ln(abs(a))*b) else begin Selhani(7); exit; end;
            end;
        end;
    end;
  Umocneni:=vysledek; {prirazeni vysledku funkci}
end;
 
{konec - slozitejsi matematicke operace}
 
 
{zacatek - interpretace vyrazu}
 
function Priorita(p:integer):integer; {vraci prioritu pocetni operace - kazda operace je zastoupena dvojcifernym cislem, kde prvni cifra znamena prioritu a druha cifra odlisuje operace stejne priority od sebe}
begin
  Priorita:=p div 10; {prirazeni priority funkci}
end;
 
procedure Operace(var z:zasobnik1;o:integer); {se dvema prvky zasobniku provede operaci}
var a,b:real; {promenne, do kterych se docasne ulozi dva posledni prvky zasobniku}
begin
  a:=Vyjmout1(z); {vyjmuti posledniho prvku ze zasobniku do promenne a}
  b:=Vyjmout1(z); {vyjmuti nove vznikleho posledniho prvku ze zasobniku do promenne b}
  case o of {v zavislosti na operaci se na konec zasobniku vlozi:}
    10: Vlozit1(z,b+a); {soucet}   {to co bylo v zasobniku vice nahore (tedy a), je ve skutecnem vyrazu vice vpravo, takze proto jsou promenne prohozene}
    11: Vlozit1(z,b-a); {rozdil}
    20: Vlozit1(z,b*a); {nasobeni}
    21: if a<>0 then Vlozit1(z,trunc(b) div trunc(a)) else Selhani(2); {celociselne deleni - osetreno deleni nulou - chyba 2 zastavi uplne cele zpracovani, kaskadovite dojde k preruseni vsech urovni algoritmu}
    22: if a<>0 then Vlozit1(z,trunc(b) mod trunc(a)) else Selhani(2); {zbytek po celociselnem deleni}
    23: if a<>0 then Vlozit1(z,b/a) else Selhani(2); {plnohodnotne deleni realnych cisel}
    30: Vlozit1(z,Umocneni(b,a)) {umocneni}
  end;
end;
 
function Vyhodnoceni(retezec:string):real; forward; {telo funkce viz dale, dopredna deklarace funkci kvuli vzajemne rekurzi funkci Zavorky a Vyhodnoceni pres funkci Cislo}
 
function Zavorky(var retezec:string):string; {nalezne v retezci nejvyssi uroven zavorek a jejich obsah vraci jako svoji hodnotu}
var pruchod,pocet:integer; {pruchod bude postupne nabyvat hodnot od jedne do delky retezce, pocet bude vyhodnocovat pocet oteviracich a uzaviracich zavorek}
    podretezec:string; {ponese obsah hledanych zavorek}
begin
  if retezec[1]<>'(' then {jestli testovany retezec vubec nezacina zavorkou, nema cenu dale pokracovat v testu}
    begin
      Zavorky:=''; {funkce v tomto pripade vraci prazdnou promennou}
      exit; {ukonceni funkce}
    end;
  pruchod:=1; {nastaveni pruchodove promenne na zacatek retezce}
  pocet:=0; {vynulovani zavorkove promenne}
  repeat
    begin
      if retezec[pruchod]='(' then inc(pocet); {pokud je nalezena oteviraci zavorka, dojde k navyseni zavorkove promenne}
      if retezec[pruchod]=')' then {pokud je nalezena uzaviraci zavorka, pokracuje se dale}
        begin
          dec(pocet); {snizeni zavorkove promenne}
          if pocet<0 then begin Selhani(1); exit; end; {pokud zavorkova promenna klesne pod nulu, znamena to, ze v retezci bylo vice uzaviracich nez oteviracich zavorek - funkce je ukoncena s chybovym hlasenim}
          if pocet=0 then break; {jakmile pocet zase klesne na nulu, znamena to ze v promenne pruchod je umistena pozice uzaviraci zavorky nejvyssi urovne - cyklus je prerusen}
        end;
      inc(pruchod); {posunuti v retezci o jednu pozici}
    end;
  until pruchod=length(retezec); {v pripade ze se neskonci drive, tak se cyklus opakuje az se projde cely retezec - znamena to vsak, ze se nerovnal pocet oteviracich a uzaviracich zavorek}
  if pocet<>0 then begin Selhani(1); exit; end; {pokud je zavorkova promenna vyssi nez nula, znamena to, ze v retezci bylo vice oteviracich nez uzaviracich zavorek - funkce je ukoncena s chybovym hlasenim}
  podretezec:=copy(retezec,2,pruchod-2); {do podretezce se zkopiruje obsah nalezene zavorky - bez hranicnich zavorek}
  retezec:=copy(retezec,pruchod+1,255); {retezec ze sebe vyjme obsah zavorek vcetne zavorek samotnych}
  if podretezec='' then podretezec:='0'; {pokud je na vstupu nahodou zadano (), tedy prazdna zavorka, neni to povazovano za chybu, ale obsahu zavorky se priradi hodnota nula}
  Zavorky:=podretezec; {zaverecne prirazeni obsahu zavorky funkci}
end;
 
function Promenna(retezec:string):char; {vraci zastupny znak promenne nebo mezeru, pokud se o promennou nejedna - na vstupu teto funkce je retezec, ktery se nachazi pred znakem '=' - tento retezec by mel byt jednoznakovy, pokud neni, bude vracena mezera}
var znak:char; {reprezentace promenne}
begin
  OdstranitMezery(retezec); {odstraneni pripadnych mezer ze zacatku vstupniho retezce}
  znak:=upcase(retezec[1]); {prvni znak ze vstupniho retezce se prevede na svoji velkou variantu}
  if (znak<'A') or (znak>'Z') then {pokud neni ordinalni hodnota daneho znaku ve vymezene hodnote, nebude se jednat o promennou}
    begin
      Promenna:=' ';  {prirazeni mezery cele funkci, znamena to negativni reakci na overeni promenne}
      exit; {ukonceni overeni}
    end;
  retezec:=copy(retezec,2,255); {vyjmuti prvniho znaku ze vstupniho retezce}
  OdstranitMezery(retezec); {opet se odstrani mozne mezery}
  if retezec<>'' then {pokud se v overovanem retezci stale neco nachazi, urcite nejde o promennou}
    begin
      Promenna:=' '; {prirazeni mezery cele funkci, znamena to negativni reakci na overeni promenne}
      exit; {ukonceni overeni}
    end;
  Promenna:=znak; {zaverecne prirazeni znaku funkci}
end;
 
function Cislo(var retezec:string):real; {vyjme ze vstupniho retezce neprerusenou sadu cislic a tyto vycisli jako hodnotu, pokud jsou nalezeny zavorky, jejich obsah je rekurzivne zpracovan funkci Vyhodnoceni a nakonec je tedy stejne vraceno cislo}
const nekonecno:real=1E35; {pomocna konstanta pro vypocet tangens}
var hodnota:string; {podretezec, do ktereho se postupne nacitaji cisla od zacatku vstupniho retezce az po libovolny operator}
    obsahzavorky:string; {promenna bude obsahovat obsah zavorky, ktera je nalezena funkci Zavorky}
    testpromenne:string; {bude obsahovat retezec, ktery je treba otestovat, zda se nejedna o promennou}
    opakovani:integer; {pomocna promenna pro cyklus}
    vyslednahodnota:real; {promenna pro vyslednou transformaci podretezce na hodnotu}
    znamenko:integer; {pokud vstupni retezec bude zacinat zapornym znamenkem, tato promenna o tom ponese informaci}
begin
  OdstranitMezery(retezec); {pokud jsou na zacatku vstupniho retezce mezery, dojde k jejich odstraneni}
  znamenko:=1; {defaultne je nastaveno, ze retezec zacina kladne}
  if retezec='' then {pokud v retezci byly jen mezery a retezec je tim padem nyni zcela prazdny, funkce konci selhanim a dale nepokracuje - tento typ selhani nastava i pri uplnem zpracovani retezce a ukoncuje vyhodnocovaci cyklus}
    begin
      Selhani(1); {cislo selhani bude ulozeno do globalni promenne chyba}
      exit; {predcasne ukonceni cele funkce Cislo}
    end;
  if retezec[1]='-' then {v pripade, ze hned prvni prvek vstupniho vyrazu je zaporny operator, dojde pred dalsim zpracovanim k uprave}
    begin
      znamenko:=-1; {ulozi se informace o zapornosti, nakonec se tim bude vysledek nasobit}
      retezec:=copy(retezec,2,255); {retezec se sam do sebe zkopiruje od druheho mista do konce - nyni je zbaven operatoru na zacatku a muze byt dale zpracovan}
    end;
  obsahzavorky:=Zavorky(retezec); {funkce Cislo je pripravena izolovat ze vstupniho retezce pouze ciselnou hodnotu a predpoklada, ze na prvnim nebo druhem miste retezce cisla opravdu jsou - proto se musi prednostne zjistit, jestli retezec nahodou nezacina zavorkovou strukturou - pokud ano, tak se obsah zavorky nejvyssi urovne nacte do teto promenne}
  if obsahzavorky<>'' then {pokud funkce Zavorky vrati nejaky obsah zavorek, je nutne tento obsah zpracovat}
    begin {zde je dobre se zamyslet, jak se navzajem funkce rekurzivne volaji v pripade, ze jsou nalezeny zavorky}
      vyslednahodnota:=Vyhodnoceni(obsahzavorky); {funkce Vyhodnoceni vrati ciselnou hodnotu odpovidajici vyrazu v zavorce - tato hodnota je prirazena vysledku}
      Cislo:=vyslednahodnota*znamenko; {funkci Cislo je prirazen vysledek, ktery se vynasobi znamenkem, coz zaruci spravnou hodnotu}
      exit; {cela funce Cisla je v tuto chvili zastavena, protoze pres toto rozhodovani se dostane pouze tehdy, kdyz se zpracovani nachazi na nejnizsi urovni zavorek - lze tedy normalne nacist cislo}
    end;
 
    {zacatek - zpracovani funkci}  {pokud se funkce Cislo postupne rekurzivnim volanim dostane az na nejnizsi uroven zavorek, je mozne ze narazi misto cisel na nejakou funkci se svym parametrem, ktery je v zavorce - v takovem pripade se algoritmus presmeruje do zpracovani dane funkce, opet bude nutne vyhodnotit parametr v zavorce pomoci funkci Zavorka a Vyhodnoceni, ktere se zase mohou rekurzivne volat...}
    {signum}
    if ZacinaPodretezcem('SGN',retezec) then {vyhodnoti zda posloupnost znaku odpovida dane funkci}
      begin
        obsahzavorky:=Zavorky(retezec); {nacteni parametru, ktery je v zavorce}
        if chyba>0 then exit; {pokud funkce Zavorky nahlasi chybu, cela funkce Cislo je prerusena}
        if obsahzavorky='' then begin Selhani(3); exit; end; {pokud je parametr prazdny, dojde k selhani a cela funkce Cislo je prerusena}
        vyslednahodnota:=Vyhodnoceni(obsahzavorky); {zjisteni hodnoty parametru}
        {nasledujici cast je pro kazdou funkci charakteristicka}
        if vyslednahodnota>0 then vyslednahodnota:=1;
        if vyslednahodnota<0 then vyslednahodnota:=-1;
        {dale je zase spolecne zpracovani}
        Cislo:=vyslednahodnota*znamenko; {korekce vysledne hodnoty podle znamenka v pameti}
        exit; {ukonceni funkce Cisla}
      end;
 
    {absolutni hodnota}
    if ZacinaPodretezcem('ABS',retezec) then
      begin
        obsahzavorky:=Zavorky(retezec);
        if chyba>0 then exit;
        if obsahzavorky='' then begin Selhani(3); exit; end;
        vyslednahodnota:=Vyhodnoceni(obsahzavorky);
        if vyslednahodnota<0 then vyslednahodnota:=-vyslednahodnota;
        Cislo:=vyslednahodnota*znamenko;
        exit;
      end;
 
    {druha mocnina}
    if ZacinaPodretezcem('SQR',retezec) then
      begin
        obsahzavorky:=Zavorky(retezec);
        if chyba>0 then exit;
        if obsahzavorky='' then begin Selhani(3); exit; end;
        vyslednahodnota:=Vyhodnoceni(obsahzavorky);
        vyslednahodnota:=sqr(vyslednahodnota);
        Cislo:=vyslednahodnota*znamenko;
        exit;
      end;
 
    {druha odmocnina}
    if ZacinaPodretezcem('SQRT',retezec) then
      begin
        obsahzavorky:=Zavorky(retezec);
        if chyba>0 then exit;
        if obsahzavorky='' then begin Selhani(3); exit; end;
        vyslednahodnota:=Vyhodnoceni(obsahzavorky);
        if vyslednahodnota<0 then begin Selhani(7); exit; end;
        vyslednahodnota:=sqrt(vyslednahodnota);
        Cislo:=vyslednahodnota*znamenko;
        exit;
      end;
 
    {logaritmus naturalis}
    if ZacinaPodretezcem('LN',retezec) then
      begin
        obsahzavorky:=Zavorky(retezec);
        if chyba>0 then exit;
        if obsahzavorky='' then begin Selhani(3); exit; end;
        vyslednahodnota:=Vyhodnoceni(obsahzavorky);
        if vyslednahodnota<=0 then begin Selhani(7); exit; end;
        vyslednahodnota:=ln(vyslednahodnota);
        Cislo:=vyslednahodnota*znamenko;
        exit;
      end;
 
    {logaritmus o zakladu 10}
    if ZacinaPodretezcem('LOG',retezec) then
      begin
        obsahzavorky:=Zavorky(retezec);
        if chyba>0 then exit;
        if obsahzavorky='' then begin Selhani(3); exit; end;
        vyslednahodnota:=Vyhodnoceni(obsahzavorky);
        if vyslednahodnota<=0 then begin Selhani(7); exit; end;
        vyslednahodnota:=ln(vyslednahodnota)/ln(10);
        Cislo:=vyslednahodnota*znamenko;
        exit;
      end;
 
    {Ludolfovo cislo}
    if ZacinaPodretezcem('PI',retezec) then
      begin
        obsahzavorky:=Zavorky(retezec);
        if chyba>0 then exit;
        if obsahzavorky<>'' then begin Selhani(3); exit; end;
        vyslednahodnota:=Pi;
        Cislo:=vyslednahodnota*znamenko;
        exit;
      end;
 
    {Eulerovo cislo}
    if ZacinaPodretezcem('EXP',retezec) then
      begin
        obsahzavorky:=Zavorky(retezec);
        if chyba>0 then exit;
        if obsahzavorky<>'' then begin Selhani(3); exit; end;
        vyslednahodnota:=exp(1);
        Cislo:=vyslednahodnota*znamenko;
        exit;
      end;
 
    {sinus}
    if ZacinaPodretezcem('SIN',retezec) then
      begin
        obsahzavorky:=Zavorky(retezec);
        if chyba>0 then exit;
        if obsahzavorky='' then begin Selhani(3); exit; end;
        vyslednahodnota:=Vyhodnoceni(obsahzavorky);
        vyslednahodnota:=sin(vyslednahodnota);
        Cislo:=vyslednahodnota*znamenko;
        exit;
      end;
 
    {cosinus}
    if ZacinaPodretezcem('COS',retezec) then
      begin
        obsahzavorky:=Zavorky(retezec);
        if chyba>0 then exit;
        if obsahzavorky='' then begin Selhani(3); exit; end;
        vyslednahodnota:=Vyhodnoceni(obsahzavorky);
        vyslednahodnota:=cos(vyslednahodnota);
        Cislo:=vyslednahodnota*znamenko;
        exit;
      end;
 
    {tangens}
    if ZacinaPodretezcem('TAN',retezec) then
      begin
        obsahzavorky:=Zavorky(retezec);
        if chyba>0 then exit;
        if obsahzavorky='' then begin Selhani(3); exit; end;
        vyslednahodnota:=Vyhodnoceni(obsahzavorky);
        if cos(vyslednahodnota)=0 then begin Selhani(7); exit; end;
        if abs(cos(vyslednahodnota))<1E-35 then vyslednahodnota:=nekonecno else vyslednahodnota:=sin(vyslednahodnota)/cos(vyslednahodnota);
        Cislo:=vyslednahodnota*znamenko;
        exit;
      end;
 
    {arcus sinus}
    if ZacinaPodretezcem('ARCSIN',retezec) then
      begin
        obsahzavorky:=Zavorky(retezec);
        if chyba>0 then exit;
        if obsahzavorky='' then begin Selhani(3); exit; end;
        vyslednahodnota:=Vyhodnoceni(obsahzavorky);
        if ((vyslednahodnota<=-1) or (vyslednahodnota>=1)) then begin Selhani(7); exit; end;
        vyslednahodnota:=arcsin(vyslednahodnota);
        Cislo:=vyslednahodnota*znamenko;
        exit;
      end;
 
    {arcus cosinus}
    if ZacinaPodretezcem('ARCCOS',retezec) then
      begin
        obsahzavorky:=Zavorky(retezec);
        if chyba>0 then exit;
        if obsahzavorky='' then begin Selhani(3); exit; end;
        vyslednahodnota:=Vyhodnoceni(obsahzavorky);
        if ((vyslednahodnota<=-1) or (vyslednahodnota>=1)) then begin Selhani(7); exit; end;
        vyslednahodnota:=arccos(vyslednahodnota);
        Cislo:=vyslednahodnota*znamenko;
        exit;
      end;
 
    {arcus tangens}
    if ZacinaPodretezcem('ARCTAN',retezec) then
      begin
        obsahzavorky:=Zavorky(retezec);
        if chyba>0 then exit;
        if obsahzavorky='' then begin Selhani(3); exit; end;
        vyslednahodnota:=Vyhodnoceni(obsahzavorky);
        vyslednahodnota:=arctan(vyslednahodnota);
        Cislo:=vyslednahodnota*znamenko;
        exit;
      end;
    {konec - zpracovani funkci}
 
  hodnota:=''; {vycisteni promenne, do ktere se budou nacitat cisla}
  for opakovani:=1 to length(retezec) do  {od zacatku do konce vstupniho retezce se proveruje, zda jsou dane prvky cisla}
    begin
      if {(retezec[opakovani]>='0') and (retezec[opakovani]<='9')} (retezec[opakovani] in ['0'..'9','.']) then hodnota:=hodnota+retezec[opakovani] {jestli jsou prvky cisla, budou se postupne pridavat do podretezce}
      else break; {jakmile se narazi na prvni prvek, ktery neni cislem, cyklus se zastavi a v promenne opakovani zustane ulozeno misto prvniho neciselneho prvku}
    end;
  retezec:=copy(retezec,opakovani,255); {retezec se sam do sebe zkopiruje od prvniho neciselneho prvku az do konce}
  if hodnota='' then {pokud v celem vstupnim retezci nebylo ani jedno cislo, je treba overit zda se nejedna o promennou - pokud se nejedna ani o promennou, funkce konci selhanim a dale nepokracuje}
    begin
      testpromenne:=copy(retezec,1,1); {prvni znak retezce se izoluje}
      retezec:=copy(retezec,2,255); {retezec se o vyjmuty znak zkrati}
      if Promenna(testpromenne)<>' ' then {pokud test promenne konci pozitivne, je treba danou promennou nacist}
        begin
          Cislo:=promenne[Promenna(testpromenne)]*znamenko; {funkci Cislo je prirazena hodnota dane promenne z pole promennych, samozrejmosti je nasobeni znamenkem}
          exit; {funkci Cislo byla prirazena hodnota, neni tedy nutne dale pokracovat}
        end;
      Selhani(5); {pokud se o promennou nejednalo, kod selhani bude ulozen do globalni promenne chyba}
      exit; {predcasne ukonceni cele funkce Cislo}
    end;
  val(hodnota,vyslednahodnota,opakovani); {vznikly retezec slozeny s cisel (muze zacinat zapornym operatorem) bude nyni preveden na cislo, pokud by doslo k chybe (coz ale kvuli predchozim podminkam nemuze) bylo by misto v retezci, ktere nelze vycislit ulozeno do promenne opakovani}
  Cislo:=vyslednahodnota*znamenko; {zaverecne prirazeni vysledne hodnoty funkci - znamenko hodnotu opravi tak, aby odpovidala puvodnimu vyrazu}
end;
 
function TypOperatoru(var retezec:string):integer; {volanim procedury ZacinaPodretezcem porovnava postupne vsechny definovane operatory se zacatkem vstupniho retezce - pokud nektery nalezne, procedura ZacinaPodretezcem jej ze vstupniho retezce vyjme a umozni, aby funkci Operator bylo prirazeno prislusne identifikacni cislo obsahujici informaci o priorite}
begin
  OdstranitMezery(retezec); {pokud jsou na zacatku vstupniho retezce mezery, dojde k jejich odstraneni}
  {pokud budou nektere opratory slozeny z vice znaku, musi byt umisteny na zacatku seznamu!!!}
  {jakmile se jeden oparator nalezne, prubeh funkce je prerusen}
  if ZacinaPodretezcem('DIV',retezec)=true then begin TypOperatoru:=21; exit; end;
  if ZacinaPodretezcem('MOD',retezec)=true then begin TypOperatoru:=22; exit; end;
  if ZacinaPodretezcem('=',retezec)=true then begin TypOperatoru:=0; exit; end;
  if ZacinaPodretezcem('+',retezec)=true then begin TypOperatoru:=10; exit; end;
  if ZacinaPodretezcem('-',retezec)=true then begin TypOperatoru:=11; exit; end;
  if ZacinaPodretezcem('*',retezec)=true then begin TypOperatoru:=20; exit; end;
  if ZacinaPodretezcem('/',retezec)=true then begin TypOperatoru:=23; exit; end;
  if ZacinaPodretezcem('^',retezec)=true then begin TypOperatoru:=30; exit; end;
  Selhani(4); {pokud neni zadny definovany operator nalezen, funkce konci selhanim}
end;
 
function Vyhodnoceni(retezec:string):real; {pri vyuziti vsech vyse zminenych procedur a funkci urci vyslednou hodnotu vyrazu zadaneho uzivatelem}
var cisla:zasobnik1; {zasobnik pro cisla}
    operatory:zasobnik2; {zasobnik pro operatory}
    c:real; {promenna, do ktere se ze zasobniku pro cisla budou nacitat prvky}
    o:integer; {promenna, do ktere se ze zasobniku pro operatory budou nacitat prvky}
    pozice:integer; {pomocna promenna pro nalezeni pozice znaku '='}
    znak:char; {bude docasne nest identitu pripadne promenne ve vyhodnocovanem retezci}
    cast1,cast2:string; {promenne pro rozsekani retezce na cast pred a po znaku '='}
begin
  {zacatek overeni, zda je zpracovavany vyraz prirazenim do promenne nebo je pozadovan primo vysledek}
  pozice:=pos('=',retezec); {pokus o nalezeni znaku '=' ve vstupnim retezci - jeho pozice je ulozena do promenne}
  if pozice>0 then {pokud obsahuje '=', jde zrejme o prirazeni}
    begin
      cast1:=copy(retezec,1,pozice-1); {do cast1 se ulozi znaky pred '='}
      cast2:=copy(retezec,pozice+1,255); {do cast2 se ulozi znaky za '='}
      znak:=Promenna(cast1); {znaky pred '=' jsou otestovany, zda se nejedna o promennou}
      if znak=' ' then {pokud je test kontroly promenne negativni, je podano chybove hlaseni}
        begin
          chyba:=6; {kod chyby}
          exit; {predcasne ukonceni celeho zpracovani}
        end;
      promenne[znak]:=Vyhodnoceni(cast2); {pokud se overeni povedlo, rekurzivne se vyhodnoti cast za '=' a vysledek se priradi do pole promennych na pozadovane misto}
      Vyhodnoceni:=promenne[znak]; {cela funkce Vyhodnoceni vrati hodnotu prave vypoctene promenne}
      exit; {pokud se jednalo o prirazeni promenne, dalsi vypocet neni potreba, takze proces je prerusen}
    end;
  {konec overeni}
 
  retezec:=retezec+'='; {mechanismus pozaduje aby byl v retezci cely pocet usporadanych dvojic [cislo,operator]}
  Inicializovat1(cisla); {vynulovani prislusneho zasobniku}
  Inicializovat2(operatory); {vynulovani prislusneho zasobniku}
  Selhani(0); {prozatim je vse v poradku}
  while chyba=0 do
    begin
      c:=Cislo(retezec); {ze vstupniho retezce se nacte cislo}
      if chyba<>0 then break; {pokud procedura Cislo nahlasi chybu, cely vyhodnocovaci proces je ukoncen - tato chyba je nahlasena take pri uplnem zpracovani retezce a slouzi jako ukonceni celeho algoritmu}
      o:=TypOperatoru(retezec); {ze vstupniho retezce se nacte operator}
      if chyba<>0 then break;
      Vlozit1(cisla,c); {do ciselneho zasobniku je vlozeno nactene cislo}
      if Prazdny2(operatory)=false then {pokud jiz v operatorovem zasobniku cekaji operatori, musi se nejdriv pred vlozenim noveho zpracovat podle priority}
        begin
          while Priorita(Nacist2(operatory))>=Priorita(o) do {dokud je priorita posledniho operatoru z operatoroveho zasobniku vetsi nebo rovna priorite soucasne nacteneho operatoru ze vstupniho retezce, tak se prednostne provadeji operace s operatori zasobniku}
            begin
              Operace(cisla,Vyjmout2(operatory)); {provede se operace se dvema nejvyssimi cisli v cislovem zasobniku, ktera je definovana operatorem z operatoroveho zasobniku}
              if Prazdny2(operatory)=true then break; {pokud je operatorovy zasobnik zcela vycerpan, cyklus je prerusen}
            end;
        end;
      Vlozit2(operatory,o); {po tom, co se bud provedli vsechny vice prioritni operace nebo byl operatorovy zasobnik vycerpan, lze jiz vlozit soucasne nacteny operator do operatoroveho zasobniku}
    end;
  Vyhodnoceni:=Vyjmout1(cisla); {po probehnuti vsech operaci je v ciselnem uz pouze vysledek celeho vyrazu - lze jej tedy priradit funkci}
  if chyba=1 then Selhani(0); {ukonceni retezce prazdnotou ve skutecnosti neni chyba}
  if chyba>1 then Vyhodnoceni:=0; {pokud je nahlasena jina chyba vysledek je urcite spatne a proto se resetuje}
end;
 
function Vyraz(retezec:string;var hlaseni:integer):real; {pomocna funkce kvuli lepsimu pouziti funkce Vyhodnoceni v programu}
begin
  Vyraz:=Vyhodnoceni(retezec); {prirazeni vysledek celeho procesu funkci}
  hlaseni:=chyba; {kod chyby je ulozen do vystupni promenne}
end;
 
{konec - interpretace vyrazu}
 
{zacatek - reseni rovnice}
 
procedure Bisekce(retezec:string;krok,leva,prava:real);
var stred,delka:real;
    l,r:real;
    hodnota1,hodnota2:real;
    help1,help2:integer;
begin
  l:=leva;
  r:=prava;
  repeat
    delka:=abs(r-l);
    stred:=(l+r)/2;
    repeat
      promenne['X']:=stred;
      hodnota1:=Vyraz(retezec,help1);
      if help1>2 then stred:=stred+krok;
    until help1<2;
    repeat
      promenne['X']:=l;
      hodnota2:=Vyraz(retezec,help2);
      if help2>2 then stred:=l+krok;
    until help2<2;
    if (hodnota1*hodnota2)<0 then r:=stred
    else l:=stred;
  until ((delka<krok) or (abs(hodnota1)<krok));
  pocetkorenu:=pocetkorenu+1;
  if pocetkorenu>50 then begin preteceni:=true; delline; GotoXY(WhereX,WhereY-1); exit; end;
  pruseciky[pocetkorenu]:=stred;
end;
 
procedure RegulaFalsi(retezec:string;krok,leva,prava:real);
var prusecik,delka:real;
    l,r:real;
    hodnota1,hodnota2:real;
    help1,help2:integer;
begin
  l:=leva;
  r:=prava;
  repeat
    delka:=abs(r-l);
    repeat
      promenne['X']:=l;
      hodnota1:=Vyraz(retezec,help1);
      if help1>2 then l:=l+krok;
    until help1<2;
    repeat
      promenne['X']:=r;
      hodnota2:=Vyraz(retezec,help2);
      if help2>2 then r:=r-krok;
    until help2<2;
    if hodnota1-hodnota2<>0 then prusecik:=l-hodnota1*((r-l)/(hodnota2-hodnota1))
    else prusecik:=l-hodnota1*((r-l)/(0.00000001));
    repeat
      promenne['X']:=prusecik;
      hodnota2:=Vyraz(retezec,help2);
      if help2>2 then prusecik:=prusecik+krok;
    until help2<2;
    if (hodnota2*hodnota1)<0 then r:=prusecik
    else l:=prusecik;
  until ((delka<krok) or (abs(hodnota1)<krok));
  pocetkorenu:=pocetkorenu+1;
  if pocetkorenu>50 then begin preteceni:=true; delline; GotoXY(WhereX,WhereY-1); exit; end;
  pruseciky[pocetkorenu]:=prusecik;
end;
 
procedure Newton(retezec:string;krok,leva,prava:real);
var stary,novy:real;
    l,r:real;
    hodnota1,hodnota2:real;
    help1,help2:integer;
begin
  l:=leva;
  r:=prava;
  stary:=(l+r)/2;
  repeat
    repeat
      promenne['X']:=stary-krok;
      hodnota1:=Vyraz(retezec,help1);
      if help1>2 then stary:=stary-krok;
    until help1<2;
    repeat
      promenne['X']:=stary+krok;
      hodnota2:=Vyraz(retezec,help2);
      if help2>2 then stary:=stary+krok;
    until help2<2;
    if hodnota1-hodnota2<>0 then novy:=(stary-krok)-hodnota1*(((stary+krok)-(stary-krok))/(hodnota2-hodnota1))
    else novy:=(stary-krok)-hodnota1*(((stary+krok)-(stary-krok))/(0.00000001));
    stary:=novy;
    repeat
      promenne['X']:=novy;
      hodnota2:=Vyraz(retezec,help2);
      if help2>2 then novy:=novy+krok;
    until help2<2;
  until abs(hodnota2)<krok;
  pocetkorenu:=pocetkorenu+1;
  if pocetkorenu>50 then begin preteceni:=true; delline; GotoXY(WhereX,WhereY-1); exit; end;
  pruseciky[pocetkorenu]:=novy;
end;
 
procedure Jednoducha(retezec:string;krok,leva,prava:real;rezim:byte);
var l,r:real;
    hodnota1,hodnota2:real;
    help1,help2:integer;
    nacitani:string;
    s1,s2,v1,v2,m1,m2,h1,h2:word;
begin
  l:=leva;
  if rezim=1 then r:=leva+krok
  else r:=leva+0.1;
  writeln;
  nacitani:='.';
  textcolor(10);
  gettime(h1,m1,v1,s1);
  repeat
    promenne['X']:=l;
    hodnota1:=Vyraz(retezec,help1);
    promenne['X']:=r;
    hodnota2:=Vyraz(retezec,help2);
    if (((hodnota1*hodnota2)<=0) and (help1<2) and (help2<2)) then
      begin
        if rezim=1 then
          begin
            pocetkorenu:=pocetkorenu+1;
            if pocetkorenu>50 then begin preteceni:=true; delline; GotoXY(WhereX,WhereY-1); exit; end;
            pruseciky[pocetkorenu]:=(l+r)/2;
          end
        else
          begin
            case rezim of
              2: Bisekce(retezec,krok,l,r);
              3: RegulaFalsi(retezec,krok,l,r);
              4: Newton(retezec,krok,l,r)
            end;
            if pocetkorenu>50 then begin exit; end;
          end;
      end;
    gettime(h2,m2,v2,s2);
    if ((nacitani='.') and (((h2*60*60*100+m2*60*100+v2*100+s2)-(h1*60*60*100+m1*60*100+v1*100+s1))=100)) then begin GotoXY(WhereX-9,WhereY); clreol; nacitani:='..'; write('Pocitam ',nacitani); gettime(h1,m1,v1,s1); end;
    if ((nacitani='..') and (((h2*60*60*100+m2*60*100+v2*100+s2)-(h1*60*60*100+m1*60*100+v1*100+s1))=100)) then begin GotoXY(WhereX-10,WhereY); clreol; nacitani:='...'; write('Pocitam ',nacitani); gettime(h1,m1,v1,s1); end;
    if ((nacitani='...') and (((h2*60*60*100+m2*60*100+v2*100+s2)-(h1*60*60*100+m1*60*100+v1*100+s1))=100)) then begin GotoXY(WhereX-11,WhereY); clreol; nacitani:='.'; write('Pocitam ',nacitani); gettime(h1,m1,v1,s1); end;
    l:=r;
    if rezim=1 then r:=r+krok
    else r:=r+0.1;
  until r>=prava;
  delline;
  GotoXY(WhereX,WhereY-1);
end;
 
{konec - reseni rovnice}
 
{zacatek - interface}
 
procedure Kalkulator;
var mista:integer;
    nacteni:string;
    neplatnost:integer;
begin
  mista:=3;
  writeln;
  textcolor(15);
  write('Pocet desetinnych mist vysledku (default=3): ');
  textcolor(11);
  readln(nacteni);
  if nacteni<>'' then val(nacteni,mista,neplatnost);
  if neplatnost>0 then mista:=3;
  repeat
    writeln;
    textcolor(15);
    write('Zadej vyraz: ');
    textcolor(14);
    readln(vstup);
    if vstup='' then break;
    x:=Vyraz(vstup,chyba);
    if chyba=0 then writeln(vstup,'=',x:5:mista)
    else begin textcolor(12); writeln ('Chyba: ',ChyboveHlaseni(chyba)); end;
  until false;
end;
 
procedure Koreny;
var mista:integer;
    nacteni:string;
    neplatnost:integer;
    q:integer;
    kontrola:boolean;
    presnost,levamez,pravamez:real;
begin
  mista:=3;
  writeln;
  textcolor(15);
  write('Pocet desetinnych mist vysledku (default=3): ');
  textcolor(11);
  readln(nacteni);
  if nacteni<>'' then val(nacteni,mista,neplatnost);
  if neplatnost>0 then mista:=3;
  repeat
    writeln;
    pocetkorenu:=0;
    preteceni:=false;
    repeat
      kontrola:=true;
      textcolor(15);
      write('Zadej rovnici: ');
      textcolor(14);
      write('0=');
      readln(vstup);
      promenne['Z']:=1;
      x:=Vyraz(vstup,chyba);
      if ((chyba>=3) and (chyba<=6)) then kontrola:=false;
      for q:=1 to length(vstup) do
        begin
          if vstup[q]='=' then kontrola:=false;
        end;
      if vstup='' then kontrola:=true;
      if kontrola=false then begin textcolor(12); writeln ('Chyba: Spatne zadana rovnice'); writeln; end;
    until kontrola=true;
    if vstup='' then break;
    textcolor(15);
    presnost:=0;
    writeln;
    write('Zadej presnost (default=0.001): ');
    textcolor(11);
    readln(nacteni);
    if nacteni<>'' then val(nacteni,presnost,neplatnost);
    if presnost=0 then neplatnost:=1;
    if neplatnost>0 then presnost:=0.001;
    writeln;
    textcolor(15);
    write('Zadej levou mez (default=-10): ');
    textcolor(11);
    readln(nacteni);
    if nacteni<>'' then val(nacteni,levamez,neplatnost);
    if neplatnost>0 then levamez:=-10;
    repeat
      writeln;
      textcolor(15);
      write('Zadej pravou mez (default=10): ');
      textcolor(11);
      readln(nacteni);
      if nacteni<>'' then val(nacteni,pravamez,neplatnost);
      if neplatnost>0 then pravamez:=10;
      if pravamez<(levamez+presnost) then begin textcolor(12); writeln ('Chyba: Spatne zadane meze'); textcolor(15); end;
    until pravamez>=(levamez+presnost);
    repeat
      begin
        writeln;
        textcolor(15);
        writeln('Jakou numerickou metodu chcete pouzit?');
        writeln('(1) Jednoduche projiti intervalu');
        writeln('(2) Bisekce (puleni intervalu)');
        writeln('(3) Regula falsi (metoda secen)');
        writeln('(4) Newton (metoda tecen)');
        write('Volba: ');
        textcolor(11);
        readln(volba);
      end;
    until ((volba>=1) and (volba<=4));
    case volba of
      1: Jednoducha(vstup,presnost,levamez,pravamez,1);
      2: Jednoducha(vstup,presnost,levamez,pravamez,2);
      3: Jednoducha(vstup,presnost,levamez,pravamez,3);
      4: Jednoducha(vstup,presnost,levamez,pravamez,4)
    end;
    writeln;
    textcolor(15);
    if preteceni=true then writeln('Rovnice ma nekonecne mnoho reseni (nebo vice nez 50)') else
      begin
        if pocetkorenu=0 then writeln('Rovnice nema reseni v R') else
          begin
            textcolor(14);
            for q:=1 to pocetkorenu do writeln('X',q,'=',pruseciky[q]:5:mista);
          end;
      end;
  until false;
end;
 
procedure Napoveda;
begin
  textcolor(10);
  writeln; writeln('-=NAPOVEDA=-');
  writeln; writeln('1) Operatory');
  writeln('+     priklad: a+b      akce: soucet'); writeln('-     priklad: a-b      akce: rozdil');
  writeln('*     priklad: a*b      akce: soucin'); writeln('/     priklad: a/b      akce: podil');
  writeln('div   priklad: a div b  akce: celociselne deleni'); writeln('mod   priklad: a mod b  akce: zbytek celociselneho deleni cisel');
  writeln('^     priklad: a^b      akce: umocneni'); writeln('=     priklad: a=5      akce: prirazeni hodnoty do promenne');
  writeln; writeln('2) Funkce');
  writeln('- kazda funkce ma v zavorce svuj parametr - napr.:  sqrt(2)');
  writeln('sgn      akce: signum'); writeln('abs      akce: absolutni hodnota');
  writeln('sqr      akce: druha mocnina'); writeln('sqrt     akce: druha odmocnina');
  writeln('ln       akce: prirozeny logaritmus'); writeln('log      akce: logaritmus o zakladu 10');
  writeln('sin      akce: sinus, parametr zadavat v radianech'); writeln('cos      akce: cosinus, parametr zadavat v radianech'); writeln('tan      akce: tangens, parametr zadavat v radianech');
  writeln('arcsin   akce: arcus sinus'); writeln('arccos   akce: arcus cosinus'); writeln('arctan   akce: arcus tangens');
  writeln; writeln('3) Konstanty');
  writeln('exp      akce: Eulerovo cislo'); writeln('pi       akce: Ludolfovo cislo');
  writeln; writeln('4) Promenne');
  writeln('- pismena A az Z jsou vyhrazena jako pametove promenne');
  writeln('- zapis prirazeni do promenne: a=vyraz');
  writeln; writeln('5) Syntax');
  writeln('- povolene znaky: promenne, operatory, funkce, cisla, desetinna tecka, zavorky');
  writeln('- funkce musi mit svuj parametr v zavorce');
  writeln('- v rezimu reseni rovnic se za promennou povazuje znak "x"');
  writeln('- prazdny vstup vyrazu nebo rovnice vrati program do hlavni nabidky');
end;
 
{konec - interface}
 
{zacatek - vlastni program}
 
begin
  for i:='A' to 'Z' do promenne[i]:=0; {vynulovani pole promennych}
  clrscr;
  writeln('SOLVER - interpreter vyrazu a iteracni reseni rovnic');
  writeln('Copyright (c) 2007 Petr Koupy');
  repeat
    repeat
      begin
        writeln;
        textcolor(7);
        writeln('Co chcete provest?');
        writeln('(1) Zapnout kalkulator');
        writeln('(2) Nalezt koreny rovnice');
        writeln('(3) Zobrazit pamet');
        writeln('(4) Vynulovat pamet');
        writeln('(5) Zobrazit napovedu');
        writeln('(6) Ukoncit program');
        write('Volba: ');
        textcolor(11);
        readln(volba);
      end;
    until ((volba>=1) and (volba<=6));
    case volba of
      1: Kalkulator;
      2: Koreny;
      3: begin writeln; textcolor(14); for i:='A' to 'Z' do writeln(i,'=',promenne[i]:5:3); textcolor(7); end;
      4: begin for i:='A' to 'Z' do promenne[i]:=0; writeln; textcolor(15); writeln('Pamet vynulovana...'); textcolor(7); end;
      5: Napoveda;
      6: break
    end;
  until false;
end.
 
{konec - vlastni program}