Převod čísel na slovní vyjádření a obráceně.

zapliner.pas

{
# Copyright 2008 Ondřej "Kedrigern" Profant < ondrej.profant (*) gmail.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA 02110-1301, USA.
}
program zapoctak;
uses crt;
var {DEFINOVANI zakladnich cisel}
 
zakladni_cisla : array[0..27] of string[10] =
('nula','jedna','dva','tri','ctyri','pet','sest','sedm','osm','devet',	
'deset','jedenact','dvanact','trinact','ctrnact','patnact','sestnact','sedmnact','osmnact','devatenact',
'dvacet','tricet','ctyricet','padesat','sedesat','sedmdesat','osmdesat','devadesat');
 
 
{VSTUP - ruzne reprezentace, kazda vhodna na neco jineho}
 
vstup_string : string[40]; {vstup reprezentovany stringem}
vstup_int : longint; {vstup reprezentovany integerem}
vstup_pole : array[1..10] of byte; {vstup reprezentovany polem, obracene}
des_pole : array[1..10] of byte; {desetinna mista reprezentovana polem}
rad : byte; {pocet cifer vstupu pred desetinnou carkou}
des_rad : byte; {pocet cifer vstupu za desetinnou carkou}
 
{POMOCNE promene}
 
pom : char; {pomocna znakova promena}
i, j : byte; {citac pro pole}
smer,preskoc : boolean ; {ridi smer prevodu}
 
 
 
{( --- PROCEDURY --- )}	
 
{pomocna funkce, ktera slouci dve sisla v jedno}
 
function make_int_2(x,y:byte):byte;
 
begin
x := 10*x;
make_int_2 := x +y;
end;
 
 
 
{easter eggs :-) }
 
procedure doplneni_konstant;
begin
if (vstup_string[1]='1') and (vstup_string[3]='4') and (vstup_string[4]='1') then
begin
writeln('Priblizne odmocnina ze dvou.');
writeln('Zde je o neco presneji: 1,41421 3562...');
end;
if (vstup_string[1]='2') and (vstup_string[3]='7') and (vstup_string[4]='1') then
begin
writeln('Priblizne Eulerovo cislo, ktere je zakladem prirozeneho logaritmu.');
writeln('Zde je o neco presneji: 2,71828 18284 59045 23536 02874 71352...');
end;
if (vstup_string[1]='3') and (vstup_string[3]='1') and (vstup_string[4]='4') then
begin
if vstup_string[5]='1' then writeln('Priblizne cislo "pi", tzv. Ludolfovo cislo.')
else writeln('Stredoskolsky zaokrouhlene cislo "pi", tzv. Ludolfovo cislo');
writeln('Zde je o neco presneji: 3,14159 26535 89793 23846 26433 83279...');
end;
end;
 
{procedura zobrazazujici 1-9}
 
procedure rad_1(x:byte);
begin	
if x <> 0 then write(zakladni_cisla[x]);
end;
 
{procedura zobrazazujici 10-99}
procedure rad_2(x:byte);
var x_string : string;
x1,x2 : byte;
 
begin
str(x,x_string);
val(x_string[1],x1);
val(x_string[2],x2);
 
{$B+}
if (x >9) and (x < 20) then write(zakladni_cisla[x]); {pokud je prvni rad (ze dvou) mensi nez 2, zobraz rovnou}
if (	(x > 19) and
(x < 50)	) then
begin
rad_1(x1); write('cet ');
if not(x2=0) then rad_1(x2);
end;
{$B-}	
 
if x1=5 then begin write(zakladni_cisla[23]+' '); rad_1(x2) end;
if x1=6 then begin write(zakladni_cisla[24]+' '); rad_1(x2) end;
if x1=7 then begin write(zakladni_cisla[25]+' '); rad_1(x2) end;
if x1=8 then begin write(zakladni_cisla[26]+' '); rad_1(x2) end;
if x1=9 then begin write(zakladni_cisla[27]+' '); rad_1(x2) end;
end;
 
procedure posledni_dvojce;
begin
if vstup_pole[2]=0 then rad_1(vstup_pole[1])
else rad_2(make_int_2(vstup_pole[2],vstup_pole[1]))
end;
 
 
 
{procedura zobrazazujici 100-999}
 
procedure rad_3(x:byte); {pozor parametr je jen stovka!}
 
begin
if x = 1 then write('sto ');
if x = 2 then write('dveste ');
if ((x > 2) and (x < 5)) then begin rad_1(x); write('sta ') end;
if ((x > 4) and (x <=9)) then begin rad_1(x); write('set ') end;
end;
 
 
 
{procedura zobrazazujici 1´000-9´999}
 
procedure rad_4(x:byte;pridat:boolean);
begin
{$B+}
if (pridat and (x=1)) then begin rad_1(x); write(' tisic ') end;
if not(pridat) and (x=1) then write('tisic ');
if ((x > 1) and (x< 5)) then begin rad_1(x); write(' tisice ') end;
if ((x > 4) and (x<=9)) then begin rad_1(x); write(' tisic ') end;
{$B-}
end;
 
 
 
{procedura zobrazazujici 10´000-99´999}
 
procedure rad_5(x:byte);
begin
rad_2(x); write(' tisic ');
end;
 
 
 
{procedura zobrazazujici 100´000-999´999}
 
procedure rad_6(x:integer;dopsat:boolean);
 
begin
rad_3(x);
if dopsat then write('tisic ')
end;
 
 
 
procedure statisice;
 
begin
{$B+}
if (vstup_pole[4]=0) and (vstup_pole[5]=0) and (vstup_pole[6]=0) then
else
begin
if (vstup_pole[4]<>0)and (vstup_pole[5]<>0) then begin rad_6(vstup_pole[6],false);
rad_2(make_int_2(vstup_pole[5],vstup_pole[4])); write(' tisic ') end
 
else
 
begin
 
if (vstup_pole[4]=0) and (vstup_pole[5]=0)	then rad_6(vstup_pole[6],true)	{pokud je rad tisicu (4.) i desetitisicu (5.) = 0, zobraz statisice}
 
else
 
begin
 
if vstup_pole[4]=0 then begin rad_6(vstup_pole[6],false); rad_5(vstup_pole[5]) end	{pokud je rad tisicu (4.)=0 zobraz desetisice}
 
else begin rad_6(vstup_pole[6],false); rad_4(vstup_pole[4],true) end; {jinak je rad desetitisicu (5.)=0 zobraz tisice}
 
end;
 
end;
 
end;
 
{$B-}	
 
end;
 
 
 
{procedura zobrazazujici 1´000´000-9´999´999}
 
procedure rad_7(x:integer;dopsat:boolean);
 
begin
 
if vstup_pole[7]=1 then write('jeden')
 
else if dopsat then rad_1(x);
 
if x = 1 then write(' milion ');
if ((x > 1) and (x< 5)) then begin rad_1(x); write(' miliony ') end;
if ((x > 4) and (x<=9)) then begin rad_1(x); write(' milionu ') end;
 
end;
 
 
 
{procedura zobrazazujici 10´000´000-99´999´999}
 
procedure rad_8(x:byte);
 
begin
 
rad_2(x); write(' milionu ')
 
end;
 
 
 
{procedura zobrazazujici 100´000´000-999´999´999}
 
procedure rad_9(x:byte;dopsat:boolean);
 
begin
 
rad_3(x);
 
if dopsat then write(' milionu ');
 
end;
 
 
 
{procedura zobrazazujici 1´000´000´000-9´999´999´999}
 
procedure rad_10(x:byte);
 
begin
rad_1(x);
{$B+}
if x=1 then begin write(' miliarda '); exit end;
if (1<x) and (x<5) then write(' miliardy ')
else write(' miliard ');
{$B-}
end;
 
 
{zobrazeni napovedy}
 
procedure help;
 
begin
 
writeln; writeln;
 
writeln('ZAKLADNI PRIKAZY:':25);
 
writeln;
write('Prikaz: ':9); writeln('Popis: '); writeln;
write('exit ':9); writeln(' Ukonceni programu.');
write('help ':9); writeln(' Zobrazeni teto napovedy.');
write('otoc ':9); writeln(' Otoceni smeru prevodu cislic. (Pozor! Pouze experimentalni)');
writeln;
writeln('Prikazy maji i dalsi alternativy (napr. exit <=> stop...).');
writeln;
writeln('Ondrej Profant, vytvoreno jako zapoctovy program v roce 2008');
writeln; writeln; writeln;
end;
 
 
 
{PREVOD cisla (integer) na slovni vyjadreni}	{========>>>>>}
 
procedure integer_to_cislo;
 
begin
 
write(' ');
 
 
 
des_rad := 0;
 
 
 
doplneni_konstant; {osetreni konstant - vypise informace pokud se jedna o nejakou casto pouzivanou konstantu}
 
 
 
rad := length(vstup_string); {urceni radu}
 
 
 
{osetreni zaporne hodnoty}
 
if vstup_string[1]='-' then
 
begin
 
write('minus ');
 
for i:=1 to rad-1 do	{posunuti kazdeho znaku o 1 misto doleva}
 
begin
 
vstup_string[i]	:= vstup_string[i+1]	
 
end;
 
dec(vstup_string[0]); {minus zabiral jeden znak}
 
dec(rad);
 
end;
 
 
 
{osetreni destinnych mist}
 
for i:=1 to rad do
 
begin
 
if (vstup_string[i]=',') or
 
(vstup_string[i]='.') then
 
begin
 
for j:= i+1 to rad do
 
begin
 
inc(des_rad);
 
val(vstup_string[j],des_pole[des_rad]); {desetina mista jsou predana do zvlasniho pole} // je neni od jedne!
 
end;
 
for j:= 1 to rad-i+1 do
 
begin
 
dec(vstup_string[0]); {osetreni radu}
 
dec(rad); {osetreni radu}	
 
end;
 
break;
 
end;
 
{pozn. length(vstup_string) se nema zcela rado s intervaly cyklu, proto uzivame (a musime menit) obe hodnoty}
 
end;
 
 
 
val(vstup_string,vstup_int); {prevedeni na cislo}
 
 
 
for i := 0 to rad-1 do	{vlozeni cisla do retezce - obracene}
 
begin
 
pom := vstup_string[i+1];
 
val(pom,vstup_pole[rad-i]);
 
end;
 
 
 
//kontrolni_vystup; {kontrolni vystup pro potreby debugovani}
 
 
 
{--- VYPIS jednotlivych hodnot ---}
 
if rad=1 then rad_1(vstup_int);
if rad=2 then rad_2(vstup_int);
if rad=3 then
begin
 
rad_3(vstup_pole[3]);
 
posledni_dvojce;
 
end;
 
if rad=4 then
begin
rad_4(vstup_pole[4],false);
rad_3(vstup_pole[3]);
posledni_dvojce;
end;
 
if rad=5 then
begin
rad_5(vstup_int div 1000);
rad_3(vstup_pole[3]);
posledni_dvojce;
end;
if rad=6 then
 
begin
 
statisice;
 
rad_3(vstup_pole[3]);
 
posledni_dvojce;
 
end;
 
 
 
if rad=7 then
 
begin
 
rad_7(vstup_pole[7],true);
 
statisice;
 
rad_3(vstup_pole[3]);
 
posledni_dvojce;
 
end;
 
 
 
if rad=8 then
 
begin
 
rad_8(make_int_2(vstup_pole[8],vstup_pole[7]));
 
statisice;
 
rad_3(vstup_pole[3]);
 
posledni_dvojce;
 
end;
 
 
 
if rad=9 then
 
begin
 
if (vstup_pole[8]=0) and (vstup_pole[7]=0)
 
then rad_9(vstup_pole[9],true)
 
else rad_9(vstup_pole[9],false);
 
rad_8(make_int_2(vstup_pole[8],vstup_pole[7]));
 
statisice;
 
rad_3(vstup_pole[3]);
 
posledni_dvojce;
 
end;
 
 
 
if rad=10 then	
 
begin
 
rad_10(vstup_pole[10]);
 
if (vstup_pole[8]=0) and (vstup_pole[7]=0)
 
then rad_9(vstup_pole[9],true)
 
else rad_9(vstup_pole[9],false);
 
rad_8(make_int_2(vstup_pole[8],vstup_pole[7]));
 
statisice;
 
rad_3(vstup_pole[3]);
 
posledni_dvojce;
 
end;
 
 
 
{---VYPIS desetinnych mist---}
 
if not(des_rad=0) then
 
begin
 
write(' celych ');
 
 
 
if des_rad=1 then
 
begin
 
rad_1(des_pole[1]);
 
write(' desetin')
 
end;
 
if des_rad=2 then
 
begin
 
rad_2(make_int_2(des_pole[1],des_pole[2]));
 
write(' setin')
 
end;
 
if des_rad=3 then
 
begin
 
rad_3(des_pole[1]);
 
rad_2(make_int_2(des_pole[2],des_pole[3]));
 
write(' tisicin')
 
end;
 
if des_rad=4 then
 
begin
 
rad_4(des_pole[1],false);
 
rad_3(des_pole[2]);
 
rad_2(make_int_2(des_pole[3],des_pole[4]));
 
write(' desetitisicin')
 
end;
 
if des_rad>4 then
 
begin
 
for i:=1 to length(des_pole) do
 
begin
 
rad_1(des_pole[i]); write(' ')
 
end;
 
end;
 
end;
 
end;
 
 
 
{PREVOD slovniho vyjadreni na cislo (integer)}	{<<<<<========}
 
procedure cislo_to_integer;
 
var x : integer;
 
pom_string : string[30];
 
vystup : array[1..10] of byte = (0,0,0,0,0,0,0,0,0,0); {pole pro vystup, hodnoty se budou ukladat obracne}
 
pom_vystup : array[1..10] of byte;
 
 
 
procedure preved_dve; {prevede "dve" na "dva"}
 
begin
 
for i:=1 to 3 do {vic jak 3x se nemuze vyskytovat}
 
begin
 
x := pos('dve',vstup_string);
 
if x <> 0 then begin	
 
delete(vstup_string,x,3);
 
insert('dva',vstup_string,x);
 
end;
 
x := 0;
 
end;
 
end;
 
 
 
{podprocedury prevodu cisla}
 
procedure vyhledej_rad_1(index1:byte); {procedura ktera vyhledava jednotliva cisla reprezentovana slovne}
 
begin	
 
for i:=1 to 9 do
 
begin
 
if pos(zakladni_cisla[i],pom_string) <> 0 then begin vystup[index1] := i; break end
 
end;
 
end;
 
 
 
procedure zpracuj_stovky(index1:byte);
 
var stovky : array[1..3] of string[3] =('ste','sta','set');
 
begin
 
//writeln('Jsem zavolana (stovky), abych zpracovala retezec: "', pom_string, '" na indexu: ', index1);
 
x := 0;
 
 
 
if pom_string = 'deset' then vystup[2] := 1; {pokud by nebylo zde, stovka by orizla}
 
 
 
{sto je pouze u jedne stovky}
 
if pos('sto',pom_string) <> 0 then begin vystup[index1] := 1; delete(pom_string,1,((pos(stovky[i],pom_string))+3)) end;
 
 
 
{podminka vyhledajici urceni stovek}
 
for i:=1 to 3 do
 
begin	
 
x := pos(stovky[i],pom_string); {najde koncovku stovky v pom string, v x index prvniho vyskytu}	
 
if	x <> 0 then
 
begin
 
vyhledej_rad_1(index1);
 
delete(pom_string,1,(x+3));
 
delete(vstup_string,1,(x+3));
 
exit;
 
end;
 
end;
 
end;
 
 
 
procedure zpracuj_desitky(index1,index2:byte); {index1 je pro desitky, index2 pro jednotky}
 
begin
 
//writeln('Jsem zavolana (desitky), abych zpracovala retezec: "', pom_string, '" na indexu: ', index1,' ',index2);
 
 
 
for i:=27 downto 1 do
 
begin
 
x := pos(zakladni_cisla[i],pom_string);
 
if x <> 0 then break;
 
end; {prvni vyskyt zakladniho cisla / cislovky}
 
if x <> 0 then
 
begin
 
{pro 20 - 99}	if (i>19) then
 
begin
 
delete(pom_string,x,(length(zakladni_cisla[i]))); {vymaz si, co si jiz nasel}
 
vystup[index1] := i-18; {rad desitek nalezen, vepisujeme}
 
for j:=1 to 9 do
 
begin
 
if (pos(zakladni_cisla[j],pom_string)) <> 0 then begin vystup[index2] := j; exit; end	
 
else vystup[index2] := 0;
 
end;
 
exit;
 
end;
 
{pro 10 - 19}	if (i>9) and (i<20) then begin vystup[index1] := 1; vystup[index2] := i-10 end;
 
{pro 01 - 09}	if (i<10) then begin vystup[index1] := 0 ; vystup[index2] := i end;
 
end;
 
end;
 
 
 
procedure osetreni_milionu;
 
begin
 
x := pos('milion',vstup_string); {x nam udava cislo indexu, kde je prvni vyskyt "milion"}
 
{$B+}
 
//writeln('Index prvku s milion: ',x); writeln('Pismeno na nem: ',vstup_string[x]); ('Pismeno na nem: ',vstup_string[x+6]);
 
 
 
if x <> 0 then begin
 
if (vstup_string[x+6] <>'y') and
 
(vstup_string[x+6] <>'u')
 
then
 
begin vystup[7] := 1 end
 
else
 
begin
 
pom_string := copy(vstup_string,1,(pos('milion',vstup_string)-1) ); {do pom_string priradim cisla pred miliony}
 
zpracuj_stovky(9); {dostane v pom_string vsechny stovky pred milionem, zapisuje 9. prvek pole}
 
zpracuj_desitky(8,7); {dostane v pom_string vsechny desitky pred milionem a za stovkou, zapisuje 8 a 7 prvek pole}
 
end;
 
end;
 
{$B-}	
 
if x <> 0 then delete(vstup_string,1,x+6); {promazani vstupniho stringu, pokud byly miliony, tak nyni jsou jiz ve vystupu}	
 
x := 0;
 
delete(pom_string,1,length(pom_string)); {vynuluje cely pomocny string}
 
end;
 
 
 
procedure osetreni_tisicu;
 
begin
 
x := pos('tisic',vstup_string); {x nam udava cislo indexu, kde je prvni vyskyt "tisic"}
 
if x <> 0 then begin
 
pom_string := copy(vstup_string,1,x-1);
 
zpracuj_stovky(6);
 
zpracuj_desitky(5,4);
 
end;
 
 
 
if x <> 0 then delete(vstup_string,1,x+5); {promazani vstupniho stringu, pokud byly tisice, tak nyni jsou jiz ve vystupu}	
 
x := 0;
 
delete(pom_string,1,length(pom_string)); {vynuluje cely pomocny string}
 
end;
 
 
 
procedure osetri_stovky;
 
begin	
 
pom_string := vstup_string;
zpracuj_stovky(3);
zpracuj_desitky(2,1);
 
delete(pom_string,1,length(pom_string)); {vynuluje cely pomocny string}
 
end;
 
 
 
begin
 
preved_dve; {nejdrive je treba udelat substituci dve -> dva, jinak by delalo "dve" bordel}
 
 
 
osetreni_milionu;
 
 
 
osetreni_tisicu;
 
 
 
osetri_stovky;
 
 
 
{obraceni vystupu, aby byl "posmeru"}
 
pom_vystup := vystup;
 
for i:=1 to 10 do vystup[i] := pom_vystup[11-i];
 
 
 
{odtran nuly na zacatku}
 
rad := 9;
 
for i:=1 to 10 do
 
begin
 
if vystup[i] = 0 then dec(rad);
 
if vystup[i] <> 0 then break;
 
end;
 
{vypis}
 
for i:=10-rad to 10 do write(vystup[i]);
 
 
 
{vynulovani promennych}
 
delete(vstup_string,1,length(vstup_string)); {vstupni string}
delete(pom_string,1,length(pom_string)); {pomocny string}
for i:=1 to 10 do vystup[i] := 0; {vystupni pole}
rad := 0;
 
end;
 
 
 
 
 
{( --- TELO PROGRAMU --- )}
 
BEGIN
 
smer := true;
 
 
 
while true do
 
begin
 
writeln('Skoncit prikazem "exit", vyvolat napovedu prikazem "help", jinak ');
 
if smer then write('zadejte cislo cislicemi: ')
 
else write('zadejte cislo slovne: ');
 
 
 
readln(vstup_string);
 
writeln; writeln;
 
 
 
{Ukonceni}
 
if vstup_string='exit' then exit;
if vstup_string='quit' then exit;
if vstup_string='stop' then exit;
if vstup_string='konec' then exit;
 
{Napoveda}
 
if vstup_string='help' then begin help; continue end;
 
if vstup_string='napoveda' then begin help; continue end;
 
 
 
{Prehazovani procedur pro prevod}
preskoc := false;
 
if (vstup_string='otoc') or	
 
(vstup_string='zmen') then
 
begin
 
preskoc := true;
 
if smer then begin smer := false;end
 
else begin smer := true; end;
 
end;
 
if smer then
begin
integer_to_cislo
end
else
begin
cislo_to_integer;
end;
 
{Ukoncovaci sekvence}
writeln; writeln;
writeln;
 
if not preskoc then
begin
writeln('Pro dalsi cislici stisknete libovolnou klavesu, pro ukonceni napiste "exit".');
readln(vstup_string);
end;
 
{Ukonceni}
if vstup_string='exit' then exit;
if vstup_string='quit' then exit;
if vstup_string='stop' then exit;
if vstup_string='konec' then exit;
 
clrscr;
 
end;
END