⟦b5ae4e934⟧

TextFile


(*********************************)
(* local procedures for module 1 *)

procedure change_par_state(line_sort : line_sort_type);
  type char3 = array(.1..3.) of char;
  const
    table : array(.par_state_type, line_sort_type.) of char3
    (* where the characters are encoded as follows :
       1st char is new par_state
          (O - outside, H - heading, N - normal_par, L - list_par),
       2nd char is a closing action
          (space - none, p - for paragraph, h - for heading),
       3rd char is an opening action
          (space - none, p - for paragraph, h - for heading),
       xxx means undefined (unused entry)
    *)
               (* blank  normal  normal_new_par  list  list_new_par *)
    = (
(* outside    *) ('O  ', 'H h',      'N p',      'L p',    'L p' ),
(* heading    *) ('Oh ', 'H  ',      'Nhp',      'xxx',    'xxx' ),
(* normal_par *) ('Op ', 'N  ',      'Npp',      'xxx',    'xxx' ),
(* list_par   *) ('Op ', 'xxx',      'xxx',      'L  ',    'Lpp' ) );

  var t : char3;
begin
  t := table(.par_state, line_sort.);
  case t(.1.) of
    'O' : par_state := outside;
    'H' : par_state := heading;
    'N' : par_state := normal_par;
    'L' : par_state := list_par
   end;
  case t(.2.) of
    ' ' : ;
    'p' : begin
            close_par_1b; command_2(close_par, irrelevant);
          end;
    'h' : begin
            close_par_1b; command_2(close_heading, irrelevant);
          end;
  end;
  case t(.3.) of
    ' ' : ;
    'p' : command_2(open_par, irrelevant);
    'h' : command_2(open_heading, irrelevant);
  end;
end; (* change_par_state *)

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


procedure init_1;
begin
  inside_figure := false; inside_block := false;
  text_processed := true;
  state := copy; par_state := outside;

  left              := init_left;
  left_add          := init_left_add;
  indentation       := init_indentation;
  right             := init_right;
  hdft_left         := init_hf_left;
  hdft_right        := init_hf_right;
  straight_margin   := init_straight_margin;
  max_white_space   := init_max_white_space;
  hdft_line_spacing := init_hf_line_spacing;
  hd_height         := init_head_height;
  ft_height         := init_foot_height;
  pg_height         := init_page_height;

  init_1b;
  init_2;
end;

procedure write_line_1(var line : f_string);
  const command_len = 20;
  var i : index;
        (* note: i is used by procedures command_error
           and get_number *)
      command : array(.1..command_len.) of char;
        (* is used by get_number *)
      number : integer;
        (* is used for the result of get_number *)

  procedure command_error;
    var j : integer;
  begin
    writeln;
    j := 1;
    while line(.j.).ch <> cr do begin
      write(line(.j.).ch); j := j+1
    end;
    writeln;
    if i-2 > 15+2 then
      writeln('FEJL I KOMMANDO', ' ':(i-2-15), '^')
    else
      writeln(' ':(i-2), '^  FEJL I KOMMANDO');
  end;

  procedure get_number(min, max : integer);
    var j : index; num : integer;
  begin
    while line(.i.).ch = ' ' do i := i+1;
    if line(.i.).ch = '?' then begin
      repeat
        j := 1;
        while command(.j.) <> ' ' do begin
          write(command(.j.)); j := j+1;
        end;
        write(' = ');
        (*$I-*) readln(num); (*I+*)
        if (ioresult <> 0) or (num > max) then num := min-1;
        writeln;
        if num < min then writeln('Fejl i tallet. Prøv igen.');
      until num >= min;
      i := i+1; number := num;
    end else begin (* read number from command line *)
      j := i; num := 0;
      while line(.i.).ch in (.'0'..'9'.) do i := i+1;
      if (i = j) or (i-j > 4) then begin
        command_error; number := undefined;
      end else begin
        num := 0;
        while j < i do begin
          num := num*10+ord(line(.j.).ch)-ord('0'); j := j+1;
        end;
        if (num < min) or (num > max) then begin
          command_error; number := undefined;
        end else
          number := num;
      end;
    end;
  end; (* get_number *)

  const ok = false; (* used with give_command and assign below *)

  procedure give_command(command : command_type;
                         var variable : integer; error : boolean);
  begin
    if error then
      command_error
    else
      if number <> undefined then begin
        command_2(command, number); variable := number
      end
  end;

  procedure assign(var variable : integer; error : boolean);
  begin
    if error then
      command_error
    else
      if number <> undefined then variable := number
  end;

  var j : index0;
      pos : 0..command_len;
      xline : f_string;
      indention, divide_point : integer;
      line_sort : line_sort_type;
      dummy : integer;
      p : justification;
      okay  : boolean;
      include_name : name;

begin (* write_line_1 *)
  if (line(.1.).ch = '$') and (line(.2.).ch = '#') then begin
    (* command line *)
    if state = format then change_par_state(blank);
    i := 3;
    while line(.i.).ch = ' ' do i := i+1;
    while line(.i.).ch <> cr do begin
      pos := 0;
      repeat
        if pos < command_len then begin
          pos := pos+1; command(.pos.) := line(.i.).ch;
          if command(.pos.) in (.'A'..'Å'.) then
            command(.pos.) := chr(ord(command(.pos.))+32);
        end;
        i := i+1;
      until line(.i.).ch in (.'0'..'9', ' ', '?', cr.);
      while pos < command_len do begin
        pos := pos+1; command(.pos.) := ' ';
      end;
      number := irrelevant;
      if command = 'venstre             ' then begin
        get_number(0, right-(indentation+left_add+min_width));
        assign(left, ok); changed_1b;
      end else
      if command = 'højre               ' then begin
        get_number(left+(indentation+left_add+min_width),
                   max_right_margin);
        assign(right, ok);
      end else
      if command = 'indryk              ' then begin
        get_number(0, right-(left+left_add+min_width));
        assign(indentation, ok);
      end else
      if command = 'liste               ' then begin
        get_number(0, right-(left+indentation+min_width));
        assign(left_add, ok); changed_1b;
      end else
      if command = 'spildplads          ' then begin
        get_number(0, max_right_margin); assign(max_white_space, ok);
      end else
      if command = 'linieafstand        ' then begin
        get_number(min_line_spacing, max_line_spacing);
        give_command(set_line_spacing, dummy, ok);
      end else
      if command = 'centrer             ' then
        state := center
      else
      if command = 'kopier              ' then
        state := copy
      else
      if command = 'formatter           ' then
        state := format
      else
      if command = 'lige-margen         ' then begin
        get_number(0, 1);
        if number <> undefined then straight_margin := number=1;
      end else
      if ( command >= 'hovedaa             ' ) and
         ( command <= 'hovedåå             ' ) and
         ( command(.8.) = ' ' )                and
         ( command(.7.) in (.'v', 'm', 'h'.) ) and
         ( command(.6.) < chr(ord('a')+nr_head_foot_lines) ) then begin
        case command(.7.) of
          'v' : p := left_side;
          'm' : p := middle;
          'h' : p := right_side
        end;
        i := i+1; j := f_pos(cr, line, i, f_len);
        f_copy(line, i, j-1, xline, 1);
        if inside_figure then
          command_error
        else
          text_command_2(head, ord(command(.6.))-ord('a')+1,
                         p, xline, j-i);
        i := j;
      end else
      if ( command >= 'fodaa               ' ) and
         ( command <= 'fodåå               ' ) and
         ( command(.6.) = ' ' )                and
         ( command(.5.) in (.'v', 'm', 'h'.) ) and
         ( command(.4.) < chr(ord('a')+nr_head_foot_lines) ) then begin
        case command(.5.) of
          'v' : p := left_side;
          'm' : p := middle;
          'h' : p := right_side
        end;
        i := i+1; j := f_pos(cr, line, i, f_len);
        f_copy(line, i, j-1, xline, 1);
        if inside_figure then
          command_error
        else
          text_command_2(foot, ord(command(.4.))-ord('a')+1,
                         p, xline, j-i);
        i := j;
      end else
      if command = 'sidenummer          ' then begin
        get_number(0, 9999);
        give_command(set_page_nr, dummy, inside_figure)
      end else
      if command = 'h/f-venstre         ' then begin
        get_number(0, hdft_right);
        give_command(set_hf_left, hdft_left, inside_figure);
      end else
      if command = 'h/f-højre           ' then begin
        get_number(hdft_left, max_right_margin);
        give_command(set_hf_right, hdft_right, inside_figure);
      end else
      if command = 'h/f-linieafstand    ' then begin
        get_number(min_line_spacing, max_line_spacing);
        give_command(set_hf_line_spacing,
                     hdft_line_spacing, inside_figure);
      end else
      if command = 'hoved-højde         ' then begin
        get_number(min_line_spacing,
                   pg_height-ft_height-char_height);
        give_command(set_head_height, hd_height, inside_figure);
      end else
      if command = 'fod-højde           ' then begin
        get_number(min_line_spacing,
                   pg_height-hd_height-char_height);
        give_command(set_foot_height, ft_height, inside_figure);
      end else
      if command = 'side-højde          ' then begin
        get_number(hd_height+ft_height+char_height, maxint);
        assign(pg_height, text_processed);
      end else
      if command = 'blok-start          ' then begin
        if inside_figure or inside_block then
          command_error
        else begin
          command_2(open_block, irrelevant);
          inside_block := true;
        end
      end else
      if command = 'blok-slut           ' then begin
        if inside_figure or not inside_block then
          command_error
        else begin
          command_2(close_block, irrelevant);
          inside_block := false;
        end
      end else
      if command = 'figur-start         ' then begin
        get_number(min_line_spacing, maxint);
        give_command(open_figure, dummy, inside_figure or inside_block)
      end else
      if command = 'figur-slut          ' then begin
        get_number(min_line_spacing, maxint);
        give_command(close_figure, dummy,
                     not inside_figure or inside_block)
      end else
      if command = 'klæb                ' then
        give_command(paste, dummy, inside_figure or inside_block)
      else
      if command = 'ny-side             ' then
        give_command(eject, dummy, inside_figure or inside_block)
      else
      if command = 'punkt               ' then begin
        change_par_state(list_new_par); text_processed := true;
        j := f_pos(cr, line, i+1, f_len);
        write_in_margin_1b(line, i+1, j-1);
        i := j;
      end else
      if command = 'medtag              ' then begin
        while line(.i.).ch = ' ' do i := i+1;
        include_name := '';
        while line(.i.).ch <> cr do begin
          include_name := include_name + line(.i.).ch; i := i+1;
        end;
        include_input(include_name, okay);
        if not okay then command_error;
      end else
        command_error;
      while line(.i.).ch = ' ' do i := i+1;
    end; (* while line(.i.).ch <> cr *)
  end else begin
    (* not a command line *)
    text_processed := true;
    case state of
    copy :
      begin
        j := f_pos(cr, line, 1, f_len)-1;
        if j = 0 then
          write_line_2(line, 0)
        else begin
          f_space(left, xline, 1);
          f_copy(line, 1, j, xline, 2);
          write_line_2(xline, 1+j);
        end;
      end;
    center:
      begin
        j := f_pos(cr, line, 1, f_len)-1;
        if j = 0 then
          write_line_2(line, 0)
        else begin
          indention := max(0,
                           (right-left-width(line, 1, j)) div 2 + left);
          f_space(indention, xline, 1);
          f_copy(line, 1, j, xline, 2);
          write_line_2(xline, 1+j)
        end;
      end;
    format:
      begin
        (* Find line_sort. If line_sort = list or list_new_par,
           then remove cr's from the margin-text and calculate
           margin_text and indent. *)
        if line(.1.).ch = cr then
          line_sort := blank
        else
        if left_add = 0 then begin
          if line(.1.).ch = ' ' then
            line_sort := normal_new_par
          else
            line_sort := normal
        end else begin
          if line(.1.).ch = ' ' then
            line_sort := list_new_par
          else
            line_sort := list
        end;
        change_par_state(line_sort);
        (* now, format the line *)
        if line_sort = blank then begin
          write_line_2(line, 0)
        end else begin
          if (line_sort = normal_new_par) or
             (line_sort = list_new_par) then indent_1b;
          i := 1;
          while line(.i.).ch = ' ' do i := i+1;
          while line(.i.).ch <> cr do begin
            j := f_pos(' ', line, i+1, f_len);
            if j = i then j := f_pos(cr, line, i+1, f_len);
            write_word_1b(line, i, j-1, divide_point);
            if divide_point <> -1 then begin
              insert_dividepoint_input(divide_point);
              if divide_point = i then
                insert_dividepoint_input(divide_point);
            end;
            i := j+1;
            while line(.i.).ch = ' ' do i := i+1;
          end; (* while *)
        end; (* non-blank line *)
      end; (* format case *)
    end; (* case *)
  end; (* processing of a non-command line *)
end; (* write_line_1 *)

procedure terminate_1;
begin
  change_par_state(blank);
  if inside_figure then command_2(close_figure, 0);
  if inside_block then command_2(close_block, irrelevant);
  terminate_1b;
  terminate_2;
end;

(*                        MODULE 1 ENDS                            *)
(*                                                                 *)
(*******************************************************************)

«eof»
DataMuseum.dk

Bogika Butler

⟦b5ae4e934⟧ TextFile

Derivation

TextFile
