【纪念】我AC过的最长代码

http://noi.openjudge.cn/ch0205/1805/ 碎纸机
var
a:array[0..6] of longint;
num:array[0..6,0..6] of longint;
b,c:array[1..6] of boolean;
x,y,n,max,tmax,k,i,j,t:longint;
procedure p;
var i,j,m:longint;
begin
fillchar(b,sizeof(b),false);
while not(b[n]) do
begin
j:=1;m:=0;
while b[j] do inc(j);
dec(j);
for i:=1 to j do b[i]:=false;
b[j+1]:=true;
j:=1;
while not(b[j]) and (j<n) do inc(j);
if num[1,j]>x then continue;
i:=1;j:=1;
while j<n do
begin
while not(b[j]) and (j<n) do inc(j);
if j>=n then break;
inc(m,num[i,j]);
inc(j);
i:=j;
end;
inc(m,num[i,n]);
if (m>max) and (m<=x) then
begin
max:=m;
tmax:=m;
c:=b;
end else
if m=max then tmax:=-1;
end;
end;
begin
read(x,y);
while (x<>0) and (y<>0) do
begin
fillchar(num,sizeof(b),0);
n:=0;max:=0;tmax:=0;
while y<>0 do
begin
inc(n);
a[n]:=y mod 10;
y:=y div 10;
end;
for i:=1 to n div 2 do
begin
t:=a[i];a[i]:=a[n-i+1];a[n-i+1]:=t;
end;
for i:=1 to n do
for j:=i to n do num[i,j]:=num[i,j-1]*10+a[j];
p;
if tmax=-1 then writeln('rejected') else
if tmax=0 then writeln('error') else
begin
write(max,' ');
i:=1;j:=1;
while j<n do
begin
while not(c[j]) and (j<n) do inc(j);
if j>=n then break;
for k:=i to j do write(a[k]);
inc(j);
i:=j;
write(' ');
end;
for k:=i to n do write(a[k]);
writeln;
end;
readln(x,y);
end;
end.