{$A-}
procedure print_proportional  (line : str255; cpi10,Pro_print,Skip_tag: boolean;margin:str255);

    label  continue,loop1,loop2,loop3,loop4,exit;

    const  gee  : array[1..2,1..9] of byte = ((0,1,1,1,1,2,0,0,0),(0,0,0,0,0,2,0,0,0));
           wye  : array[1..2,1..9] of byte = ((0,1,1,1,1,2,0,0,0),(0,0,0,0,0,2,0,0,0));
           pee  : array[1..2,1..9] of byte = ((0,3,1,0,0,0,0,0,0),(0,2,0,0,0,0,0,0,0));
           que  : array[1..2,1..9] of byte = ((0,0,0,0,1,3,0,0,0),(0,0,0,0,0,2,0,0,0));
           usc  : array[1..2,1..9] of byte = ((1,1,1,1,1,1,1,1,1),(0,0,0,0,0,0,0,0,0));
           dol  : array[1..2,1..9] of byte = ((0,0,0,2,0,0,0,0,0),(0,0,0,0,0,0,0,0,0));
           com  : array[1..2,1..9] of byte = ((2,0,0,0,0,0,0,0,0),(0,0,0,0,0,0,0,0,0));

    var   dots,sum,y,x,z,
          extra_spaces,nn  : integer;
          charactors,xx    : integer;
          decenders        : boolean;
          overprint        : boolean;
          line2            : str255;
          do_anyway        : boolean;
          boldface_line    : array[1..96] of byte;
          double_strike_line : array[1..96] of byte;
          underline_line   : array[1..96] of byte;
          B_flag,D_flag    : boolean;
          DS,BF            : byte;

    begin
    if not(skip_tag) then
        begin
        b_flag := false;
        D_flag := false;
        decenders := false;
        for x := 1 to 96 do
            begin
            boldface_line[x] := mem[addr(boldface)] * $FF;
            double_strike_line[x] := mem[addr(double_strike)] * $FF;
            underline_line[x] := mem[addr(underline)] * $FF;
            end;
        end;
    if underline then decenders := true;
    xx := 1;
    line2 := '';
    overprint := false;
{.pa}
    if length(line) > 0 then
        repeat
            if line[xx] in ['g','y','p','q','_','$',','] then
                decenders := true;
            if ord(line[xx]) = $0D then
                if (xx+1 < length(line)) then
                    if (ord(line[xx+1]) = $0A) then
                        begin
                        print_proportional (copy(line,1,xx-1),cpi10,pro_print,true,margin);
                        line := copy (line,xx+2,length(line));
                        print_proportional (line,cpi10,pro_print,false,margin);
                        program_line := program_line + 1;
                        page_line := page_line + 1;
                        if include then include_line := include_line + 1;
                        goto exit;
                        end
                      else
                        begin
                        line2 := copy(line,xx+1,length(line));
                        line := copy (line,1,xx-1);
                        decenders := true;
                        overprint := true;
                        repeat
                            if length(line2)< length(line) then
                                line2 := line2 + ' ';
                            until length(line2) >= length(line);
                        goto continue;
                        end;
            case line[xx] of
                ^S    : begin
                        underline := not(underline);
                        for x := xx to 96 do
                            underline_line[x] := mem[addr(underline)] * $FF;
                        decenders := true;
                        end;
               ^D     : begin
                        Double_strike := not(Double_strike);
                        for x := xx to 96 do
                            Double_strike_line[x] := mem[addr(double_strike)] * $FF;
                        D_flag := true;
                        end;
               ^B     : begin
                        Boldface := not(boldface);
                        for x := xx to 96 do
                            boldface_line[x] := mem[addr(boldface)] * $FF;
                        b_flag := true;
                        end;
               end;
            if ord(line[xx]) < 32 then
                delete (line,xx,1)
              else
                xx := xx+1;
continue:
            until xx > length(line);
    if not(cpi10) then
        begin
        if length(line) > 95-length(margin) then
            line[0] := chr(95-length(margin));
        end
      else
        if length(line) > 79-length(margin) then
            line[0] := chr(79-length(margin));
    DS := $FF;
    BF := $FF;
{.pa}
loop1:
    charactors := length(line);
    dots := length(line)* 12;   { assumes 10 cpi }
    if not(cpi10) then dots := length(line) * 10;
    write (lst,margin);
    write (lst,^[,'L',chr(dots mod $100),chr(dots div $100));
    sum := 0;
    for x := 1 to length(line) do
        if cpi10 then
            sum := sum + sizes [ord(line[x])] + 3
          else
            sum := sum + sizes [ord(line[x])] + 1;
    extra_spaces := dots - sum;
    do_anyway := false;
    for x := 1 to length(line) do
        begin
        if not (pro_print) then
            if sizes[ord(line[x])] < 8 then
                for y := 1 to ((9-sizes[ord(line[x])]) DIV 2) do
                    write (lst,^@);
        for y := 1 to sizes[ord(line[x])] do
            if not(overprint) then
                write (lst,chr((let_ers[ord(line[x]),1,y]) and (((BF and DS) or Boldface_line[x])
                                                             or (DS or (BF and Double_strike_line[x])))))
              else
                write (lst,chr(((let_ers[ord(line[x]),1,y] or
                               let_ers[ord(line2[x]),1,y])) and (((bf and DS) or boldface_line[x])
                                                             or  (DS or (BF and Double_strike_line[x])))));
        if not (pro_print) then
            for y := 1 to (9 -sizes[ord(line[x])] -(9-sizes[ord(line[x])]) DIV 2) do
                write (lst,^@);
        if cpi10 then
            write (lst,^@,^@,^@)
          else
            write (lst,^@);
        if not (line[x] in [' ','0'..'9']) then do_anyway := true;
        charactors := charactors - 1;
        if (extra_spaces > 0) and (not(line[x] in [' ','0'..'9']) or do_anyway) and pro_print then
            for y := 1 to (extra_spaces div charactors) +1 do
                begin
                write (lst,^@);
                extra_spaces := extra_spaces - 1;
                end;
        end;
    if pro_print then
        for y := 1 to extra_spaces do
            write (lst,^@);
    if (D_flag or B_flag) and (DS <> 0) then
        begin
        DS := 0;
        write (lst,^m);
        goto loop1;
        end;
    if b_flag and (BF <> 0) then
        begin
        BF := 0;
        write (lst,^m);
        goto loop1;
        end;
    write (lst,^m,^[,'J',^a);
    BF := $FF;
    DS := $FF;
{.pa}
loop2:
    extra_spaces := dots - sum;
    charactors := length(line);
    write (lst,margin);
    write (lst,^[,'L',chr(dots mod $100),chr(dots div $100));
    do_anyway := false;
    for x := 1 to length(line) do
        begin
        if not (pro_print) then
            if sizes[ord(line[x])] < 8 then
                for y := 1 to ((9-sizes[ord(line[x])]) DIV 2) do
                    write (lst,^@);
        for y := 1 to sizes[ord(line[x])] do
            if not(overprint) then
                write (lst,chr((let_ers[ord(line[x]),2,y]) and (((BF and DS) or Boldface_line[x])
                                                             or (DS or (BF and Double_strike_line[x])))))
              else
                write (lst,chr(((let_ers[ord(line[x]),2,y] or
                               let_ers[ord(line2[x]),2,y])) and (((bf and DS) or boldface_line[x])
                                                             or  (DS or (BF and Double_strike_line[x])))));
        if not (pro_print) then
            for y := 1 to (9 -sizes[ord(line[x])] -(9-sizes[ord(line[x])]) DIV 2) do
                write (lst,^@);
        if cpi10 then
            write (lst,^@,^@,^@)
          else
            write (lst,^@);
        if not(line[x] in [' ','0'..'9']) then do_anyway := true;
        charactors := charactors - 1;
        if (extra_spaces > 0) and (not(line[x] in [' ','0'..'9']) or do_anyway) and pro_print then
            for y := 1 to (extra_spaces div charactors) +1 do
                begin
                write (lst,^@);
                extra_spaces := extra_spaces - 1;
                end;
        end;
    if pro_print then
        for y := 1 to extra_spaces do
            write (lst,^@);
    if (D_flag or B_flag) and (DS <> 0) then
        begin
        DS := 0;
        write (lst,^m);
        goto loop2;
        end;
    if b_flag and (BF <> 0) then
        begin
        BF := 0;
        write (lst,^m);
        goto loop2;
        end;
    if not(decenders) then
        write (lst,^M,^[,'J',chr(printer_indexes_per_inch Div 6-1))
      else

{   Second stage when decenders are required }

        begin        {  print the decender part  }
        write (lst,^m,^[,'J',^c);    {down 3 half-pins}
        BF := $FF;
        DS := $FF;
{.pa}
loop3:
        write (lst,margin);
        write (lst,^[,'L',chr(dots mod $100),chr(dots div $100));
        extra_spaces := dots - sum;
        charactors := length(line);
        do_anyway := false;
        for x := 1 to length(line) do
            begin
            if not (pro_print) then
                if sizes[ord(line[x])] < 8 then
                    for y := 1 to ((9-sizes[ord(line[x])]) DIV 2) do
                        if (overprint and (line2[x] = '_')) or (line[x] = '_') or (underline_line[x] = $FF) then
                            write (lst,chr($01 and (((BF and DS) or Boldface_line[x])
                                           or (DS or (BF and Double_strike_line[x])))))
                          else
                            write (lst,^@);
            for y := 1 to sizes[ord(line[x])] do
                begin
                if not(line[x] in ['g','p','q','y','_','$',',']) then
                    nn := 0
                  else
                    case line[x] of
                      'g'   : nn := gee[1,y];
                      'y'   : nn := wye[1,y];
                      'p'   : nn := pee[1,y];
                      'q'   : nn := que[1,y];
                      '_'   : nn := usc[1,y];
                      '$'   : nn := dol[1,y];
                      ','   : nn := com[1,y];
                      end;
                if overprint then
                  if line2[x] in ['g','p','q','y','_','$',','] then
                    case line2[x] of
                      'g'   : nn := nn or gee[1,y];
                      'y'   : nn := nn or wye[1,y];
                      'p'   : nn := nn or pee[1,y];
                      'q'   : nn := nn or que[1,y];
                      '_'   : nn := nn or usc[1,y];
                      '$'   : nn := nn or dol[1,y];
                      ','   : nn := nn or com[1,y];
                      end;
                write (lst,chr(((nn or ($01 and underline_line[x])) and (((BF and DS) or Boldface_line[x])
                                   or (DS or (BF and Double_strike_line[x]))))));
                end;
            if not (pro_print) then
                for y := 1 to (9 -sizes[ord(line[x])] -(9-sizes[ord(line[x])]) DIV 2) do
                    if (overprint and (line2[x] = '_')) or (line[x] = '_') or (underline_line[x] = $FF) then
                        write (lst,chr($01 and (((BF and DS) or Boldface_line[x])
                                           or (DS or (BF and Double_strike_line[x])))))
                      else
                        write (lst,^@);
{.pa}
            if cpi10 then
                if (overprint and (line2[x] = '_')) or ( line[x] = '_') or (underline_line[x] = $FF) then
                    for z := 1 to 3 do
                        write (lst,chr($01 and (((BF and DS) or Boldface_line[x])
                                           or (DS or (BF and Double_strike_line[x])))))
                  else
                    write (lst,^@,^@,^@)
              else
                if (overprint and (line2[x] = '_')) or (line[x] = '_') or (underline_line[x] = $FF) then
                    write (lst,chr($01 and (((BF and DS) or Boldface_line[x])
                                           or (DS or (BF and Double_strike_line[x])))))
                  else
                    write (lst,^@);
            if not(line[x] in [' ','0'..'9']) then do_anyway := true;
            charactors := charactors - 1;
            if (extra_spaces > 0) and (not(line[x] in [' ','0'..'9']) or do_anyway) and pro_print then
                for y := 1 to (extra_spaces div charactors) +1 do
                    begin
                    if (overprint and (line2[x] = '_')) or (line[x] = '_') or (underline_line[x] = $FF) then
                        write (lst,chr($01 and (((BF and DS) or Boldface_line[x])
                                           or (DS or (BF and Double_strike_line[x])))))
                      else
                        write (lst,^@);
                    extra_spaces := extra_spaces - 1;
                    end;
            end;
        do_anyway := false;
        if pro_print then
            for y := 1 to extra_spaces do
                write (lst,^@);
        if (D_flag or B_flag) and (DS <> 0) then
            begin
            DS := 0;
            write (lst,^m);
            goto loop3;
            end;
        if b_flag and (BF <> 0) then
            begin
            BF := 0;
            write (lst,^m);
            goto loop3;
            end;
        write (lst,^m,^[,'J',^a);
        DS := $FF;
        BF := $FF;
{.pa}
Loop4:
        extra_spaces := dots - sum;
        charactors := length(line);
        write (lst,margin);
        write (lst,^[,'L',chr(dots mod $100),chr(dots div $100));
        for x := 1 to length(line) do
            begin
            if not (pro_print) then
                if sizes[ord(line[x])] < 8 then
                    for y := 1 to ((9-sizes[ord(line[x])]) DIV 2) do
                        write (lst,^@);
            for y := 1 to sizes[ord(line[x])] do
                begin
                if not(line[x] in ['g','p','q','y','_','$',',']) then
                    nn := 0
                  else
                    case line[x] of
                      'g'   : nn := gee[2,y];
                      'y'   : nn := wye[2,y];
                      'p'   : nn := pee[2,y];
                      'q'   : nn := que[2,y];
                      '_'   : nn := usc[2,y];
                      '$'   : nn := dol[2,y];
                      ','   : nn := com[2,y];
                      end;
                if overprint then
                  if line2[x] in ['g','p','q','y','_','$',','] then
                    case line2[x] of
                      'g'   : nn := nn or gee[2,y];
                      'y'   : nn := nn or wye[2,y];
                      'p'   : nn := nn or pee[2,y];
                      'q'   : nn := nn or que[2,y];
                      '_'   : nn := nn or usc[2,y];
                      '$'   : nn := nn or dol[2,y];
                      ','   : nn := nn or com[2,y];
                      end;
                write (lst,chr(nn and (((BF and DS) or Boldface_line[x])
                                      or (DS or (BF and Double_strike_line[x])))));
                end;
            if not (pro_print) then
                for y := 1 to (9 -sizes[ord(line[x])] -((9-sizes[ord(line[x])]) DIV 2)) do
                   write (lst,^@);
{.pa}
            if cpi10 then
                write (lst,^@,^@,^@)
              else
                write (lst,^@);
            if not(line[x] in [' ','0'..'9']) then do_anyway := true;
            charactors := charactors - 1;
            if (extra_spaces > 0) and (not(line[x] in [' ','0'..'9']) or do_anyway) and pro_print then
                for y := 1 to (extra_spaces div charactors) +1 do
                    begin
                    write (lst,^@);
                    extra_spaces := extra_spaces - 1;
                    end;
            end;
        if pro_print then
            for y := 1 to extra_spaces do
                write (lst,^@);
        if (D_flag or B_flag) and (DS <> 0) then
            begin
            DS := 0;
            write (lst,^m);
            goto loop4;
            end;
        if b_flag and (BF <> 0) then
            begin
            BF := 0;
            write (lst,^m);
            goto loop4;
            end;
        write (lst,^M,^[,'J',chr(printer_indexes_per_inch Div 6-5))
        end;
exit:
    end;
{$A+}
