Cod sursa(job #38917)

Utilizator vanila0406Ionescu Victor vanila0406 Data 26 martie 2007 11:29:11
Problema Next Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.62 kb
program next;
var f,g:text;
        v:array[1..1000005] of byte;
        d,y:qword;
        n,l:longint;
        b:array[1..100]of byte;


procedure iofile;
var code:integer;
        x:byte;
        c:char;
begin
        assign(f,'next.in');
        reset(f);
        assign(g,'next.out');
        rewrite(g);
        n:=0;
        while not(eoln(f)) do
                begin
                        read(f,c);
                        val(c,x,code);
                        inc(n);
                        v[n]:=x;
                end;
        read(f,d);
        close(f);
end;


procedure aflare_rest;
var x:qword;
        p,i:longint;
begin
        p:=1;
        x:=v[1];
        while (x<d)and(p<n) do
                begin
                        inc(p);
                        x:=x*10+v[p];
                end;
        x:=x mod d;
        for i:=p+1 to n do
                begin
                        x:=x*10+v[i];
                        x:=x mod d;
                end;
        if x=0 then x:=d;
        y:=d-x;
        l:=0;
        repeat
                inc(l);
                b[l]:=y mod 10;
                y:=y div 10;
        until y=0;
end;



procedure adunare;
var i,aux,t,x:longint;
begin
        for i:=1 to n div 2 do
                begin
                        aux:=v[i];
                        v[i]:=v[n-i+1];
                        v[n-i+1]:=aux;
                end;
        i:=1;
        t:=0;
        while (i<=l)and(i<=n) do
                begin
                        x:=v[i]+b[i]+t;
                        v[i]:=x mod 10;
                        t:= x div 10;
                        inc(i);
                end;
        if i<=l then
                while i<=l do
                        begin
                                x:=b[i]+t;
                                v[i]:=x mod 10;
                                t:=x div 10;
                                inc(i);
                        end else
                while i<=n do
                        begin
                                x:=v[i]+t;
                                v[i]:=x mod 10;
                                t:= x div 10;
                                inc(i);
                        end;
        n:=i-1;
        if t<>0  then
                begin
                        inc(n);
                        v[n]:=t;
                end;
end;



procedure prel;
var i:longint;
begin
        for i:=n downto 1 do
                write(g,v[i]);
        close(g);
end;



begin
        iofile;
        aflare_rest;
        adunare;
        prel;
end.