{ File: Lb:[22,311]SENDER.PAS       Last Edit: 18-SEP-1989 11:17:44 
}

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:

    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:msgpacket.typ;
%include pas$ext:castin.ext;
%include pas$ext:cpitas.ext;
%include pas$ext:cpstas.ext;
%include pas$ext:rcvmsg.ext;
%include pas$ext:sndmsg.ext;

Var

  alpha_id: ch20;
  alpha_sub: ch20;
  escape:boolean;
  exit_requested: boolean;
  long_alpha_sub: ch80;
  med_alpha_sub: ch50;
  msg: message_packet_type;  
  stat: integer;
  task_name, old_task_name: 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 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;
sclear(recv_task_name);  { receive from anyone }
rcvmsg(recv_task_name,msg,stat);
{ Note that STAT is directive status after the VRCD variable receive data
  exec call.  That means that STAT is the overall length of the data 
  received in words.  This length INCLUDES the 2 word rad50 task name.
  Thus a successful receive STAT must be greater than or equal to 2
  ( the sending task name in rad50).  And unless the message sent had
  a zero length (no message text), STAT must be 3 or greater.  Remember,
  since data packets are sent in WORDs only, a message text of 1 byte
  is sent and received as a word, with a random byte added to bring
  the message text to a word boundry.}
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(msg.id,alpha_id);
        supper(alpha_id);
        swrite(output,alpha_id);
        writeln(' message received from "',recv_task_name,'"',
           ' full msg length = ',len:1,', and');
        cpstas(msg.sub,long_alpha_sub);
        write('  sub type set is [');
        swrite(output,long_alpha_sub);
        writeln('].');
        if 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 "',
               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
            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 }
    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
            msg.sub:= 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 }
    msg.sub:= 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;
msg.sub:= [];
repeat
match_found:= false;
repeat
  cpstas(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 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 }

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

Begin    { main program }
exit_requested:= false;
old_task_name:= 'X     ';   { if operator makes not entry, default is exit }
repeat
  { main process loop, repeat until exit requested }
  writeln;
  writeln('Receive any outstanding messages...');
  get_any_messages;
  writeln;
  write('Enter task name for send, X to exit, N for no send (',
    task_name,')> ');
  readln(task_name);
  { convert task name to upper case if not already }
  supper(task_name);
  if task_name = 'X     ' then exit_requested:= true;
  if task_name = '      ' then task_name:= old_task_name;
  old_task_name:= task_name;
  if (not(exit_requested)) and (task_name<>'N     ')
    then begin
      { Clear the message contents, get the packet id to send, 
        prompt the operator for contents, and then send the packet. }
      sclear(msg.value);
      get_id_selection(escape);
      if not(escape)
        then begin
          get_sub_selection;
          cpitas(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(msg.sub,med_alpha_sub);
          swrite(output,med_alpha_sub);
          writeln(']');
          writeln;
          get_msg_contents;
          {now send the message}
          sndmsg(task_name,msg,stat);
          if stat=1
            then writeln('  Message sent to ',task_name)
            else writeln(chr(7),
                   '  Failed to send message, error status is ',stat:1);
          end;
      end;
  until exit_requested;
end.