kermit.columbia.edu/kermit.columbia.edu.tar/kermit.columbia.edu/archives/ucsdpecan.tar.gz/ucsdpecan.tar/setshow.text

Text File | 1990-08-05 | 6KB | 187 lines

{ Change log:
30 Apr 89, V1.1: moved into kermutil   RTC
30 Apr 89, V1.1: Added SET INTERFACE command    RTC
16 Apr 89, V1.1: Added Client Unit to SHOW VER command      RTC
14 Apr 89, V1.1: Added SHOW VERSION command   RTC
14 Aug 88: Added SYSTEM-ID and modified DEBUG      RTC
31 Jul 88: Modified to permit REMUNIT to accept/reject baud rate    RTC

}

procedure fill_parity_array;

(* parity value table for even parity...not(entry) = odd parity *)

const min = 0;
      max = 255;

var i, shifter, counter: integer;
    ch: char;

begin
   for ch := chr(min) to chr(max) do
     case parity of
        evenpar: begin
                    shifter := aand(ord(ch),255); (* mask off parity bit *)
                    counter := 0;
                    for i := 1 to 7 do begin       (* count the 1's *)
                       if odd(shifter) then
                          counter := counter + 1;
                       shifter := shifter div 2
                    end; (* for i *)
                    if odd(counter) then       (* stick a 1 on if necessary *)
                       parity_array[ch] := chr(aor(ord(ch),128))
                    else
                       parity_array[ch] := chr(aand(ord(ch),127))
                 end; (* for ch *) (* case even *)
        oddpar:  begin
                    shifter := aand(ord(ch),255);  (* mask off parity bit *)
                    counter := 0;
                    for i := 1 to 7 do begin        (* count the 1's *)
                       if odd(shifter) then
                           counter := counter + 1;
                       shifter := shifter div 2
                    end; (* for i *)
                    if odd(counter) then        (* stick a 1 on if necessary *)
                       parity_array[ch] := chr(aand(ord(ch),127))
                    else
                       parity_array[ch] := chr(aor(ord(ch),128))
                 end; (* for ch *) (* case odd *)
        markpar: parity_array[ch] := chr(aor(ord(ch),128));
        spacepar:parity_array[ch] := chr(aand(ord(ch),127));
        nopar:   parity_array[ch] := ch;
      end; (* case *)
  end; (* fill_parity_array *)

procedure write_bool{s: string255; b: boolean};

(* writes message & 'on' if b, 'off' if not b *)
  begin
    write(s);
    case b of
        true: writeln('on');
        false: writeln('off');
      end; (* case *)
  end; (* write_bool *)

procedure show_parms;

(* shows the various settable parameters *)
var
  i,first,last : vocab;

begin
   if noun = allsym then
     begin
       first := baudsym; last := systemsym
     end
   else
     begin
       first := noun; last := noun
     end;
   for i := first to last do
     case i of
       debugsym:    write_bool('Debugging is ',debug);

       escsym:      writeln('Escape character is ^',ctl(esc_char));

       filenamsym:  begin
                      write('File names are ');
                      if lit_names
                        then write('Literal')
                        else write('Converted');
                      writeln
                    end;

       filetypesym: begin
                      write('File type is ');
                      if f_is_binary
                        then write('Binary')
                        else write('Text');
                      writeln
                    end;

       filewarnsym: write_bool('File warning is ',fwarn);

       ibmsym:      write_bool('IBM is ',ibm);

       localsym:    write_bool('Local echo is ',halfduplex);

       emulatesym:  write_bool('Emulate DataMedia is ', emulating );

       baudsym:     writeln( 'Baud rate is ', baud:5 );

       paritysym:   begin
                       case parity of
                          evenpar: write('Even');
                          markpar: write('Mark');
                          nopar: write('No');
                          oddpar: write('Odd');
                          spacepar: write('Space');
                       end; (* case *)
                       writeln(' parity');
                    end; (* paritysym *)

       systemsym:   writeln('System ID is ',system_id);

     end; (* case *)
   if noun = versionsym then
     begin
       writeln(ker_version);
       rec_version; sen_version; cli_version;
       hlp_version; pak_version; utl_version; gbl_version;
       mnu_version; par_version;
     end
end; (* show_sym *)


procedure set_parms;

(* sets the parameters *)

  var
    oldbaud : integer;

  begin
    case noun of
        debugsym: debug := adj = onsym;
        escsym: escchar := newescchar;
        filenamsym : lit_names := adj = litsym;
        filetypesym : f_is_binary := adj = binsym;
        filewarnsym: fwarn := (adj = onsym);
        ibmsym: case adj of
                    onsym: begin
                        ibm := true;
                        parity := markpar;
                        half_duplex := true;
                        fillparityarray
                      end; (* onsym *)
                    offsym: begin
                        ibm := false;
                        parity := nopar;
                        half_duplex := false;
                        fillparityarray
                      end; (* onsym *)
                  end; (* case adj *)
        intsym: if adj = ucsdsym then menu_interface;
        localsym: halfduplex := (adj = onsym);
        emulatesym: emulating := (adj = onsym);
        paritysym: begin
              case adj of
                  evensym: parity := evenpar;
                  marksym: parity := markpar;
                  nonesym: parity := nopar;
                  oddsym: parity := oddpar;
                  spacesym: parity := spacepar;
                end; (* case *)
              fill_parity_array;
             end; (* paritysym *)
        baudsym: begin
            oldbaud := baud; baud := newbaud;
            if not setup_comm then baud := oldbaud
         end { baudsym };
        systemsym: system_id := line;
      end; (* case *)
  end; (* set_parms *)