{ ROSMSG.INC - Remote Operating System Message Sub-system }

overlay procedure mesg_enter(comment: boolean);
{ Enter a new message }
  var
    stop_msg: boolean;
    ch: char;
    last_line, to_loc: integer;
    to_fn: firstname;
    to_ln: lastname;
    subj: subject;
    key: StrName;
    mesg_array: array[0..Max_Lines] of message;

  procedure mesg_input(var last_line: integer);
  { Input message }
    var
      msg: message;
    begin
      writeln(USR);
      msg := ' ';
      while (last_line <= Max_lines) and (msg <> '') and (not brk) do
        begin
          msg := prompt(intstr(last_line, 2) + ': ', len_msg, 'AE');
          writeln(USR);
          if msg <> ''
            then
              begin
                mesg_array[last_line] := msg;
                last_line := succ(last_line)
              end
        end
    end;

  procedure mesg_print(last_line: integer);
  { Display message currently being edited }
    var
      i: integer;
    begin
      writeln(USR);
      for i := 1 to last_line do
        writeln(USR, i:2, ': ', mesg_array[i])
    end;

  procedure mesg_edit(last_line: integer);
  { Simple line-replacement 'editor' }
    var
      i: integer;
      msg: message;
    begin
      writeln(USR);
      i := strint(prompt('Line number: ', 5, 'E'));
      writeln(USR);
      if (1 <= i) and (i <= last_line)
        then
          begin
            writeln(USR, i:2, ': ', mesg_array[i]);
            writeln(USR, 'Enter new line or <RETURN> for no change:');
            msg := prompt(intstr(i, 2) + ': ', len_msg, 'AE');
            writeln(USR);
            if msg <> ''
              then mesg_array[i] := msg;
          end
        else writeln(USR, 'Line not found')
    end;

  procedure mesg_save(to_num: integer; subj: subject; last_line: integer;
    var stop_msg: boolean);
  { Save message to disk }
    var
      i, start: integer;
      file_time: tad_array;
    begin
      GetTAD(file_time);
      start := filesize(mesg_file);
      seek(summ_file, 0);
      read(summ_file, summ_rec);
      with summ_rec do
        begin
          summ_area     := AreaSet;
          summ_num      := succ(summ_num);
          summ_date     := file_time;
          summ_from_num := user_loc;
          summ_to_num   := to_num;
          summ_subject  := subj;
          summ_st_rec   := start;
          summ_size     := last_line
        end;
      seek(summ_file, 0);
      write(summ_file, summ_rec);
      seek(summ_file, filesize(summ_file));
      write(summ_file, summ_rec);

      mesg_insert(2);

      seek(mesg_file, start);
      for i := 1 to last_line do
        begin
          mesg_rec.mesg_text := mesg_array[i];
          write(mesg_file, mesg_rec)
        end;

      writeln(USR);
      writeln(USR, 'Message ', summ_rec.summ_num, ' filed ', FormTAD(file_time));
      stop_msg := TRUE
    end;

  procedure mesg_quit(var stop_msg: boolean);
  { Return to command mode }
    begin
      writeln(USR);
      writeln(USR, 'Cancelled.');
      stop_msg := TRUE
    end;

  begin { mesg_enter }
    if user_rec.access < 20
      then list('D');
    writeln(USR);
    writeln(USR, 'From: ', user_rec.fn, ' ', user_rec.ln);
    repeat
      if comment or (user_rec.access < 20)
        then
          begin
            to_fn := 'SYSOP';
            writeln(USR, '  To: ', to_fn)
          end
        else
          begin
            to_fn := prompt('To FIRST name or <RETURN> for ALL: ', len_fn, 'ES');
            writeln(USR)
          end;
      if to_fn = ''
        then
          begin
            to_loc := mesg_pub;
            OK := TRUE
          end
        else
          begin
            if to_fn = 'SYSOP'
              then to_ln := ''
              else
                begin
                  to_ln := prompt('LAST name: ', len_ln, 'ES');
                  writeln(USR)
                end;
            key := pad(to_ln, len_ln) + pad(to_fn, len_fn);
            FindKey(IdxF, to_loc, key);
            if not OK
              then writeln(USR, to_fn, ' ', to_ln, ' not known on system.')
          end
    until (not online) or OK;
    if user_rec.access < 20
      then
        begin
          subj := 'New user';
          writeln(USR, '  Re: ', subj)
        end
      else
        begin
          subj := prompt('Subject: ', len_subj, 'E');
          writeln(USR)
        end;
    writeln(USR);
    writeln(USR, 'To re-enter command mode, enter empty line (<RETURN> only).');
    writeln(USR, 'Enter message (', Max_Lines, ' line limit):');
    last_line := 1;
    mesg_input(last_line);
    stop_msg := FALSE;
    repeat
      writeln(USR);
      case select('<L>ist, <E>dit, <C>ontinue, <S>ave, <Q>uit:', 'ListEditContinueSaveQuit') of
        'L': mesg_print(pred(last_line));
        'E': mesg_edit(pred(last_line));
        'C': mesg_input(last_line);
        'S': mesg_save(to_loc, subj, pred(last_line), stop_msg);
        'Q': mesg_quit(stop_msg)
      end
    until (not online) or stop_msg
  end;

overlay procedure mesg_quick_scan;
{ Print abbreviated summary of messages }
  var
    private: boolean;
    sep: char;
  begin
    mesg_find(mesg_start('Start'));
    writeln(USR);
    while (MesgCurr <> nil) and (not brk) do
      begin
        private := (MesgCurr^.TypMsg <> 0);
        if private
          then sep := '*'
          else sep := ':';
        seek(summ_file, MesgCurr^.SummLoc);
        read(summ_file, summ_rec);
        writeln(USR, MesgCurr^.MesgNo, sep, ' ', summ_rec.summ_subject);
        MesgCurr := MesgCurr^.next
      end;
    if private
      then
        begin
          writeln(USR);
          writeln(USR, '"*" indicates a private message.')
        end
  end;

overlay procedure mesg_summary;
{ Message summary }
  var
    start, last_line: integer;
  begin
    mesg_find(mesg_start('Start'));
    while (MesgCurr <> nil) and (not brk) do
      begin
        mesg_header_list(start, last_line);
        MesgCurr := MesgCurr^.next
      end
  end;

overlay procedure mesg_read;
{ Read message }
  var
    i, start, last_line: integer;
  begin
    mesg_find(mesg_start('Start'));
    OK := TRUE;
    while OK and (MesgCurr <> nil) and (not brk) do
      begin
        mesg_header_list(start, last_line);
        seek(mesg_file, start);
        i := 1;
        while (not brk) and (i <= last_line) do
          begin
            read(mesg_file, mesg_rec);
            writeln(USR, mesg_rec.mesg_text);
            i := succ(i)
          end;
        if (user_loc = summ_rec.summ_from_num) or
           (user_loc = summ_rec.summ_to_num) or
           (user_rec.access = 255)
          then if ask('Do you wish to ERASE this message')
                 then mesg_delete(0)
                 else
                   begin
                     writeln(USR, 'Message retained.');
                     if area_assign and (user_rec.access = 255)
                       then
                         begin
                           summ_rec.summ_area := strint(prompt('Message area # ', 3, 'E'));
                           writeln(USR);
                           seek(summ_file, pred(FilePos(summ_file)));
                           Write(summ_file, summ_rec)
                         end
                   end;
        MesgCurr := MesgCurr^.next;
        if MesgCurr <> nil
          then OK := ask('Read next message')
      end
  end;

overlay procedure mesg_kill;
{ Read message }
  var
    start: integer;
  begin
    start := mesg_start('Message');
    mesg_find(start);
    if (MesgCurr^.MesgNo = start) and
       ((user_loc = summ_rec.summ_from_num) or
        (user_loc = summ_rec.summ_to_num) or
        (user_rec.access >= 200))
      then mesg_delete(start)
      else writeln(USR, 'Not found.')
  end;

overlay procedure mesg_area_change(req: Str10);
{ Change message area }
  var
    i: integer;
    this: AreaPtr;
    st: StrPr;

  procedure mesg_build_index(area: byte);
  { Scan summary file and build message index list.  Public messages are
    tied to message area.  Private and authored messages are accessible
    from all areas.  All messages are viewable from area #0 (SYSTEM). }
    var
      this: MesgPtr;
    begin
      while MesgBase <> nil do              { Delete old messages }
        begin
          this := MesgBase;
          MesgBase := MesgBase^.next;       { Go to next on list }
          dispose(this)                     { Reclaim space }
        end;
      msg_all := 0;
      msg_ind := 0;
      msg_aut := 0;
      msg_sys := 0;
      seek(summ_file, 1);
      while not EOF(summ_file) do
        with summ_rec do
          begin
            read(summ_file, summ_rec);
            if (summ_to_num = mesg_pub) and (area = summ_area)
              then
                begin                       { Public message }
                  msg_all := succ(msg_all);
                  mesg_insert(0)
                end
            else if summ_to_num = user_loc
              then
                begin                       { Private message }
                  msg_ind := succ(msg_ind);
                  mesg_insert(1)
                end
            else if (summ_to_num <> mesg_era) and (summ_from_num = user_loc)
              then
                begin                       { Author of message }
                  msg_aut := succ(msg_aut);
                  mesg_insert(2)
                end
            else if area = 0
              then
                begin                       { Sysop can view all messages }
                  msg_sys := succ(msg_sys);
                  mesg_insert(3)
                end
          end
      end;

  procedure mesg_directory;
  { Display directory of messages }
    var
      hi: integer;
    begin
      if MesgBase = nil
        then hi := 0
        else hi := MesgLast^.MesgNo;
      writeln(USR, 'High message now  : ', hi);
      writeln(USR, 'Public messages   : ', msg_all);
      writeln(USR);
      if msg_ind = 0
        then writeln(USR, user_rec.fn, ', no personal mail for you today.')
        else
          begin
            writeln(USR, user_rec.fn, ', the following messages are addressed to you personally:');
            MesgCurr := MesgBase;
            while (MesgCurr <> nil) and (not brk) do
              begin
                if MesgCurr^.TypMsg = 1
                  then write(USR, MesgCurr^.MesgNo, '  ');
                MesgCurr := MesgCurr^.next
              end;
            writeln(USR)
          end;
      if msg_aut > 0
        then
          begin
            writeln(USR, user_rec.fn, ', the following messages were sent by you:');
            MesgCurr := MesgBase;
            while (MesgCurr <> nil) and (not brk) do
              begin
                if MesgCurr^.TypMsg = 2
                  then write(USR, MesgCurr^.MesgNo, '  ');
                MesgCurr := MesgCurr^.next
              end;
            writeln(USR)
          end
    end;

  begin { mesg_area_change }
    if req = ''
      then
        begin
          req := compress(prompt('Message area (? for MENU): ', 10, 'ES'));
          writeln(USR)
        end;
    while req <> '' do
      begin
        this := AreaBase;
        if req = '?'
          then
            begin
              writeln(USR, 'Available message areas:');
              writeln(USR);
              while (not brk) and (this <> nil) do
                begin
                  if user_rec.access >= this^.AreaAccs
                    then writeln(USR, pad(this^.AreaName, 14), this^.AreaDesc)
                  else if this^.AreaAccs < 100
                    then writeln(USR, pad(this^.AreaName, 14), 'Validation required');
                  this := this^.next
                end;
              writeln(USR);
              req := compress(prompt('Message area (? for MENU): ', 10, 'AES'));
              writeln(USR)
            end
        else if req <> ''
          then
            begin
              while (req <> this^.AreaName) and (this <> nil) do
                this := this^.next;
              if (req = this^.AreaName) and (user_rec.access >= this^.AreaAccs)
                then
                  begin
                    AreaSet := this^.Area;
                    AreaReq := req;
                    req := '';
                    mesg_build_index(AreaSet);
                    mesg_directory
                  end
              else if (req = this^.AreaName) and (this^.AreaAccs < 100)
                then
                  begin
                    writeln(USR, 'Validation required');
                    writeln(USR);
                    req := compress(prompt('Message area (? for MENU): ', 10, 'AES'));
                    writeln(USR)
                  end
                else
                  begin
                    writeln(USR, '"', req, '" not found.  Available message areas:');
                    writeln(USR);
                    i := 0;
                    this := AreaBase;
                    while (not brk) and (this <> nil) do
                      begin
                        if user_rec.access >= this^.AreaAccs
                          then
                            begin
                              write(USR, pad(this^.AreaName, 12));
                              i := succ(i);
                              if 0 = i mod 6
                                then writeln(USR)
                            end;
                        this := this^.next
                      end;
                    if 0 <> i mod 6
                      then writeln(USR);
                    writeln(USR);
                    req := compress(prompt('Message area (? for MENU): ', 10, 'AES'));
                    writeln(USR)
                  end
            end
      end
  end;