{ ROSKIO.INC - Remote Operating System Kernel - I/O routines }

function online: boolean;
{ Determine whether system is still online - local or remote }
  begin
    if remote_online
      then if ch_carck
             then online := TRUE
             else
               begin
                 mdhangup;
                 putstat('Carrier lost');
                 remote_online := FALSE;
                 online := FALSE
               end
      else online := local_online
  end;

procedure PutByte(b: byte);
  begin
    if ch_carck
      then ch_out(b)
  end;

procedure PutChar(ch: char);
{ User written I/O driver to output character }
  var
    i: integer;
  begin
    if not user_rec.case_sw
      then ch := UpCase(ch);
    if printer_copy
      then BDOS(5, ord(ch));
    if local_online
      then BDOS(6, ord(ch))
    else if online
      then
        begin
          if ch <> BEL
            then BDOS(6, ord(ch));
          if remote_copy
            then
              begin
                ch_out($7F and ord(ch));
                if ch = CR
                  then for i := 1 to user_rec.nulls do
                    ch_out(ord(NUL))
              end
        end
  end;

function GetByte(sec: integer; var timeout: boolean): byte;
{ Get byte from modem with 'sec' seconds timeout }
  var
    count: real;
  begin
    count := sec * lps;
    while (not ch_inprdy) and (ch_carck) and (count > 0.0) do
      count := count - 1.0;
    timeout := (not ch_carck) or (count <= 0.0);
    if timeout
      then GetByte := ord(NUL)
      else GetByte := ch_inp
  end;

function GetChar: char;
{ Get character, no echo }
  var
    ch: char;
  begin
    if keypressed
      then
        begin
          read(KBD, ch);
          if (not online) and (not (ch in [^C, LF, CR]))
            then ch := NUL;
          case ch of
            ^W: begin
                  op_chat := TRUE;
                  writeln(USR, BEL, BEL, 'Please standby...');
                  ch := ' '
                end;
            ^E: begin
                  remote_copy := not remote_copy;
                  if remote_copy
                    then putstat('Remote copy on')
                    else putstat('Remote copy off');
                  ch := NUL
                end;
            ^R: begin
                  delay_down := TRUE;
                  putstat('Remote offline - delayed');
                  ch := NUL
                end;
            ^T: begin
                  remote_online := FALSE;
                  putstat('Remote offline - immediate');
                  ch := NUL
                end;
            LF: begin
                  if online
                    then putstat('^W: CHAT, ^E: Remote copy on/off, ^R: Remote offline - delayed, ^T: Twit')
                    else putstat('^C: Shutdown ROS, <RETURN>: Local use');
                  ch := NUL
                end
          end
        end
    else if remote_online and remote_copy and ch_carck and ch_inprdy
           then ch := chr($7F and ch_inp)
    else ch := NUL;
    GetChar := ch
  end;

procedure GetStr(var inpstr: StrStd; var ch: char; maxlen: integer; mode: Str10);
{ Get a valid input string from the user }
  type
    charset = set of char;
  const
    editset: charset = [BS, RUB, CAN, TAB];
    termset: charset = [LF, CR, ETX];
    dispset: charset = [NUL, ' '..'~'];
  var
    auto, echo, shiftlock, wrap, question: boolean;
    i, len, cursor: integer;
    count: real;
  begin
    auto      := (pos('A', mode) > 0);      { Line complete when full }
    echo      := (pos('E', mode) > 0);      { Display characters on entry }
    shiftlock := (pos('S', mode) > 0);      { Make all characters upper case }
    wrap      := (pos('W', mode) > 0);      { Word wrap }
    question  := (pos('?', mode) > 0);      { Force inpstr := '?' when encountered }
    auto := auto or wrap;                   { Wrap forces auto on }
    cursor := succ(length(inpstr));
    if echo and (cursor > 0)
      then write(USR, inpstr);
    repeat
      count := timeout * lps * 0.574;       { This loop is slower than GetByte }
      repeat
        if (0 < macro_ptr) and (macro_ptr <= length(macro))
          then
            begin
              ch := macro[macro_ptr];
              if ch = '/'
                then ch := CR;
              macro_ptr := succ(macro_ptr)
            end
          else ch := GetChar;
        if remote_online
          then count := count - 1.0
      until (not online) or (ch <> NUL) or (count < 0.0);
      if count < 0.0
        then
          begin
            writeln(USR, BEL, BEL, '++ Input timed out ++');
            remote_online := FALSE
          end;
      if shiftlock
        then ch := UpCase(ch);
      case ch of
        TAB:
          repeat
            if echo
              then write(USR, ' ');
            cursor := succ(cursor);
            insert(' ', inpstr, cursor)
          until (0 = cursor mod 5) or (cursor >= maxlen);
        RUB, BS:
          if cursor > 1
            then
              begin
                if echo
                  then write(USR, BS, ' ', BS);
                cursor := pred(cursor);
                delete(inpstr, cursor, 1)
              end;
        CAN:
          while cursor > 1 do
            begin
              if echo
                then write(USR, BS, ' ', BS);
              cursor := pred(cursor);
              delete(inpstr, cursor, 1)
            end;
        ^A:
          while cursor > 1 do
            begin
              if echo
                then write(USR, BS);
              cursor := pred(cursor)
            end;
        ^S:
          if cursor > 1
            then
              begin
                if echo
                  then write(USR, BS);
                cursor := pred(cursor)
              end;
        ^D:
          if cursor <= length(inpstr)
            then
              begin
                if echo
                  then write(USR, inpstr[cursor]);
                cursor := succ(cursor)
              end;
        ^F:
          while cursor <= length(inpstr) do
            begin
              if echo
                then write(USR, inpstr[cursor]);
              cursor := succ(cursor)
            end;
        else
          if (ch in dispset) and ((len < maxlen) or auto)
            then
              begin
                if echo
                  then write(USR, ch);
                if (ch = '?') and question
                  then
                    begin
                      inpstr := ch;
                      ch := CR
                    end
                  else
                    begin
                      insert(ch, inpstr, cursor);
                      cursor := succ(cursor)
                    end
              end
      end;
      len := length(inpstr)
    until (not online) or (ch in termset) or ((len >= maxlen) and auto);
    next_inpstr := '';
    if wrap and (len >= maxlen)
      then
        begin
          while (inpstr[len] <> ' ') and (len > 1) do
            len := pred(len);
          if len > 1
            then
              begin
                if echo
                  then
                    begin
                      for i := succ(len) to length(inpstr) do
                        write(USR, BS);
                      for i := succ(len) to length(inpstr) do
                        write(USR, ' ')
                    end;
                next_inpstr := copy(inpstr, succ(len), length(inpstr));
                inpstr := copy(inpstr, 1, pred(len))
              end
        end
  end;

function brk: boolean;
{ Check for break or pause }
  var
    ch: char;
  begin
    ch := GetChar;
    while ch = DC3 do                       { ^S }
      repeat
        ch := GetChar
      until (not online) or (ch <> NUL);
    brk := (not online) or (ch = ETX)       { ^C }
  end;

function prompt(st: StrPr; len: integer; mode: Str10): StrStd;
{ Prompt user and get response }
  var
    ch: char;
    reply: StrStd;
  begin
    write(USR, st);
    if noisy
      then write(USR, BEL);
    reply := '';
    GetStr(reply, ch, len, mode);
    prompt := reply
  end;

function select(pr: StrPr; st: StrStd): char;
{ Prompt user and get single character response }
  var
    i, j: integer;
    ch: char;
  begin
    if user_rec.help_level > 0
      then pr := pr + ' [press "?" for menu]';
    pr := prompt(pr + '> ', 1, 'AS') + ' ';
    ch := pr[1];
    i := pos(ch, st);
    if i > 0
      then
        begin
          j := i;
          repeat
            j := succ(j)
          until (j > length(st)) or (st[j] in ['A'..'Z']);
          writeln(USR, copy(st, i, j - i))
        end
      else writeln(USR, ch);
    select := ch
  end;

function ask(pr: StrPr): boolean;
{ Ask yes-or-no question and return TRUE for 'Y', FALSE otherwise }
  var
    yes: boolean;
  begin
    yes := ('Y' = prompt(pr + ' <y/n>? ', 1, 'AS'));
    if yes
      then writeln(USR, 'Yes')
      else writeln(USR, 'No');
    ask := yes
  end;

procedure pause;
{ Pause for user response before continuing }
  var
    st: string[1];
  begin
    st := prompt('Press <RETURN> to continue...', 1, '');
    write(USR, CR, ' ':29, CR)
  end;

function getc(var inp_file: untype_file; var BufferPtr, remaining: integer): integer;
  { Get an 8 bit value from the input buffer - read block if necessary }
    var
      NoOfRecs: integer;
    begin
      if BufferPtr > BufSize
        then
          begin
            if BufBlocks < remaining
              then NoOfRecs := BufBlocks
              else NoOfRecs := remaining;
            if NoOfRecs > 0
              then BlockRead(inp_file, Buffer, NoOfRecs);
            remaining := remaining - NoOfRecs;
            BufferPtr := 1
          end;
      getc := Buffer[BufferPtr];
      BufferPtr := succ(BufferPtr)
    end;