program prevody;
uses crt;
procedure ZKlogo;
   begin;
   textbackground(0);
   textcolor(13);
   writeln(' ------------------------------------------------------------------------------');
   writeln('                ***  Kamil Zitny as ZK (V1), prevody soustav ***               ');
   writeln(' ------------------------------------------------------------------------------');
   textcolor(7)
   end;
var a,i,bi,bii,biii,biiii,ia,iaa:integer;
    pdsi,pdsii:integer;
    apo:integer;
    px,x:integer;
    xcds,xxx:longint;
    pxx:array[1..32] of integer;
    pxv,xv:integer;
    pxvv,xvv:integer;
    rpx,rx,xko:integer;
    pxc:array[1..32] of integer;
    pmm:integer;
    sjc:integer;
    dsjc:integer;
    cds:longint;
    pdss,pcjj:longint;
    sj:char;
    dsj:char;
    hlp:char;
    ci:char;
    dci:char;
    pcv:char;
    ok:string;
    p:array [1..10] of integer;
    pcj:array [1..10] of integer;
    pds:array [1..10] of longint;
label zcj,dzcj,sjl,dsjl;

begin;
{
Slovo uvodem ---------------------------------------;
}
clrscr;
ZKlogo;
 textcolor(2);
writeln('   Tento program byl zkonstruovan na SPSSE a VOS v Liberci konecem roku 1999.');
 textcolor(7);
writeln;
writeln(' Omezeni programu:');
writeln(' ~~~~~~~~~~~~~~~~~');
writeln('    1) Nejvetsi soustava je "16" a nejmensi "2".');
writeln('    2) Maximalni pocet zadavanych cislic v soustavach.');
writeln('');
writeln('                         16,15 --------- 7');
writeln('                         14,13,12,11 --- 8');
writeln('                         10,9 ---------- 9');
writeln('                         8,7,6,5,4,3,2 - 10');
writeln(' Prubeh programu:');
writeln(' ~~~~~~~~~~~~~~~~');
writeln('    1) Zadate jake soustavy budete vkladat cislo.');
writeln('    2) Vlozite cislo.');
writeln('    3) Zadate do jake soustavy se ma provest konvert.');
writeln('    4) Muzete zvolite "A" pro vypis poli cisel.');
writeln('');
 textcolor(12);
writeln(' ---- POZOR ---- Vlozena cisla uz nejdou smazat.');
writeln('                 Programem musite projit az do konec.');
 textcolor(7);
writeln('');
write(' Pro pokracovani stisknete klavesu ...');
delay(5000);
hlp:=readkey;
writeln;
{
Soustava 1 ---------------------------------------;
}
sjl:;
clrscr;
ZKlogo;
writeln;
writeln(' Prvni cislo bude soustavy?');
write(' Vkladane cislo: ');

sj:=readkey;

{
if sj='0' then begin;
               pmm:=10;
               ok:='ok';
               sjc:=0;
               end;
if sj='1' then begin
               pmm:=10;
               ok:='ok';
               sjc:=1;
               end;
}
if sj='2' then begin
               pmm:=10;
               ok:='ok';
               sjc:=2;
               end;
if sj='3' then begin
               pmm:=10;
               ok:='ok';
               sjc:=3;
               end;
if sj='4' then begin
               pmm:=10;
               ok:='ok';
               sjc:=4;
               end;
if sj='5' then begin
               pmm:=10;
               ok:='ok';
               sjc:=5;
               end;
if sj='6' then begin
               pmm:=10;
               ok:='ok';
               sjc:=6;
               end;
if sj='7' then begin
               pmm:=10;
               ok:='ok';
               sjc:=7;
               end;
if sj='8' then begin
               pmm:=9;
               ok:='ok';
               sjc:=8;
               end;
if sj='9' then begin
               pmm:=9;
               ok:='ok';
               sjc:=9;
               end;
if sj='a' then begin
               pmm:=9;
               ok:='ok';
               sjc:=10;
               end;
if sj='A' then begin
               pmm:=9;
               ok:='ok';
               sjc:=10;
               end;
if sj='b' then begin
               pmm:=8;
               ok:='ok';
               sjc:=11;
               end;
if sj='B' then begin
               pmm:=8;
               ok:='ok';
               sjc:=11;
               end;
if sj='c' then begin
               pmm:=8;
               ok:='ok';
               sjc:=12;
               end;
if sj='C' then begin
               pmm:=8;
               ok:='ok';
               sjc:=12;
               end;
if sj='d' then begin
               pmm:=8;
               ok:='ok';
               sjc:=13;
               end;
if sj='D' then begin
               pmm:=8;
               ok:='ok';
               sjc:=13;
               end;
if sj='e' then begin
               pmm:=8;
               ok:='ok';
               sjc:=14;
               end;
if sj='E' then begin
               pmm:=8;
               ok:='ok';
               sjc:=14;
               end;
if sj='f' then begin
               pmm:=7;
               ok:='ok';
               sjc:=15;
               end;
if sj='F' then begin
               pmm:=7;
               ok:='ok';
               sjc:=15;
               end;
if sj='g' then begin
               pmm:=7;
               ok:='ok';
               sjc:=16;
               end;
if sj='G' then begin
               pmm:=7;
               ok:='ok';
               sjc:=16;
               end;

if ok<>'ok' then begin
                 writeln;
                 writeln;
                 textcolor(12);
                 write('--- Spatne cislo, toto je neplatny znak: --> ');
                 textcolor(2);
                 write(sj);
                 textcolor(12);
                 write(' <-- !!!');
                 textcolor(7);
                 writeln;

                 Sound(220);
                 Delay(200);
                 NoSound;

                 delay(4000);
                 goto sjl;
                 end;
ok:='';
{
Cislo 1 ----------------------------------------;
}

i:=0;
repeat;
for a:=1 to pmm do begin;
zcj:;

clrscr;
ZKlogo;
writeln;
write(' Vlozte cislo v soustave "');
textcolor(2);
write(sjc);
textcolor(7);
write('", zbyva znaku ');
textcolor(2);
write((pmm+1)-a);
textcolor(7);
write(', pro konec "');
textcolor(12);
write('ENTR');
textcolor(7);
writeln('".');
write(' Vkladane cislo: ');

repeat;
for bi:=1 to i do begin;
                  if p[bi]=0 then write('0');
                  if p[bi]=1 then write('1');
                  if p[bi]=2 then write('2');
                  if p[bi]=3 then write('3');
                  if p[bi]=4 then write('4');
                  if p[bi]=5 then write('5');
                  if p[bi]=6 then write('6');
                  if p[bi]=7 then write('7');
                  if p[bi]=8 then write('8');
                  if p[bi]=9 then write('9');
                  if p[bi]=10 then write('A');
                  if p[bi]=11 then write('B');
                  if p[bi]=12 then write('C');
                  if p[bi]=13 then write('D');
                  if p[bi]=14 then write('E');
                  if p[bi]=15 then write('F');
                  end;
until bi=i;

ci:=readkey;

if ci='0' then begin;
               if sjc <= 0 then
               else
               begin;
               i:=i+1;
               p[i]:=0;
               ok:='ok';
               end;
               end;
if ci='1' then begin;
               if sjc <= 1 then
               else
               begin;
               i:=i+1;
               p[i]:=1;
               ok:='ok';
               end;
               end;
if ci='2' then begin;
               if sjc <= 2 then
               else
               begin;
               i:=i+1;
               p[i]:=2;
               ok:='ok';
               end;
               end;
if ci='3' then begin;
               if sjc <= 3 then
               else
               begin;
               i:=i+1;
               p[i]:=3;
               ok:='ok';
               end;
               end;
if ci='4' then begin;
               if sjc <= 4 then
               else
               begin;
               i:=i+1;
               p[i]:=4;
               ok:='ok';
               end;
               end;
if ci='5' then begin;
               if sjc <= 5 then
               else
               begin;
               i:=i+1;
               p[i]:=5;
               ok:='ok';
               end;
               end;
if ci='6' then begin;
               if sjc <= 6 then
               else
               begin;
               i:=i+1;
               p[i]:=6;
               ok:='ok';
               end;
               end;
if ci='7' then begin;
               if sjc <= 7 then
               else
               begin;
               i:=i+1;
               p[i]:=7;
               ok:='ok';
               end;
               end;
if ci='8' then begin;
               if sjc <= 8 then
               else
               begin;
               i:=i+1;
               p[i]:=8;
               ok:='ok';
               end;
               end;
if ci='9' then begin;
               if sjc <= 9 then
               else
               begin;
               i:=i+1;
               p[i]:=9;
               ok:='ok';
               end;
               end;
if ci='a' then begin;
               if sjc <= 10 then
               else
               begin;
               i:=i+1;
               p[i]:=10;
               ok:='ok';
               end;
               end;
if ci='A' then begin;
               if sjc <= 10 then
               else
               begin;
               i:=i+1;
               p[i]:=10;
               ok:='ok';
               end;
               end;
if ci='b' then begin;
               if sjc <= 11 then
               else
               begin;
               i:=i+1;
               p[i]:=11;
               ok:='ok';
               end;
               end;
if ci='B' then begin;
               if sjc <= 11 then
               else
               begin;
               i:=i+1;
               p[i]:=11;
               ok:='ok';
               end;
               end;
if ci='c' then begin;
               if sjc <= 12 then
               else
               begin;
               i:=i+1;
               p[i]:=12;
               ok:='ok';
               end;
               end;
if ci='C' then begin;
               if sjc <= 12 then
               else
               begin;
               i:=i+1;
               p[i]:=12;
               ok:='ok';
               end;
               end;
if ci='d' then begin;
               if sjc <= 13 then
               else
               begin;
               i:=i+1;
               p[i]:=13;
               ok:='ok';
               end;
               end;
if ci='D' then begin;
               if sjc <= 13 then
               else
               begin;
               i:=i+1;
               p[i]:=13;
               ok:='ok';
               end;
               end;
if ci='e' then begin;
               if sjc <= 14 then
               else
               begin;
               i:=i+1;
               p[i]:=14;
               ok:='ok';
               end;
               end;
if ci='E' then begin;
               if sjc <= 14 then
               else
               begin;
               i:=i+1;
               p[i]:=14;
               ok:='ok';
               end;
               end;
if ci='f' then begin;
               if sjc <= 15 then
               else
               begin;
               i:=i+1;
               p[i]:=15;
               ok:='ok';
               end;
               end;
if ci='F' then begin;
               if sjc <= 15 then
               else
               begin;
               i:=i+1;
               p[i]:=15;
               ok:='ok';
               end;
               end;
if ord(ci)=13 then begin
                   if a=1 then begin
                                ok:='';
                                end
                               else
                                begin;
                                a:=pmm;
                                ok:='ok';
                                end;
                   end;
{
if ord(ci)=8 then begin
                  if a=1 then begin
                              ok:='ok';
                              end
                  else
                              begin
                              a:=(a-1);
                              i:=(i-1);
                              ok:='ok';
                              end
                  end;
}
if ok<>'ok' then begin
                 writeln;
                 writeln;
                 textcolor(12);
                 write('--- Spatne cislo, toto je neplatny znak: --> ');
                 textcolor(2);
                 write(ci);
                 textcolor(12);
                 write(' <-- !!!');
                 textcolor(7);
                 writeln;

                 Sound(220);
                 Delay(200);
                 NoSound;

                 delay(4000);
                 goto zcj
                 end;
ok:='';
end;
until a=pmm;

{
pole se vinuluje a nakrmi
}
repeat;
for bii:=1 to 10 do begin;
                    pcj[bii]:=0;
                    end;
until bii=10;

ia:=i+1;
iaa:=11;
repeat
for biii:=1 to i do begin;
                    ia:=ia-1;
                    iaa:=iaa-1;
                    pcj[iaa]:=p[ia];
                    end;
until biii=i;
{
Soustava 2 -----------------------------------;
}
dsjl:;
clrscr;
ZKlogo;
writeln;
writeln(' Druhe cislo bede soustavy?');
write(' Vkladane cislo: ');

dsj:=readkey;

{
if dsj='0' then begin
                ok:='ok';
                dsjc:=0;
                end;
if dsj='1' then begin
                ok:='ok';
                dsjc:=1;
                end;
}
if dsj='2' then begin
                ok:='ok';
                dsjc:=2;
                end;
if dsj='3' then begin
                ok:='ok';
                dsjc:=3;
                end;
if dsj='4' then begin
                ok:='ok';
                dsjc:=4;
                end;
if dsj='5' then begin
                ok:='ok';
                dsjc:=5;
                end;
if dsj='6' then begin
                ok:='ok';
                dsjc:=6;
                end;
if dsj='7' then begin
                ok:='ok';
                dsjc:=7;
                end;
if dsj='8' then begin
                ok:='ok';
                dsjc:=8;
                end;
if dsj='9' then begin
                ok:='ok';
                dsjc:=9;
                end;
if dsj='a' then begin
                ok:='ok';
                dsjc:=10;
                end;
if dsj='A' then begin
                ok:='ok';
                dsjc:=10;
                end;
if dsj='b' then begin
                ok:='ok';
                dsjc:=11;
                end;
if dsj='B' then begin
                ok:='ok';
                dsjc:=11;
                end;
if dsj='c' then begin
                ok:='ok';
                dsjc:=12;
                end;
if dsj='C' then begin
                ok:='ok';
                dsjc:=12;
                end;
if dsj='d' then begin
                ok:='ok';
                dsjc:=13;
                end;
if dsj='D' then begin
                ok:='ok';
                dsjc:=13;
                end;
if dsj='e' then begin
                ok:='ok';
                dsjc:=14;
                end;
if dsj='E' then begin
                ok:='ok';
                dsjc:=14;
                end;
if dsj='f' then begin
                ok:='ok';
                dsjc:=15;
                end;
if dsj='F' then begin
                ok:='ok';
                dsjc:=15;
                end;
if dsj='g' then begin
                ok:='ok';
                dsjc:=16;
                end;
if dsj='G' then begin
                ok:='ok';
                dsjc:=16;
                end;

if ok<>'ok' then begin
                 writeln;
                 writeln;
                 textcolor(12);
                 write('--- Spatne cislo, toto je neplatny znak: --> ');
                 textcolor(2);
                 write(dsj);
                 textcolor(12);
                 write(' <-- !!!');
                 textcolor(7);
                 writeln;

                 Sound(220);
                 Delay(200);
                 NoSound;

                 delay(4000);
                 goto dsjl;
                 end;
ok:='';

{
Prevod do 10 soustavy-----------------------------------------------;
}
cds:=0;
pcjj:=pcj[1];
pdss:=(pcjj*(sqr(sjc)));
pdss:=(pdss*(sqr(sjc)));
pdss:=(pdss*(sqr(sjc)));
pdss:=(pdss*(sqr(sjc)));
pdss:=(pdss*sjc);
pds[1]:=pdss;
cds:=cds + pdss;

pcjj:=pcj[2];
pdss:=(pcjj*(sqr(sjc)));
pdss:=(pdss*(sqr(sjc)));
pdss:=(pdss*(sqr(sjc)));
pdss:=(pdss*(sqr(sjc)));
pds[2]:=pdss;
cds:=cds + pdss;

pcjj:=pcj[3];
pdss:=(pcjj*(sqr(sjc)));
pdss:=(pdss*(sqr(sjc)));
pdss:=(pdss*(sqr(sjc)));
pdss:=(pdss*sjc);
pds[3]:=pdss;
cds:=cds + pdss;

pcjj:=pcj[4];
pdss:=(pcjj*(sqr(sjc)));
pdss:=(pdss*(sqr(sjc)));
pdss:=(pdss*(sqr(sjc)));
pds[4]:=pdss;
cds:=cds + pdss;

pcjj:=pcj[5];
pdss:=(pcjj*(sqr(sjc)));
pdss:=(pdss*(sqr(sjc)));
pdss:=(pdss*sjc);
pds[5]:=pdss;
cds:=cds + pdss;

pcjj:=pcj[6];
pdss:=(pcjj*(sqr(sjc)));
pdss:=(pdss*(sqr(sjc)));
pds[6]:=pdss;
cds:=cds + pdss;

pcjj:=pcj[7];
pdss:=(pcjj*(sjc*(sqr(sjc))));
pds[7]:=pdss;
cds:=cds + pdss;

pcjj:=pcj[8];
pdss:=(pcjj*(sqr(sjc)));
pds[8]:=pdss;
cds:=cds + pdss;

pcjj:=pcj[9];
pdss:=(pcjj*sjc);
pds[9]:=pdss;
cds:=cds + pdss;

pcjj:=pcj[10];
pdss:=(pcjj*1);
pds[10]:=pdss;
cds:=cds + pdss;
{
prevod do X soustavy -----------------------------------------------;
}
px:=32;
xcds:=cds;
repeat;
for x:=1 to px do begin;
                  xxx:=(xcds div dsjc);
                  pxx[x]:=(xcds - xxx * dsjc);
                  xcds:=xxx;
                  if xxx=0 then begin;
                                xko:=x;
                                x:=px;
                                end;
                  end;
until x=px;

rpx:=1;
repeat;
for rx:=xko downto 1 do begin;
                        pxc[rpx]:=pxx[rx];
                        rpx:=(rpx+1);
                        end;
until rx=1;

{
Konec -----------------------------------------------;
}
clrscr;
textcolor(7);
ZKlogo;

{
Konec, otazkana pole cisel --------------------------------------;
}
writeln;
 textcolor(14);
write(' Pridat vypis poli cisel (A/COKOLI)?');
 textcolor(2);
pcv:=readkey;
gotoxy(1,5);
delline;
if pcv='a' then pcv:='A';
{
Zdrzovacka ---------;
}
textcolor(7);
write (' Zapisuji DATA .');
delay(700);
write ('.');
delay(600);
write ('.');
delay(300);
write ('.');
delay(300);
write ('.');
delay(200);
write ('.');
delay(100);
write ('.');
delay(500);
write ('.');
write(' Hotovo');
delay(1000);
textcolor(2);
delline;
writeln;
{
Cislo v x vstupni soustave;
}
writeln;
writeln;
write('                      Cislo "');
 textcolor(15);

repeat;
for bi:=1 to i do begin;
                  if p[bi]=0 then write('0');
                  if p[bi]=1 then write('1');
                  if p[bi]=2 then write('2');
                  if p[bi]=3 then write('3');
                  if p[bi]=4 then write('4');
                  if p[bi]=5 then write('5');
                  if p[bi]=6 then write('6');
                  if p[bi]=7 then write('7');
                  if p[bi]=8 then write('8');
                  if p[bi]=9 then write('9');
                  if p[bi]=10 then write('A');
                  if p[bi]=11 then write('B');
                  if p[bi]=12 then write('C');
                  if p[bi]=13 then write('D');
                  if p[bi]=14 then write('E');
                  if p[bi]=15 then write('F');
                  end;
until bi=i;
 textcolor(2);


write('" v "');
 textcolor(15);
write(sjc);
 textcolor(2);
writeln('" soustave.');

if pcv='A' then begin;
                textcolor(7);
                write('      Pole: ');
                repeat;
                for biiii:=1 to 10 do begin;
                                      write(pcj[biiii]);
                                      write(',');
                                      end;
                until biiii=10;
                writeln;
                textcolor(2);
                end;

{
Cislo v 10 soustave;
}
writeln;
writeln;
write('                      Cislo "');
 textcolor(15);
write(cds);
 textcolor(2);
write('" v "');
 textcolor(15);
write('10');
 textcolor(2);
writeln('" soustave.');

if pcv='A' then begin;
                textcolor(7);
                write('      Pole: ');

                repeat;
                for pdsi:=1 to 10 do begin;
                                     write(pds[pdsi]);
                                     write(',');
                                     end;
                until pdsi=10;
                writeln;
                textcolor(2);
                end;

{
Cislo v x soustave;
}

writeln;
writeln;
write('                      Cislo "');
 textcolor(15);

pxvv:=xko;
repeat;
for xvv:=1 to pxvv do begin;
                      if pxc[xvv]=0 then write('0');
                      if pxc[xvv]=1 then write('1');
                      if pxc[xvv]=2 then write('2');
                      if pxc[xvv]=3 then write('3');
                      if pxc[xvv]=4 then write('4');
                      if pxc[xvv]=5 then write('5');
                      if pxc[xvv]=6 then write('6');
                      if pxc[xvv]=7 then write('7');
                      if pxc[xvv]=8 then write('8');
                      if pxc[xvv]=9 then write('9');
                      if pxc[xvv]=10 then write('A');
                      if pxc[xvv]=11 then write('B');
                      if pxc[xvv]=12 then write('C');
                      if pxc[xvv]=13 then write('D');
                      if pxc[xvv]=14 then write('E');
                      if pxc[xvv]=15 then write('F');
                      end;
until xvv=pxvv;

 textcolor(2);
write('" v "');
 textcolor(15);
write(dsjc);
 textcolor(2);
writeln('" soustave.');

if pcv='A' then begin;
                textcolor(7);
                write('      Pole: ');

                pxv:=xko;
                repeat;
                for xv:=1 to pxv do begin;
                                    write(pxc[xv]);
                                    write(',')
                                    end;
                until xv=pxv;
                textcolor(2);
                end;
writeln;
writeln;
textcolor(7);
gotoxy(1,24);
textcolor(28);
write(' Pro ukonceni programu stisknete klavesu ...');
delay(3000);
readkey;
textcolor(7);
clrscr;
ZKlogo;
end.