{ File: Lb:[22,311]SENDER.PAS       Last Edit: 6-APR-1990 00:01:36 
}
{ [a+,b+,l-,k+,r+] Pasmat }

PROGRAM SENDER;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  Test program for MSGPACKET.TYP, MSGPACKET.PAS (CPITAS,CPSTAS,SNDMSG,RCVMSG).
  This program also doubles as a send/receive tool for sending and 
  receiving message packets. 

 History:

     6-APR-1990 Jim Bostwick.   Clean up output formats a bit. 
     4-APR-1990 Jim Bostwick.   Add Delay command. This inserts variable
    				delay after SEND to allow other task output
				before SENDER starts babbling again. 
    14-DEC-1989 Jim Bostwick. 	Added Pause (STOP$S) function. 
    20-NOV-1989 Jim Bostwick.   More work on the user interface. 
                                The 'N(osend)' option is now 'R(eceive)',
                                although N will still work. 
    20-OCT-1989 Jim Bostwick.   Major hack for Message_rec integrated network
                                messages. INCOMPATIBLE with previous versions!
    03-Feb-89.  Philip Hannay.  Created.
    18-Mar-89.  Philip Hannay.  Updated for packet sub types    
    22-Mar-89.  Bob Thomas.     Added the "Report status" device
    04-Apr-89.  Bob Thomas.     Modified in keeping with modifications to 
                                the msgpackets.
    07-Apr-89.  Bob Thomas.     Altered the form of the program and added <25> 
                                style of specifying characters to Pk_info_short.
    31-May-89.  Bob Thomas.     Added send half of Pk_synch and stubbed
                                Pk_field_value.
    19-Jun-89.  Philip Hannay.  Miscellaneous modifications to accomodate
                                changes to MSGPACKET.TYP.  Includes addition
                                of PK_RECORD type, and some name changes.
     8-Aug-89.  Philip Hannay.  Fleshed out PK_BIN, add PK_CONTROL_NUMERIC
                                and PK_CONTROL_ALPHA, replacing 
                                PK_CONTROL_SHORT and PK_CONTROL_LONG.
                                Added changes for PK_SCALE and PK_RECORD.
    15-SEP-89.  Tom Trulson.    Extended Pk_comment input from 80 characters
                                to 199 characters.


~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
 %include pas$ext:General.typ;
 %include pas$ext:string.pkg;
 %INCLUDE 'pas$ext:message.pkg';
 %include pas$ext:castin.ext;
 %include pas$ext:cpitas.ext;
 %include pas$ext:cpstas.ext;
 %INCLUDE 'pas$ext:stop.ext';
 %INCLUDE 'pas$ext:wait.ext';

  Var

    alpha_id: ch20;
    alpha_sub: ch20;
    escape: boolean;
    exit_requested: boolean;
    long_alpha_sub: ch80;
    med_alpha_sub: ch50;
    in_msg, out_msg: message_rec;
    stat: integer;
    delay: Integer; 
    comman, old_comman, task_name, old_task_name: ch6;
    to_node, to_task: ch6;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}


  PROCEDURE SCOMPARE(t: Ch20;
                     s: Ch20;
                     var result: Boolean);

  { Compare the source string (S) to the target string (T).  If
    S is a truncation of T, then return RESULT true. }

    var
      i: integer;


    begin
    { convert both strings to uppercase to make our compare case independent }
      supper(t);
      supper(s);
      i := 0;
      result := true;
      repeat
        i := i + 1;
        if (s[i] <> chr(0)) and (s[i] <> t[i]) then
          result := false;
      until (result = false) or (s[i] = chr(0)) or (i = 20);
    end;

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}


  PROCEDURE GET_ANY_MESSAGES;

   { read and display any outstanding messages }

    var
      i, len: integer;
      recv_task_name: ch6;

      {~~~~~~~~~}


    PROCEDURE DISPLAY_MESSAGE; {Local}

      var
        i: integer;


      Begin
        with in_msg do
          begin
          case id of
            pk_misc:
              begin
              writeln('  Value is "', value, '"');
              end;
            pk_debug:
              begin
              writeln('  Debug level is "', deb_level, '" on device "',
                      deb_device, '"');
              end;
            pk_monitor:
              begin
              writeln('  Monitor level is "', mon_level, '" on device "',
                      mon_device, '"');
              end;
            pk_view:
              begin
              writeln('  View level is "', view_level, '" on device "',
                      view_device, '"');
              end;
            pk_info_short:
              begin
              writeln('  Short info msg is "', sinfo, '"');
              end;
            pk_info_long:
              begin
              write('  Long info msg is "');
              swrite(output, linfo);
              writeln('"');
              end;
            pk_check_config:
              begin
              writeln('  Config file is "', config_file, '"');
              end;
            pk_orderly_abort:
              begin
              end;
            pk_wake_up_sender:
              begin
              end;
            pk_send_as_is:
              begin
              write('  Content is "');
              swrite(output, content);
              writeln('"');
              end;
            pk_ACKed_transaction: {ack from device}
              begin
              write('  First part of transaction was "');
              swrite(output, ACK_content);
              writeln('"');
              end;
            pk_NAKed_transaction: {nak from device}
              begin
              write('  First part of transaction was "');
              swrite(output, NAK_content);
              writeln('"');
              end;
            pk_resource:
              begin
              writeln('  Resource name is "', resource_name,
                      '" and owner is "', resource_owner, '"');
              end;
            pk_identity:
              begin
              writeln('  Identity is "', ident, '"');
              end;
            pk_gate:
              begin
              writeln('  Gate name is "', gate_name, '", status word is ',
                      gate_status: - 6, ' octal,');
              writeln('  Requested gate opening is ', gate_set: 1,
                      '%, current gate opening is ', gate_current: 1, '%,');
              writeln('  Maximum gate open allowed except shakeout is ',
                      gate_max: 1, '%, shakeout opening is ', gate_shake: 1,
                      '%');
              end;
            pk_report_status:
              begin
              writeln('  Report status to device "', device_stat, '"');
              end;
            pk_synch:
              begin
              writeln('  Synchronization text is "', synch_text,
                      '" and number is ', synch_num: 1);
              end;
            pk_scale:
              begin
              writeln('  Scale order type is "', scale_order_type, '",');
              writeln('  header 1 is "', scale_header1, '",');
              writeln('  header 2 is "', scale_header2, '",');
              writeln('  product is "', scale_product, '", order size is "',
                      scale_order_size, '", draft_size is "',
                      scale_draft_size, '" and gate open is "',
                      scale_gate_open, '"');
              end;
            pk_control_symbol:
              begin
              writeln('  Symbol type is ', symbol_type: 1,
                      ', symbol name is "', symbol_name, '",');
              writeln('  symbol data base is ', symbol_DB: 1,
                      ', symbol offset is ', symbol_offset: 1);
              end;
            pk_control_alpha:
              begin
              writeln('  Symbol type is ', alpha_type: 1,
                      ', symbol data base is ', alpha_DB: 1,
                      ', symbol offset is ', alpha_offset: 1, ',');
              writeln('  alpha length is ', ord(alpha_value[0]): 1, ',');
              write('  alpha value is "');
              swrite(output, alpha_value);
              writeln('"');
              writeln;
              end;
            pk_control_numeric:
              begin
              writeln('  Symbol type is ', numeric_type: 1,
                      ', symbol data base is ', numeric_DB: 1,
                      ', symbol offset is ', numeric_offset: 1, ',');
              writeln('  numeric value byte count is ', numeric_len: 1, ',');
              writeln('  numeric value (as decimal integers) is ');
              i := 1;
              while (i <= numeric_len) do
                begin
                if (i mod 8 = 0) then
                  writeln(numeric_value[i]: 8)
                else
                  write(numeric_value[i]: 8, ',');
                i := i + 1;
                end;
              if ((i - 1) mod 8 <> 0) then
                writeln;
              writeln;
              end;
            pk_bin:
              begin
              writeln('  Bin name is "', bin_name, '", status word is ',
                      bin_status: - 6, ' octal,');
              writeln('  bin level is ', bin_level: 1,
                      'ft, out of max height of ', bin_height: 1, 'ft,');
              writeln('  bin CGRADE is "', bin_cgrade, '", GRADE is "',
                      bin_grade, '" and SUBGRADE is "', bin_sgrade, '"');
              end;
            pk_field_value:
              begin
              writeln('  Field name is "', field_name, '"');
              writeln('  field status is ', field_status: 1,
                      ' and terminator is ', field_term: 1);
              write(' field value is "');
              swrite(output, field_value);
              writeln('"');
              writeln;
              end;
            pk_record:
              begin
              writeln('  Record length (2byte words) is ', record_len: 1);
              writeln('  and record value (in decimal words) is');
              i := 1;
              while i <= record_len do
                begin
                if (i mod 8) = 0 then
                  writeln(record_value[i]: 7)
                else
                  write(record_value[i]: 7, ',');
                i := i + 1;
                end;
              if ((i - 1) mod 8 <> 0) then
                writeln;
              writeln;
              end;
            pk_reserved9:
              begin
              end;
            pk_reserved10:
              begin
              end;
            pk_reserved11:
              begin
              end;
            pk_reserved12:
              begin
              end;
            pk_reserved13:
              begin
              end;
            pk_reserved14:
              begin
              end;
            pk_reserved15:
              begin
              end;
            pk_reserved16:
              begin
              end;
            pk_reserved17:
              begin
              end;
            pk_reserved18:
              begin
              end;
            pk_reserved19:
              begin
              end;
            pk_reserved20:
              begin
              end;
            pk_reserved21:
              begin
              end;
            pk_reserved22:
              begin
              end;
            pk_reserved23:
              begin
              end;
            pk_comment:
              begin
              write('  Comment text is "');
              swrite(output, comment);
              writeln('"');
              end;
            otherwise
              begin
              { nothing else to write }
              end
            end; {case}
          end; {with}
      end; {local procedure display_message}

    {~~~~~~~~~}


    Begin { procedure get_any_messages }
      writeln;
      writeln('SENDER> Receive any outstanding messages...');
      msrcv(null_task_name, in_msg);
      stat := $dsw;
      if stat = - 8 then
        begin
        { no messages }
        writeln('  no messages outstanding');
        end
      else
        begin
        if stat < 3 then
          begin
        { Some directive error (negative), bad processing (0), or 
          incomplete task name (1) or zero length message (2).  Anything
          3 or above is normal }
          writeln('  bad receive of message, stat = ', stat: 1);
          end
        else
          begin
          { Message in - show it. }
          len := (stat * 2) - 4; { LEN is message text length in bytes }
          cpitas(in_msg.id, alpha_id);
          supper(alpha_id);
          swrite(output, alpha_id);
          writeln(' message received, with status =', stat, '.');
          Dmphdr(output, in_msg);
          cpstas(in_msg.sub, long_alpha_sub);
          write('  sub type set is [');
          swrite(output, long_alpha_sub);
          writeln('].');
          if in_msg.id in [pk_misc..pk_comment] then
            begin
            { AMI general messages, display the contents }
            display_message;
            end
          else
            begin
            { site specific message, contents without interpretation }
            writeln('  site specific message - possible contents are "',
                    in_msg.value, '"');
            end;
          writeln;
          end;
        end;
    end; { procedure get_any_messages }

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}


  PROCEDURE GET_ID_SELECTION(var bailout: Boolean);

  { Prompt the operator for a message packet id selection.  Provide
    help if requested.  Set BAILOUT boolean true if operator indicates
    a desire to leave without sending a message, otherwise set false.}

    Var
      resp: ch20;
      match_found: boolean;

      {~~~~~~~~~}


    PROCEDURE LIST_ID_NAMES; {Local}

      Var
        id: message_packet_id_type;
        short_alpha_id: ch18;
        column: integer;


      begin
        { show packet list }
        column := 1;
        for id := pk_misc to pk_unknown do
          begin
          cpitas(id, short_alpha_id);
          spad(short_alpha_id, chr(0), ' ');
          write('  (', ord(id): 2, ') ', short_alpha_id);
          if column < 3 then
            begin
            column := column + 1;
            end
          else
            begin
            writeln;
            column := 1;
            end;
          end;
        if column <> 1 then
          writeln;
      end; { procedure list_id_names }

    {~~~~~~~~~}


    PROCEDURE MATCH_IDNUM; {Local}

  { convert operator supplied number to an integer, and try to map it
    to a packet id type.  If found, set MATCH_FOUND true. }

      var
        id: message_packet_id_type;
        pos, point: integer;


      Begin
        pos := 1; { start conversion at beginning of string }
        castin(resp, point, pos);
        if (pos > 1) and (pos <= 4) then
          begin
          { one to three digits - could be 0 thru 255, okay so far }
          if (point >= 0) and (point <= ord(pk_unknown)) then
            begin
        { falls within pk_misc thru pk_unknown range, so now
          map it to an id }
            for id := pk_misc to pk_unknown do
              begin
              if point = ord(id) then
                begin
                out_msg.id := id;
                match_found := true
                end;
              end; {for}
            end;
          end;
      end; { procedure match_idnum }

    {~~~~~~~~~}


    PROCEDURE MATCH_ID; {Local}

  { Compare operator entry with possible names.  If more than one 
    match found, indicate that it is not unique, and show the choices.
    If one match found, set MATCH_FOUND true and go with it. }

      var
        compare_result: boolean;
        match_count: integer;
        id, last_match: message_packet_id_type;


      Begin
        match_count := 0;
        for id := pk_misc to pk_unknown do
          begin
          if not (match_found) then
            begin
            cpitas(id, alpha_id);
            scompare(alpha_id, resp, compare_result);
            if compare_result = true then
              begin
              supper(alpha_id);
              supper(resp);
              if sequal(alpha_id, resp) then
                match_found := true;
              match_count := match_count + 1;
              last_match := id;
              end;
            end;
          end;
        if match_count = 1 then
          begin
          { unique match }
          out_msg.id := last_match;
          match_found := true;
          end
        else
          begin
          if match_count = 0 then
            begin
            { no match found }
            writeln('    No match found, try again');
            end
          else
            begin
            { multiple matches found, list them }
            writeln('    Multiple matches found, try again.  Match list is...'
                    );
            for id := pk_misc to pk_unknown do
              begin
              cpitas(id, alpha_id);
              scompare(alpha_id, resp, compare_result);
              if compare_result = true then
                writeln('      ', alpha_id);
              end;
            end;
          end;
      end; { procedure match_id }

    {~~~~~~~~~}


    Begin {Get_id_selection}
      match_found := false;
      bailout := false;
      repeat
        write('  Enter packet type to send (? for list, blank to quit)> ');
        sread(input, resp);
        if (resp[1] = '?') then
          begin
          { help the user }
          list_id_names;
          end
        else
          begin
          { see if user wants to escape }
          if (resp[1] = ' ') or (resp[1] = chr(0)) then
            begin
            bailout := true;
            end
          else
            begin
            { see if its an ordinal number }
            if (resp[1] >= '0') and (resp[1] <= '9') then
              begin
              { it must be an ordinal value, covert to numeric and find
                it. }
              match_idnum;
              end
            else
              begin
              {must be alpha, see if we can find a match }
              match_id;
              end;
            end;
          end;
      until (match_found) or (bailout);
    end; { procedure get_id_selection }

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}


  PROCEDURE GET_SUB_SELECTION;

  { Prompt the operator for a message packet sub selection.  Provide
    help if requested. }

    Var
      resp: ch20;
      sub_done, match_found: boolean;

      {~~~~~~~~~}


    PROCEDURE LIST_SUB_NAMES; {Local}

      Var
        sub: message_packet_sub_type;
        subset: message_packet_sub_set;
        short_alpha_sub: ch18;
        column: integer;


      begin { show sub list }
        column := 1;
        for sub := ps_ack to ps_reserved11 do
          begin
          subset := [sub];
          cpstas(subset, short_alpha_sub);
          spad(short_alpha_sub, chr(0), ' ');
          write('  (', ord(sub): 2, ') ', short_alpha_sub);
          if column < 3 then
            begin
            column := column + 1;
            end
          else
            begin
            writeln;
            column := 1;
            end;
          end;
        if column <> 1 then
          writeln;
      end; { procedure list_sub_names }

    {~~~~~~~~~}


    PROCEDURE MATCH_SUBNUM; {Local}

  { convert operator supplied number to an integer, and try to map it
    to a packet sub type.  If found, set MATCH_FOUND true. }

      var
        sub: message_packet_sub_type;
        pos, point: integer;


      Begin
        pos := 1; { start conversion at beginning of string }
        castin(resp, point, pos);
        if (pos > 1) and (pos <= 4) then
          begin
          { one to three digits - could be 0 thru 255, okay so far }
          if (point >= 0) and (point <= ord(ps_reserved11)) then
            begin
        { falls within ps_ack thru ps_reserved11 range, so now
          map it to an sub }
            for sub := ps_ack to ps_reserved11 do
              begin
              if point = ord(sub) then
                begin
                out_msg.sub := out_msg.sub + [sub];
                match_found := true
                end;
              end; {for}
            end;
          end;
      end; { procedure match_subnum }

    {~~~~~~~~~}


    PROCEDURE MATCH_SUB;

  { Compare operator entry with possible names.  If more than one 
    match found, indicate that it is not unique, and show the choices.
    If one match found, set MATCH_FOUND true and go with it. }

      var
        compare_result: boolean;
        match_count: integer;
        sub, last_match: message_packet_sub_type;
        subset: message_packet_sub_set;


      Begin
        match_count := 0;
        for sub := ps_ack to ps_reserved11 do
          begin
          if not (match_found) then
            begin
            subset := [sub];
            cpstas(subset, alpha_sub);
            scompare(alpha_sub, resp, compare_result);
            if compare_result = true then
              begin
              supper(alpha_sub);
              supper(resp);
              if sequal(alpha_sub, resp) then
                match_found := true;
              match_count := match_count + 1;
              last_match := sub;
              end;
            end;
          end;
        if match_count = 1 then
          begin
          { unique match }
          out_msg.sub := out_msg.sub + [last_match];
          match_found := true;
          end
        else
          begin
          if match_count = 0 then
            begin
            { no match found }
            writeln('    No match found, try again');
            end
          else
            begin
            { multiple matches found, list them }
            writeln('    Multiple matches found, try again.  Match list is...'
                    );
            for sub := ps_ack to ps_reserved11 do
              begin
              subset := [sub];
              cpstas(subset, alpha_sub);
              scompare(alpha_sub, resp, compare_result);
              if compare_result = true then
                writeln('      ', alpha_sub);
              end;
            end;
          end;
      end; { procedure match_sub }

    {~~~~~~~~~}


    Begin {Get_sub_selection}
      sub_done := false;
      out_msg.sub := [];
      repeat
        match_found := false;
        repeat
          cpstas(out_msg.sub, med_alpha_sub);
          write('    your sub type set is [');
          swrite(output, med_alpha_sub);
          writeln(']');
          write(
               '  Enter a packet sub type to send or <CR> (type ? for list)> '
                );
          sread(input, resp);
          if slen(resp) <= 0 then
            begin
            { blank entry - no more entries }
            match_found := true;
            sub_done := true;
            end
          else
            begin
            { non blank response, entering a sub type }
            if resp[1] = '?' then
              begin
              { help the user }
              list_sub_names;
              end
            else
              begin
              { see if its an ordinal number }
              if (resp[1] >= '0') and (resp[1] <= '9') then
                begin
              { it must be an ordinal value, covert to numeric and find
                it. }
                match_subnum;
                end
              else
                begin
                { must be alpha - see if we can find a match }
                match_sub;
                end;
              end;
            end;
        until match_found;
      until sub_done;
    end; { procedure get_sub_selection }

{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}


  PROCEDURE GET_MSG_CONTENTS;

   { get any message fields needed as dictated by MSG.ID }

    var
      hold70: ch70;
      resp: char;
      i, int: integer;
      holdbuff: packed array [1..100] of char;
      Done: boolean;
      err: boolean;
      info: Ch20;

      {~~~~~~~~~}


    PROCEDURE TRANSLATE_CONTENTS_INTO_ASCII; {Local}

      var
        i: integer;
        h: integer;
        n: integer;
        pos: integer;
        asc_num: ch3;
        num: integer;


      Begin
        Sclear(info);
        err := False;
        i := 1;
        h := 1;
        n := 1;
        Done := true;
        While h <= Slen(holdbuff) do
          Begin
          If Holdbuff[h] <> '<' then
            Begin
            Info[i] := Holdbuff[h];
            h := h + 1;
            i := i + 1;
            end
          Else {holdbuff[h] = '<'}
            Begin
            Done := False;
            n := 1;
            If Holdbuff[h + 1] = '<' then
              Begin
              Info[i] := Holdbuff[h];
              h := h + 2;
              i := i + 1;
              end
            Else If holdbuff[h + 1] = '>' then
              Begin
              Info[i] := Chr(0);
              i := i + 1;
              h := h + 2;
              Done := true;
              End
            Else
              Begin
              Sclear(ASC_num);
              n := 0;
              While (n <= 3) and (holdbuff[h + n + 1] <> '>') do
                Begin
                n := n + 1;
                If holdbuff[h + n] <> '>' then
                  ASC_num[n] := Holdbuff[h + n];
                End;
              If holdbuff[h + n + 1] = '>' then
                Begin
                Pos := 1;
                Castin(Asc_num, num, pos);
                info[i] := Chr(num);
                h := h + n + 2;
                i := i + 1;
                Done := true;
                End;
              End;
            End;
          End;
        err := Not done;

      End;

    {~~~~~~~~~}

    Begin {Get_msg_contents}
      with out_msg do
        begin
        case id of
          pk_misc:
            begin
            write('  Enter value> ');
            sread(input, value);
            end;
          pk_debug:
            begin
            repeat
              write('  Enter debug level (0-9)> ');
              readln(deb_level);
            until deb_level in ['0'..'9'];
            write('  Enter debug device name> ');
            sread(input, deb_device);
            end;
          pk_monitor:
            begin
            repeat
              write('  Enter monitor level (0-9)> ');
              readln(mon_level);
            until mon_level in ['0'..'9'];
            write('  Enter monitor device name> ');
            sread(input, mon_device);
            end;
          pk_view:
            begin
            repeat
              write('  Enter view level (0-9)> ');
              readln(view_level);
            until view_level in ['0'..'9'];
            write('  Enter view device name> ');
            sread(input, view_device);
            end;
          pk_info_short:
            begin
            repeat
              begin
              writeln(
               ' You may enter a char or its decimal ordinal number in arrows'
                      );
              writeln(
               ' so "A" and <65> are equivalent. To enter "<" double it "<<".'
                      );
              writeln(' Also note that a final null <0> will be ignored. ');
              writeln(' Enter short info text (up to 20 chars):');
              writeln(' ');
              sread(input, holdbuff);
              translate_contents_into_ASCII;
              Sassign(Sinfo, Info);
              If err then
                writeln('TEXT IN INVALID FORM');
              End;
            until not err;
            end;
          pk_info_long:
            begin
            writeln('  Enter long info text (up to 199 chars)> ');
            writeln('        ',
      '         1         2         3         4         5         6         7'
                    );
            writeln('        ',
      '1234567890123456789012345678901234567890123456789012345678901234567890'
                    );
            write('   1-70>');
            sread(input, hold70);
            sassign(linfo, hold70);
            writeln('        ',
      '         8         9         0         1         2         3         4'
                    );
            writeln('        ',
      '1234567890123456789012345678901234567890123456789012345678901234567890'
                    );
            write(' 71-140>');
            sread(input, hold70);
            sconcat(linfo, hold70);
            writeln('        ',
                 '         5         6         7         8         9         '
                    );
            writeln('        ',
                 '12345678901234567890123456789012345678901234567890123456789'
                    );
            write('141-199>');
            sread(input, hold70);
            sconcat(linfo, hold70);
            end;
          pk_check_config:
            begin
            write('  Enter config file name> ');
            readln(config_file);
            end;
          pk_orderly_abort:
            begin
            { nothing else needed }
            end;
          pk_wake_up_sender:
            begin
            { nothing else needed }
            end;
          pk_send_as_is:
            begin
            write('  Enter content to be sent> ');
            sread(input, content);
            end;
          pk_ACKed_transaction:
            begin
            write('  Enter transaction that was acked> ');
            sread(input, ACK_content);
            end;
          pk_NAKed_transaction:
            begin
            write('  Enter transaction that was nakked> ');
            sread(input, NAK_content);
            end;
          pk_resource:
            begin
            write('  Enter resource name> ');
            readln(resource_name);
            write('  Enter resource owner> ');
            readln(resource_owner);
            write('  Enter resource detail> ');
            readln(resource_detail);
            end;
          pk_identity:
            begin
            write('  Enter identity string');
            readln(ident);
            end;
          pk_gate:
            begin
            write('  Enter gate name (1-6 char)> ');
            readln(gate_name);
            write('  Enter gate status (16 bit word)> ');
            readln(gate_status);
            write('  Enter gate requested set> ');
            readln(gate_set);
            write('  Enter gate current set> ');
            readln(gate_current);
            write('  Enter gate max set> ');
            readln(gate_max);
            write('  Enter gate shakeout set> ');
            readln(gate_shake);
            end;
          pk_report_status:
            begin
            write('  Enter status report device name> ');
            sread(input, Device_stat);
            end;
          pk_synch:
            begin
            write('  Enter synch text> ');
            readln(synch_text);
            write('  Enter synch number> ');
            readln(synch_num);
            end;
          pk_scale:
            begin
            write('  Enter order type (R,S)> ');
            readln(scale_order_type);
            write('  Enter header 1 text> ');
            readln(scale_header1);
            write('  Enter header 2 text> ');
            readln(scale_header2);
            write('  Enter product name> ');
            readln(scale_product);
            write('  Enter order size> ');
            readln(scale_order_size);
            write('  Enter draft size> ');
            readln(scale_draft_size);
            write('  Enter gate opening> ');
            readln(scale_gate_open);
            end;
          pk_control_symbol:
            begin
            write('  Enter symbol type (128-float,64-bit,32-num,20-str)> ');
            readln(symbol_type);
            write('  Enter symbol name> ');
            readln(symbol_name);
            write('  Enter symbol Database (DB)> ');
            readln(symbol_DB);
            write('  Enter symbol offset (decimal)> ');
            readln(symbol_offset);
            end;
          pk_control_alpha:
            begin
            write('  Enter value type (128-float,64-bit,32-num,20-str)> ');
            readln(alpha_type);
            write('  Enter value Database (DB)> ');
            readln(alpha_DB);
            write('  Enter value offset (decimal)> ');
            readln(alpha_offset);
            write('  Do ascii value entry or numeric) (A,N)> ');
            readln(resp);
            if resp in ['N', 'n'] then
              begin
              write('  Enter value byte count> ');
              readln(i);
              alpha_value[0] := chr(i);
              writeln('Enter numeric bytes (decimal), 999 to end early');
              for i := 1 to i do
                begin
                write('Byte ', i: 1, '> ');
                readln(int);
                if (int >= 0) and (int <= 255) then
                  alpha_value[i] := chr(int)
                else
                  alpha_value[i] := chr(0);
                end;
              end
            else
              begin
              write('  Enter value string> ');
              sread(input, alpha_value);
              end;
            end;
          pk_control_numeric:
            begin
            write('  Enter value type (128-float,64-bit,32-num,20-str)> ');
            readln(numeric_type);
            write('  Enter value Database (DB)> ');
            readln(numeric_DB);
            write('  Enter value offset (decimal)> ');
            readln(numeric_offset);
            write('  Enter value length(in 2byte words)> ');
            readln(numeric_len);
            for i := 1 to numeric_len do
              begin
              write('Integer ', i: 1, '> ');
              readln(numeric_value[i]);
              end;
            end;
          pk_bin:
            begin
            write('  Enter bin name> ');
            readln(bin_name);
            write('  Enter bin status word> ');
            readln(bin_status);
            write('  Enter bin level> ');
            readln(bin_level);
            write('  Enter bin height> ');
            readln(bin_height);
            write('  Enter bin certificate (official) grade> ');
            readln(bin_cgrade);
            write('  Enter bin grade name> ');
            readln(bin_grade);
            write('  Enter bin subgrade name> ');
            readln(bin_sgrade);
            write('  Enter bin priority> ');
            readln(bin_priority);
            end;
          pk_field_value:
            begin
            write('  Enter field name (1-6 chars)> ');
            readln(field_name);
            write('  Enter field status (word)> ');
            readln(field_status);
            write('  Enter field terminator> ');
            readln(field_term);
            write('  Enter field value >');
            sread(input, field_value);
            end;
          pk_record:
            begin
            write('  Enter record length (in 2byte words> ');
            readln(record_len);
            writeln('  Enter record value (integers):');
            for i := 1 to record_len do
              begin
              write('  value[', i: 1, ']> ');
              readln(record_value[i]);
              end;
            end;
          pk_comment:
            begin
            writeln('  Enter comment text (up to 199 chars)> ');
            writeln('        ',
      '         1         2         3         4         5         6         7'
                    );
            writeln('        ',
      '1234567890123456789012345678901234567890123456789012345678901234567890'
                    );
            write('   1-70>');
            sread(input, hold70);
            sassign(comment, hold70);
            writeln('        ',
      '         8         9         0         1         2         3         4'
                    );
            writeln('        ',
      '1234567890123456789012345678901234567890123456789012345678901234567890'
                    );
            write(' 71-140>');
            sread(input, hold70);
            sconcat(comment, hold70);
            writeln('        ',
                 '         5         6         7         8         9         '
                    );
            writeln('        ',
                 '12345678901234567890123456789012345678901234567890123456789'
                    );
            write('141-199>');
            sread(input, hold70);
            sconcat(comment, hold70);
            end;
          otherwise
            begin
            { all other packets need no additional text }
            end;
          end; {case}
        end; {with}
    end; {procedure get_msg_contents }

  {------------- Modify_Header ----------------------------------}


  Procedure Modify_header;

{ this procedure prompts for destination task and node, then 
      calls MSINIT with the information. }

    VAR
      stat: integer;


    BEGIN
      Writeln(' enter a space to bug out...');
      write('destination task name [');
      SWrite(output, to_task);
      write('] ');
      Readln(to_task);
      if (to_task = '      ') then
        escape := TRUE
      ELSE
        BEGIN
        write('Destination node name [');
        SWrite(output, to_node);
        Write('] ');
        Readln(to_node);
        if (to_node = '      ') then
          escape := TRUE
        ELSE
          BEGIN
          Msinit(to_node, to_task, out_msg, stat);
          writeln('msinit status is ', stat, '.');
          if (Stat < 1) THEN
            escape := true
          END
        END
    END;

{~~~~~~~~~~~~~~}
  
  Procedure Modify_Delay;
  
  { Accept integer, 0-60, which becomes delay in seconds after sending any
    message. }
  
  var 
  	pos,new_delay: Integer;
  	resp: ch10;
  	fin: boolean;
  
  BEGIN
  	fin := false;
  	while not(fin) DO
	BEGIN 
	  write('Enter delay in seconds [',delay:2,']:');
	  sread(input,resp);
	  if resp[1] = chr(0) 
	    then fin := true
	    else BEGIN
  		pos := 1;
	        castin(resp,new_delay,pos);
		if (pos > 1) AND (new_delay >= 0) AND (new_delay < 60)
		  THEN BEGIN
		    delay := new_delay;
		    fin := true
		    END
		  ELSE Writeln('Delay must be between 0 and 60...')
		end
	   end
	end; { modify_delay }
	
{~~~~~~~~~~~~~~}
	
  Procedure Do_Delay; 
  
  { 
  	Wait number of seconds specified by DELAY. This is to allow other 
  	programs to do some output to our screen without interleaving with
  	this program's next prompts. 
  }
  
BEGIN
  if delay <> 0 then Wait(f3,delay,SECONDS)
END; {do_delay }
  
  	    
{@MARK@}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}


  Begin { main program }
    exit_requested := false;
    sclear(alpha_id);
    sclear(med_alpha_sub);
    comman := 'H     '; { if operator makes no entry, default is set header }
    delay := 0; 	{ initialize to no delay after send }
    { initialize out_msg header to empty...}
    With out_msg do
      BEGIN
      router := null_task_name;
      dest_task := null_task_name;
      src_task := null_task_name;
      dest_node := '      ';
      src_node := '      ';
      msg_size := 0;
      flags := [];
      protocol := 0
      END;

    repeat
      { main process loop, repeat until exit requested }
      writeln;
{***  
  get_any_messages;
***}
      writeln('Current out-bound message header is:');
      dmpHdr(output, out_msg);
      write('Current Body is type ');
      swrite(output, alpha_id);
      write(', with sub_type ');
      swrite(output, med_alpha_sub);
      writeln(', and size =', out_msg.msg_size, '. ');
      writeln;
      write('B(ody), D(elay), H(ead), S(nd), R(cv) P(ause), X(it), [', comman: 1,']> ');
      readln(comman);
      { convert comman name to upper case if not already }
      supper(comman);
      if comman = '      ' then
        comman := old_comman;
      old_comman := comman;

  {*******
     New Control Flow:
        Commands are done in a CASE, rather than the IF-THEN-IF... which
        was getting badly out of hand. Impact minimized by doing a free
        Get_any_message after 'Send' as well as 'Receive'. The Nosend
        option has been changed to 'Receive', but both command letters are
        parsed. 
   ************ }

      Case Comman[1] of

        'B': { Modify Body }
          BEGIN
      { Clear the message contents, get the packet id to send, 
        prompt the operator for contents, and then send the packet. }
          sclear(out_msg.value);
          get_id_selection(escape);
          if not (escape) then
            begin
            get_sub_selection;
            cpitas(out_msg.id, alpha_id);
            supper(alpha_id);
            write('  Prepare to send a "');
            swrite(output, alpha_id);
            writeln('" packet');
            write('    with sub type set of [');
            cpstas(out_msg.sub, med_alpha_sub);
            swrite(output, med_alpha_sub);
            writeln(']');
            writeln;
            get_msg_contents;
            out_msg.msg_size := MsSize(out_msg);
            end;
          end;

	'D':
	  Modify_delay;

        'H':
          Modify_Header;

        'N', 'R':
          Get_any_messages;

        'S': { Send the current message }
          BEGIN
          mssend(out_msg, f0);
          stat := $dsw;
          if stat = 1 then
            writeln('  Message sent to ', to_task)
          else
            writeln(chr(7), '  Failed to send message, error status is ',
                    stat: 1);
          Do_Delay; 
          Get_any_messages;
          end;

  	'P':
	  BEGIN
	  Writeln('SENDER PAUSING... to resume, type UNS SENTxx or UNS SENDER.');
  	  Stop;
	  Writeln('SENDER Continuing...');
	  end;
        'X':
          Exit_requested := TRUE;

        Otherwise
          Writeln('Huh?');
        end; { case }
    until exit_requested;
  end.