program linebreaks3;
    label
        666;
    const
{ Private to the list_of_int ADT. }
        NODESIZE = 2;
        HEAPSIZE = 500000;
{ Private to character i/o, and non-portable.  FIXME. }
        end_of_file = chr(1);
        newline = chr(2);
{ Private to the text formatter. }
        BUFSIZE = 10000;
        MAXWORDS = 5000;
{ The maximum length of a formatted line. }
        M = 50;
    type
        longint = integer; {Remove this if using Think Pascal}
{ The right hand side is private to the list_of_int ADT. }
        list_of_int = real;
{ The right hand sides are private to the text formatter. }
        array_of_int = array[1..MAXWORDS] of integer;
        array_of_bool = array[1..MAXWORDS] of boolean;
    var
{ Private to the list_of_int ADT. }
        listnodes: array[0..HEAPSIZE] of integer;
        nextnode: longint;
        emptylist0: list_of_int;
{ Private to character i/o. }
        nextcharacter: char;
        nextcharacterIsReady: boolean;
{ Private to the text formatter. }
        paragraphBuffer: packed array[1..BUFSIZE] of char;
        paragraphIndex: longint;
        paragraphWords: longint;
        paragraphWordLengths: array_of_int;
        paragraphLineBreaks: array_of_bool;

{ Private to the list_of_int ADT. }

    function project_list (z: list_of_int): longint;
        var
            n: longint;
    begin
        n := round(z + 0.5);
        if (z = n - 0.5) and (n < HEAPSIZE) then
            project_list := n
        else
            begin
                writeln('An illegal operation has been performed on a list_of_int.');
                writeln('Attempting to recover system integrity...');
                writeln('@#$!@#$%!@#$@$!@#$@!#$@@!%!@%#!@%!^!&$#%!%');
                writeln('Recovery unsuccessful.  Rebooting Internet...');
                goto 666
            end
    end;

    function inject_list (n: longint): list_of_int;
    begin
        inject_list := n - 0.5
    end;

{ The implementations of these functions and procedures are private. }

    function emptylist: list_of_int;
    begin
        emptylist0 := emptylist0 - 1.0;
        emptylist := emptylist0
    end;

    function empty (z: list_of_int): boolean;
    begin
        empty := z < 0.0
    end;

    function cons (x: longint; y: list_of_int): list_of_int;
        var
            n, next: longint;
    begin
        n := project_list(y);
        next := nextnode;
        nextnode := nextnode + NODESIZE;
        if nextnode < HEAPSIZE then
            begin
                listnodes[next] := x;
                listnodes[next + 1] := n;
                cons := inject_list(next)
            end
        else
            begin
                writeln('List storage overflowed.');
                writeln('You might want to consider an algorithm');
                writeln('that uses less storage for lists.');
                goto 666
            end;
    end;

    function first (z: list_of_int): longint;
    begin
        first := listnodes[project_list(z)]
    end;

    function rest (z: list_of_int): list_of_int;
    begin
        rest := inject_list(listnodes[project_list(z) + 1])
    end;

    procedure InitLists;
    begin
        nextnode := 0;
        emptylist0 := -1.5
    end;

    procedure DeleteLists;
    begin
        InitLists
    end;

{ Replace this procedure's code with your optimal and efficient algorithm. }

    function ChooseLB (i, n: longint;
                       var L: array_of_int;
                       M: longint;
                       var costptr: longint): list_of_int;
    forward;

    procedure ChooseLineBreaks (n: longint;
                                var L: array_of_int;
                                M: longint;
                                var B: array_of_bool);
        var
            i, cost: longint;
            breaks: list_of_int;
    begin
        InitLists;
        breaks := ChooseLB(1, n, L, M, cost);
        for i := 1 to n do
            B[i] := false;
        while not empty(breaks) do
            begin
                B[first(breaks)] := true;
                breaks := rest(breaks);
            end;
{Deallocate all list storage. }
        DeleteLists;
        for i := 1 to n do
            if B[i] then
                write(1 : 1)
            else
                write(0 : 1);
        writeln
    end;

{ ChooseLB ( i , n , L , M , costptr ) returns a list of the optimal line breaks}
{ for L [ i .. n ] , and returns in costptr the value of the Ugliness }
{ function for those optimal line breaks. }

    function ChooseLB; {(n, L, M, costptr)}
        var
            n1, spaces, cost, j, sum, newcost: longint;
            best, breaks: list_of_int;
    begin
        n1 := n;
        if i = n1 then
            begin
                costptr := 0;
                ChooseLB := emptylist;
            end
        else
            begin
                best := cons(i, ChooseLB(i + 1, n, L, M, costptr));
                spaces := M - L[i];
                cost := spaces * spaces * spaces + costptr;
                j := i + 1;
                sum := L[i] + 1 + L[j];

{           Loop invariant:}
{                i <= j < n,}
{                sum = j - i + the sum of L[i] through L[j]}
{                  (that is, sum is the length of words i..j when separated}
{                   by spaces),}
{                sum - L[j] <= M,}
{                best is a list of line breaks for L[i..n1],}
{                best is optimal among all lists of line breaks}
{                  for L[i..n1] that begin with a line break after}
{                  word i...word j-1, and}
{                cost is the Ugliness associated with best for words i..n1 only.}

                while (sum <= M) and (j <> n1) do
                    begin
                        breaks := ChooseLB(j + 1, n, L, M, costptr);
                        spaces := M - sum;
                        newcost := spaces * spaces * spaces + costptr;
                        if newcost < cost then
                            begin
                                best := cons(j, breaks);
                                cost := newcost;
                            end;
                        j := j + 1;
                        sum := sum + 1 + L[j];
                    end;

                if sum > M then
                    begin
                        costptr := cost;
                        ChooseLB := best;
                    end
                else
{            /*  j == n1, and the last line costs nothing  */}
                    begin
                        costptr := 0;
                        ChooseLB := emptylist;
                    end
            end;
    end;

{ Character i/o. }

    procedure InitCharacterIO;
    begin
        nextcharacterIsReady := false
    end;

    procedure putchar (c: char);
    begin
        if c = newline then
            writeln
        else
            write(c)
    end;

    function getchar: char;
    begin
        if nextcharacterIsReady then
            begin
                nextcharacterIsReady := false;
                getchar := nextcharacter
            end
        else
            begin
                if eof then
                    nextcharacter := end_of_file
                else if eoln then
                    begin
                        readln;
                        writeln('Encountered end of line.');
                        nextcharacter := newline
                    end
                else
                    read(nextcharacter);
                getchar := nextcharacter
            end
    end;

    function peekchar: char;
    begin
        if nextcharacterIsReady then
            peekchar := nextcharacter
        else
            begin
                if eof then
                    nextcharacter := end_of_file
                else if eoln then
                    begin
                        readln;
                        nextcharacter := newline
                    end
                else
                    read(nextcharacter);
                nextcharacterIsReady := true;
                peekchar := nextcharacter
            end
    end;

{ The text formatter. }

    procedure FlushWhitespace;
        var
            c: char;
    begin
        c := peekchar;
        while (c <> end_of_file) and ((c = ' ') or (c = newline)) do
            begin
                c := getchar;
                c := peekchar
            end
    end;

    function EndOfParagraph: boolean;
        var
            c: char;
    begin
        EndOfParagraph := false;
        c := peekchar;
        while (c = ' ') or (c = newline) do
            begin
                if c = ' ' then
                    begin
                        c := getchar;
                        c := peekchar;
                    end
                else
                    begin
                        c := getchar;
                        c := peekchar;
                        if (c = end_of_file) or (c = newline) then
                            EndOfParagraph := true
                    end
            end
    end;

    procedure ReadWord;
        var
            c: char;
    begin
        c := peekchar;
        while (c <> end_of_file) and (c <> ' ') and (c <> newline) do
            begin
                paragraphBuffer[paragraphIndex] := c;
                paragraphIndex := paragraphIndex + 1;
                c := getchar;
                c := peekchar
            end;
        paragraphBuffer[paragraphIndex] := ' ';
        paragraphIndex := paragraphIndex + 1;
        paragraphWords := paragraphWords + 1
    end;

    procedure ReadParagraph;
    begin
        paragraphIndex := 1;
        paragraphWords := 1;
        while not EndOfParagraph do
            ReadWord
    end;

    procedure FormatParagraph (M: longint);
        var
            i, thisword, index: longint;
    begin
        i := 1;
        thisword := 0;
        index := 1;
        while index < paragraphIndex do
            if paragraphBuffer[index] = ' ' then
                begin
                    paragraphWordLengths[i] := thisword;
                    i := i + 1;
                    thisword := 0;
                    index := index + 1;
                end
            else
                begin
                    thisword := thisword + 1;
                    index := index + 1
                end;
        paragraphIndex := paragraphIndex - 1;
{ Choose line breaks. }
        ChooseLineBreaks(paragraphWords,
                         paragraphWordLengths,
                         M,
                         paragraphLineBreaks);
{ Replace the chosen spaces by newlines. }
        index := 0;
        i := 1;
        while i < paragraphWords do
            begin
                if paragraphLineBreaks[i] then
                    paragraphBuffer[index + 1 + paragraphWordLengths[i]]
                      := newline;
                index := index + 1 + paragraphWordLengths[i];
                i := i + 1
            end
    end;

    procedure WriteParagraph;
        var
            index: longint;
    begin
        for index := 1 to paragraphIndex do
            putchar(paragraphBuffer[index])
    end;

begin
    InitCharacterIO;
    FlushWhitespace;
    while peekchar <> end_of_file do
        begin
            ReadParagraph;
            FormatParagraph(M);
            WriteParagraph;
            writeln;
            writeln
        end;
666:
end.