⟦c4fcf5689⟧

TextFile



(**************************************************************)
(*                                                            *)
(*                     MODULE 3 starts                        *)

type
  buffer_type = array(.1..buffer_size.) of record
                  line : f_string;
                  len  : index0;
                  line_spacing : integer;
                end;

var
  directly_out, first_page, on_top_of_page : boolean;
  spacing_of_previous_line : integer;
  space_left_on_page : integer;

  buffer : buffer_type;
  nr_buffer_lines : integer;
  buffer_height : integer;
  buffer_file : file of buffer_type;

  head_foot : array(.place,
                     1..nr_head_foot_lines,
                     justification.) of record
                line : f_string;
                len  : index0;
              end;
  first_page_to_print, last_page_to_print : integer;
  print_page : boolean;
  nr_of_this_page, nr_of_next_page : integer;
  number : array(.1..5.) of char; (* nr_of_this_page in print format *)
  chars_in_nr : integer; (* no. of valid chars in number *)

  hf_left, hf_right, hf_line_spacing,
    foot_height, saved_foot_height,
    head_height, page_height : integer;

(*********************************)
(* local procedures for module 3 *)

procedure print_head_foot(hf : place; height : integer);
  (* prints the head or the foot of a page *)
  var nr_lines, white_space,
      i, j, pos, t1, p1, chars_missing : integer;
      just : justification;
      x_line, t_line : f_string;
      x_len, t_len : index0;
      x_width, t_width : integer;
begin
  nr_lines := min(nr_head_foot_lines, height div hf_line_spacing);
  for i := 1 to nr_lines do begin
    if (head_foot(.hf, i, left_side.).len = 0) and
       (head_foot(.hf, i, middle.).len = 0) and
       (head_foot(.hf, i, right_side.).len = 0)
    then begin
      if print_page then write_white_space_output(hf_line_spacing)
    end else begin
      (* build a line from the left, the middle and the right part *)
      x_len := 0; x_width := 0;
      for just := left_side to right_side do begin
        (* copy one of the 3 parts to t_line while substituting
           the value of the page number for any series of #'s *)
        with head_foot(.hf, i, just.) do begin
          t_len := 0; pos := 1;
          while pos <= len do begin
            p1 := pos; pos := f_pos('#', line, pos, len);
            if pos < p1 then pos := len+1;
            f_copy(line, p1, pos-1, t_line, t_len+1);
            t_len := t_len+(pos-p1);
            if pos <= len then begin
              (* substitute page number for a series of #'s *)
              t1 := t_len; p1 := pos;
              while (line(.pos.).ch = '#') and (pos <= len) do
                pos := pos+1;
              (* now positions p1...pos-1 contain #'s *)
              (* copy minimum chars_in_nr #'s to t_line : *)
              chars_missing := chars_in_nr - (pos-p1);
              if chars_missing > 0 then begin
                f_fill(line(.p1.).ch, line(.p1.).attr,
                       t_line, t_len+1, t_len+chars_missing);
                t_len := t_len+chars_missing;
              end;
              f_copy(line, p1, pos-1, t_line, t_len+1);
              t_len := t_len+(pos-p1);
              (* now subsitute the #'s in t_line with the nr : *)
              for j := 1 to (t_len-t1)-chars_in_nr do
                t_line(.t1+j.).ch := ' ';
              for j := 1 to chars_in_nr do
                t_line(.t_len-(j-1).).ch := number(.j.);
            end;
          end; (* while pos < len *)
          t_width := width(t_line, 1, t_len);
        end; (* with ... *)

        (* calculate how much white space to put into x_line
           before the contents of t_line : *)
        case just of
          left_side  :
            white_space := hf_left;
          middle     :
            begin
              white_space := ( hf_right-hf_left-t_width ) div 2
                             + hf_left - x_width;
              if white_space < 0 then begin
                white_space := 0;
                if t_width > 0 then begin
                  write('Advarsel : I linie ', i, ' i ');
                  if hf=head then write('hovedet') else write('foden');
                  writeln(' på side ', nr_of_this_page,
                    ' var det ikke muligt at centrere den midterste del');
                end;
              end;
            end;
          right_side :
            begin
              white_space := hf_right - t_width - x_width;
              if white_space < 0 then begin
                white_space := 0;
                if t_width > 0 then begin
                  write('Advarsel : Linie ', i, ' i ');
                  if hf=head then write('hovedet') else write('foden');
                  writeln(' på side ', nr_of_this_page, ' er blevet for lang');
                end;
              end;
            end;
        end; (* case just of *)

        (* put the calculated amount of white space into x_line
           followed by the contents of t_line : *)
        f_space(white_space, x_line, x_len+1);
        x_len := x_len+1; x_width := x_width+white_space;
        while x_width + t_width > max_right_margin do begin
          t_width := t_width-width(t_line, t_len, t_len);
          t_len := t_len-1;
        end;
        f_copy(t_line, 1, t_len, x_line, x_len+1);
        x_len := x_len+t_len; x_width := x_width+t_width;

      end; (* for just := ... *)
      if print_page then
        write_line_output(x_line, x_len, hf_line_spacing);
    end; (* if ...len + ...len + ...len *)
  end; (* for i := 1 to nr_lines *)

  j := height - nr_lines*hf_line_spacing;
  if j > 0 then
    if print_page then write_white_space_output(j);
end; (* print_head_foot *)


procedure eject_page;
  var real_space_left : integer;
begin
  if on_top_of_page then
    real_space_left := space_left_on_page
  else
    real_space_left := space_left_on_page+spacing_of_previous_line
                                         -char_height;
  write('På side ', nr_of_this_page, ' er der ',
        real_space_left, ' punkter tilbage i højden.');
  if real_space_left >= 0 then
    writeln
  else begin
    writeln(' ADVARSEL : OVERFYLDT !');
    while real_space_left < 0 do begin
      real_space_left    := real_space_left   +page_height;
      space_left_on_page := space_left_on_page+page_height;
    end;
  end;
  if print_page then
    write_white_space_output(space_left_on_page);
  print_head_foot(foot, saved_foot_height);
end;

procedure print_buffer;
  var i, j : integer;
begin
  if nr_buffer_lines > 0 then begin
    if nr_buffer_lines > buffer_size then begin
      write(buffer_file, buffer);
      close(buffer_file);
      reset(buffer_file);
      read(buffer_file, buffer);
    end;
    for i := 1 to nr_buffer_lines do begin
      j := (i-1) mod buffer_size + 1;
      with buffer(.j.) do begin
        if print_page then
          write_line_output(line, len, line_spacing);
        space_left_on_page := space_left_on_page-line_spacing;
      end;
      if (j = buffer_size) and (i < nr_buffer_lines) then
        read(buffer_file, buffer);
    end;
    if nr_buffer_lines > buffer_size then begin
      close(buffer_file); erase(buffer_file);
    end;
    on_top_of_page := false; nr_buffer_lines := 0;
  end;
end; (* print_buffer *)

procedure new_page;
  var xline : f_string;
      len, p1, p2 : index0;
      i, num : integer;
begin
  if not first_page then eject_page; first_page := false;
  (* convert page_nr to print format : *)
  nr_of_this_page := nr_of_next_page;
  nr_of_next_page := nr_of_next_page+1;
  num := nr_of_this_page; chars_in_nr := 0;
  repeat
    chars_in_nr := chars_in_nr+1;
    number(.chars_in_nr.) := chr(ord('0')+ num mod 10);
    num := num div 10;
  until num = 0;
  print_page := (nr_of_this_page >= first_page_to_print) and
                (nr_of_this_page <= last_page_to_print);
  (* print head : *)
  print_head_foot(head, head_height);
  on_top_of_page := true;
  space_left_on_page := page_height-head_height-foot_height;
  saved_foot_height := foot_height;
end; (* new_page *)

(* end of local procedures for module 3 *)
(****************************************)

procedure init_3;
  var i : place; j : 1..nr_head_foot_lines; k : justification;
begin
  directly_out := true; first_page := true;
  spacing_of_previous_line := char_height;
  nr_buffer_lines := 0;
  for i := head to foot do
    for j := 1 to nr_head_foot_lines do
      for k := left_side to right_side do
        head_foot(.i, j, k.).len := 0;
  first_page_to_print := 0;
  last_page_to_print := maxint;
  nr_of_next_page := init_page_nr;
  hf_left         := init_hf_left;
  hf_right        := init_hf_right;
  hf_line_spacing := init_hf_line_spacing;
  head_height     := init_head_height;
  foot_height     := init_foot_height;
  page_height     := init_page_height;
  assign(buffer_file, buffer_file_name);
end;

procedure pages_to_print_3(first, last : integer);
begin
  first_page_to_print := first;
  last_page_to_print := last;
end;

procedure write_line_3(may_break : boolean; var line : f_string;
                       len : index0; line_spacing : integer);

  procedure put_line_into_buffer;
  begin
    buffer(.1.).line := line; buffer(.1.).len := len;
    buffer(.1.).line_spacing := line_spacing;
    nr_buffer_lines := 1; buffer_height := char_height;
  end;

  procedure add_line_to_buffer;
    var buf_index : 1..buffer_size;
  begin
    if nr_buffer_lines = 0 then
      put_line_into_buffer
    else begin
      buf_index := nr_buffer_lines mod buffer_size + 1;
      if buf_index = 1 then begin
        if nr_buffer_lines = buffer_size then rewrite(buffer_file);
        write(buffer_file, buffer);
      end;
      buffer(.buf_index.).line := line; buffer(.buf_index.).len := len;
      buffer(.buf_index.).line_spacing := line_spacing;
      buffer_height := buffer_height+spacing_of_previous_line;
      nr_buffer_lines := nr_buffer_lines+1;
    end;
  end;

begin (* write_line_3 *)
  if first_page then new_page;
  if directly_out then begin
    if not may_break then begin
      put_line_into_buffer;
      print_buffer;
    end else begin
      directly_out := false;
      put_line_into_buffer;
    end;
  end else begin (* not directly_out *)
    if not may_break then begin
      add_line_to_buffer;
      if buffer_height > space_left_on_page then begin
        new_page; print_buffer; directly_out := true;
      end;
    end else begin
      if buffer_height > space_left_on_page then new_page;
      if not (on_top_of_page and (nr_buffer_lines = 1) and
              (buffer(.1.).len = 0) ) then
        print_buffer;
      put_line_into_buffer;
    end;
  end;
  spacing_of_previous_line := line_spacing;
end; (* write_line_3 *)

procedure command_3(command : command_type;
                    param, param2, param3, param4 : integer);
begin
  case command of
    set_page_nr :
      nr_of_next_page := param;
    set_hf_left :
      hf_left := param;
    set_hf_right :
      hf_right := param;
    set_hf_line_spacing :
      hf_line_spacing := param;
    set_head_height :
      head_height := param;
    set_foot_height :
      foot_height := param;
    set_page_height :
      page_height := param;
    eject :
      begin
        print_buffer; directly_out := false; new_page;
      end;
    figure :
      (* to be implemented *)
  end;
end; (* command_3 *)

procedure text_command_3(placing : place; line_id : integer;
                         p : justification;
                         var text : f_string; length : index0);
begin
  with head_foot(.placing, line_id, p.) do begin
    line := text; len := length;
  end
end;

procedure terminate_3;
begin
  if not directly_out then begin
    if buffer_height > space_left_on_page then new_page;
    if not (on_top_of_page and (nr_buffer_lines = 1) and
            (buffer(.1.).len = 0) ) then
      print_buffer;
  end;
  eject_page;
end;

(*                     MODULE 3 ends                          *)
(*                                                            *)
(**************************************************************)

«eof»
DataMuseum.dk

Bogika Butler

⟦c4fcf5689⟧ TextFile

Derivation

TextFile
