(*$B- Aufgabe 4.4 *)
PROGRAM zahum;
CONST anzziffern = 50;
TYPE bzahl = RECORD
                 basis, laenge: longint;
                 ziffer: ARRAY[0..anzziffern] OF char
             END;
VAR zahlb : bzahl; h: char; k,i,b,zahl10 : longint;

FUNCTION wert(c:char):longint;
(* Die Ziffern werden durch die Charakters 0,1,...,9,A,B,...
   dargestellt. Wert berechnet den dezimalen Wert einer Ziffer *)
BEGIN
  IF ('0'<=c) AND (c<='9') THEN wert := ord(c)-ord('0')
  ELSE wert := ord(upcase(c))-ord('A') +10
END;

FUNCTION ch(i:longint):char;
(*Umkehrfunktion von Wert *)
BEGIN
  IF (0<=i) AND (i<=9) THEN ch:= chr(ord('0')+i)
  ELSE ch:= chr(ord('A')+i-10)
END;

FUNCTION bnachdez(d:bzahl):longint;
(* Algorithmus 4.3 *)
VAR i,u :longint;
BEGIN
  u:=0;
  FOR i:= d.laenge DOWNTO 0 DO
     u:=u*d.basis+wert(d.ziffer[i]);
  bnachdez :=u
END;

PROCEDURE deznachb(u,b:longint; VAR d:bzahl);
(* Algorithmus 4.4 *)
VAR i:longint;
BEGIN
  i :=0;
  WHILE u<>0 DO
  BEGIN
    d.ziffer[i]:= ch(u MOD b); u:=u DIV b; i:=i+1
  END;
  d.laenge := i-1; d.basis:=b
END;


BEGIN
  writeln('Basis der umzuwandelnden Zahl ?'); readln(b);
  writeln('damit moegliche Ziffern :');
  FOR i:=0 TO b-1 DO write(ch(i));
  writeln; writeln; writeln('Zahl eingeben');
  i:=-1;
  WHILE NOT eoln DO
  BEGIN i:=i+1; read(zahlb.ziffer[i]) END;
  zahlb.laenge:=i; zahlb.basis:=b;

  (*umordnen*)
  WITH zahlb DO
  FOR k:= 0 TO laenge DIV 2 DO
  BEGIN
    h:=ziffer[k];
    ziffer[k]:= ziffer[laenge-k];
    ziffer[laenge-k]:=h
  END;

  zahl10:=bnachdez(zahlb);
  writeln('im Zehnersystem: ',zahl10); writeln;

  writeln('neue Basis eingeben'); read(b);
  deznachb(zahl10,b,zahlb);

  WITH zahlb DO
  FOR i:= laenge DOWNTO 0 DO write(ziffer[i]); writeln
END.