program kermit;

(* $R-*) (* turn range checking off *)
(* $L+*)

USES {$u kermglob.code} kermglob,
     {$U kermutil.code} kermutil,
     (* {$U kermpack.code} kermpack, *)
     {$U parser.code}   parser,
     {$U helper.code}   helper,
     {$U sender.code}   sender,
     {$U receiver.code} receiver;

{
  Modifications by SP, 25 Oct 1983: adapt to IBM Version IV.1
  Delete keyboard and serial buffering: provided by system already.

  Additional mods by SP, 18 Mar 1984: make all strings 255 chars long

  13 May 84: Incorporate screen control through syscom record entries
             for portability
}


procedure showparms;
forward;


procedure connect;

(* connect to remote host and transceive *)

var ch: char;
    close: boolean;

  procedure read_esc;

  (* read character after esc char and interpret it *)

    begin
      repeat
      until read_ch(keyport,ch);       (* wait until they've typed something in *)
      if (ch in ['a'..'z']) then  (* uppercase it *)
          ch := chr(ord(ch) - ord('a') + ord('A'));
      if ch in ['B','C','S','?'] then
          case ch of
              'B': sendbrk;       (* B: send a break to the IBM *)
              'C': close := true; (* C: end connection *)
              'S': begin          (* S: show status *)
                      noun := allsym;
                      showparms
                   end; (* S *)
              '?': begin          (* ?: show options *)
                  writeln('B    Send a BREAK signal.');
                  writeln('C    Close Connection, return to KERMIT-UCSD command level.');
                  writeln('Q    Query Status of connection');
                  writeln('F    Send Control-F character to remote host.' );
                  writeln('S    Send Control-S character to remote host.' );
                  writeln('?    Print this list');
                  writeln('^',esc_char,'   send the escape character itself to the');
                  writeln('     remote host.')
                end; (* ? *)
            end (* case *)
      else if ch = esc_char then  (* ESC-char: send it out *)
        begin
          if half_duplex then
            begin
              write(ch); { changed from echo() by SP }
              write_ch(oport,ch)
            end (* if *)
        end (* else if *)
      else                        (* anything else: ignore *)
          write(chr(bell))
    end; (* read_esc *)

  begin (* connect *)
    clear_buf(keyport);                    (* empty keyboard buffer *)
    clear_buf(inport);                    (* empty remote input buffer *)
    writeln('Connecting to host...type CTRL-',ctl(esc_char),' C to exit');
    close := false;
    repeat
        if read_ch(inport,ch) then        (* if char from host then *)
            echo(ch);                   (* echo it *)

        if read_ch(keyport,ch) then        (* if char from keyboard then *)
            if ch <> esc_char then      (* if not ESC-char then *)
              begin
                if half_duplex then       (* echo it if half-duplex *)
                    write(ch); { changed from echo() by sp }
                write_ch(oport,ch)     (* send it out the port *)
              end (* if *)
            else (* ch = esc_char *)    (* else is ESC-char so *)
              read_esc;                   (* interpret next char *)
    until close;                      (* if still connected, get more *)
    writeln('Disconnected')
  end; (* connect *)


procedure fill_parity_array;

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

const min = 0;
      max = 126;

var i, shifter, counter: integer;
    minch, maxch, ch: char;
    r: char_int_rec;

begin
   minch := chr(min);
   maxch := chr(max);
   case parity of
      evenpar: for ch := minch to maxch do begin
                  r.ch := ch;               (* put char into variant record *)
                  shifter := aand(r.i,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:  for ch := minch to maxch do begin
                  r.ch := ch;                (* put char into variant record *)
                  shifter := aand(r.i,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:
          for ch := minch to maxch do     (* stick a 1 on all chars *)
              parity_array[ch] := chr(aor(ord(ch),128));
      spacepar:
          for ch := minch to maxch do     (* mask off parity on all chars *)
              parity_array[ch] := chr(aand(ord(ch),127));
      nopar:
          for ch := minch to maxch do     (* don't mess with parity bit at all *)
              parity_array[ch] := ch;
    end; (* case *)
  end; (* fill_parity_array *)


$I setshow.text


procedure initialize;

var ch: char;

  begin
    pad := mypad;
    padchar := chr(mypchar);
    xeol := chr(my_eol);
    esc_char := chr(my_esc);
    quote := my_quote;
    ctlset := [chr(1)..chr(31),chr(del),quote];
    half_duplex := false;
    debug := false;
    emulating := false;
    fwarn := false;
    spsiz := max_pack;
    rpsiz := max_pack;
    n := 0;
    parity := nopar;
    initvocab;
    fill_parity_array;
    ibm := false;
    xon := chr(17);
    bufpos := 1;
    bufend := 0;

    baud := defaultbaud;
    setup_comm
  end; (* initialize *)


procedure closeup;

  begin
    page( output )
  end; (* closeup *)


  begin (* main kermit program *)
    initialize;
    repeat
        write('Kermit-UCSD> ');
        readstr(keyport,line);
        case parse of
            unconfirmed: writeln('Unconfirmed');
            parm_expected: writeln('Parameter expected');
            ambiguous: writeln('Ambiguous');
            unrec: writeln('Unrecognized command');
            fn_expected: writeln('File name expected');
            ch_expected: writeln('Single character expected');
            null: case verb of
                      consym: connect;
                      helpsym: help;
                      recsym: begin
                          recsw(rec_ok);
                          gotoxy(0,debugline);
                          write(chr(bell));
                          if rec_ok then
                              writeln('successful receive')
                          else
                              writeln('unsuccessful receive');
                          (*$I-*) (* set i/o checking off *)
                          close(oldf);        { why??? }
                          if not rec_ok then
                             close(f);  { added by SP }
                          (*$I+*) (* set i/o checking back on *)
                          gotoxy(0,promptline);
                        end; (* recsym *)
                      sendsym: begin
                          uppercase(xfilename);
                          sendsw(send_ok);
                          gotoxy(0,debugline);
                          write(chr(bell));
                          if send_ok then
                              writeln('successful send')
                          else
                              writeln('unsuccessful send');
                          (*$I-*) (* set i/o checking off *)
                          close(oldf);
                          (*$I+*) (* set i/o checking back on *)
                          gotoxy(0,promptline);
                        end; (* sendsym *)
                      setsym: set_parms;
                      show_sym: show_parms;
                  end; (* case verb *)
        end; (* case parse *)
     until (verb = exitsym) or (verb = quitsym);
     closeup
   end. (* kermit *)