program linebreaks2;
    label
        666;
    const
{ 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
{ 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 character i/o. }
        nextcharacter: char;
        nextcharacterIsReady: boolean;
{ Private to the text formatter. }
        paragraphBuffer: packed array[1..BUFSIZE] of char;
        paragraphIndex: integer;
        paragraphWords: integer;
        paragraphWordLengths: array_of_int;
        paragraphLineBreaks: array_of_bool;

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

    procedure ChooseLineBreaks (n: integer;
                                var L: array_of_int;
                                M: integer;
                                var B: array_of_bool);
        var
            i, thisline: integer;
    begin
        i := 1;
        thisline := L[1];
        while i < n do
            begin
                B[i] := false;
                if thisline <= M then
                    begin
                        i := i + 1;
                        thisline := thisline + 1 + L[i]
                    end
                else
                    begin
                        B[i - 1] := true;
                        thisline := L[i]
                    end
            end;
        B[n] := false;
        if thisline > M then
            B[i - 1] := true;
{       for i := 0 to n - 1 do}
{           if B[i] then}
{               write(1 : 1)}
{           else}
{               write(0 : 1);}
{       writeln;}
    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: integer);
        var
            i, thisword, index: integer;
    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: integer;
    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.