{ PICS2E.INC - Pascal Integrated Communications System Utility Sub-system }
{ 5/25/87 vers 1.6 Copyright 1987 by Les Archambault}

overlay procedure display_users;
{ Display user file }
  const
    col_width = 19;
  var
    i, colbeg, colend, len,count: integer;
    ch, disp_case, disp_nois: char;
    t: tad_array;
    key: StrName;
    temp_user_rec: user_list;
    Tstr:strtad;
    caller:boolean;

  begin   {display users}
   SetSect(HomDrv,HomUsr);
   if (user_rec.access > 250) or (not remote_copy) then caller:=false
   else caller:=true;
    repeat
    if (not caller) then
      begin
        writeln(usr);
        st := prompt('Art der Auflistung <A><B><K><Q><G><?> ',80, 'ES?');
        if length(st)=1 then ch:=st[1]
        else ch:=' ';
        if not(ch in ['A','B','K','Q','G'])
          then Writeln(USR, '<A>lle, <B>esondere, <K>urzuebersicht, <G>ast-Benutzer, <Q>uit');
      end
    else
      If user_rec.access>=val_acc then ch:='K'
      else ch:='Q';
    if ch in ['A','K','B','G'] then
    Begin
    Writeln(USR);
    Writeln(USR, 'Die Benutzer-Liste wird alphabetisch nach Zunamen ausgegeben,');
    Writeln(USR, 'beginnend mit dem eingegebenen Zeichen oder String.');
    Writeln(USR);
    key := prompt('Start [<CR> fuer alle Namen]', len_name, 'ESU');
    if key = ' '
      then
        begin
          ClearKey(IdxF);
          NextKey(IdxF, i, key)
        end
      else
        begin
          SearchKey(IdxF, i, key);
          if not OK
            then
              begin
                ClearKey(IdxF);
                NextKey(IdxF, i, key)
              end
        end;
    GetTAD(t);
    Count:=0;
    Tstr := FormTAD(t);
    if ch = 'B' then Writeln(USR, 'Besondere (Access, Zeit, Ausnahme von Reinigung)')
       else if ch = 'G' then Write(USR, 'Nichteingetragene ');
    Writeln(USR, 'Benutzer [Stand: ', Tstr, ']');
    Writeln(USR);
    if (user_rec.lines<>99) and (not printer_copy) then count:=count+2;
    if (user_rec.access > 250) or (not remote_copy) then
      begin
        Writeln(USR, FileLen(DatF), ' Eintraege, ');
        if (user_rec.lines<>99) and (not printer_copy) then count:=succ(count);
      end;
    if ch<>'K' then Writeln(USR, UsedRecs(DatF), ' Benutzer in der Liste.');
    if (user_rec.lines<>99) and (not printer_copy) then count:=succ(count);
    colend := 999;
    while (not brk) and OK do
      with temp_user_rec do
        begin
          GetRec(DatF, i, temp_user_rec);
          if (ch = 'K') and (fn <> 'SYSOP') and (access >= val_acc)
            then
              begin
                Writeln(usr,pad(ln,succ(len_ln)),' ',pad(fn,succ(len_fn)),
                 '    ',pad(cy,succ(len_cy)));
                writeln(usr,'Computer-Typ: ',pad(comp,succ(len_comp)),
                     '  Letzter Anruf: ',laston[3],'-',laston[4],'-',laston[5]);
                writeln(usr);
                if (user_rec.lines <>99) and (not printer_copy) then
                  begin
                    count:=count+3;
                    if count>=user_rec.lines then
                      begin
                        pause; count:=0;
                      end;
                  end;
              end
          else if (ch = 'A')
               or ((ch = 'G') and  (access < val_acc))
               or ((ch = 'B') and ((access > val_acc) or (limit > val_time)
               or test_bit(flags,5)))
            then if fn<>'SYSOP' then
              begin
                Writeln(usr);
                Writeln(USR,                 {first line}
                  ln,' ',fn,'   ',cy,'   ',
                  pad(ph, succ(len_ph)),'  ',
                  pad(comp, succ(len_comp)));

                Writeln(usr,                 {second line}
                  'Adresse: ',pad(ad, succ(len_ad)),
                  '    Level:',access:4,
                  '    Zeitlimit:',limit:4);

                if shift_lock
                  then disp_case := 'U'
                  else disp_case := 'L';
                if noisy
                  then disp_nois := 'N'
                  else disp_nois := 'Q';

                Write(USR,                   {third line}
                  'Nullen:',nulls:2,
                  '   Schrift:',disp_case:2,
                  '   Bell:',disp_nois:2,
                  '   Konferenzen:');
                  if conf_flags>0 then
                    begin
                      for i:=1 to 7 do
                       if test_bit(conf_flags,i) then write(usr,' ',chr(i+48));
                      writeln(usr);
                    end
                  else writeln(usr,' Keine');

                Writeln(usr,                 {fourth line}
                  'Zeilen:',lines:3,
                  '   Zuletzt: ',laston[3],'/',laston[4],'/',laston[5],
                  '   Gelesen:',lasthi:5,
                  '   Zeit ges.: ', time_total:5);

                Writeln(usr,                   {fifth line}
                  'Uplds:',upload:3,
                  '   Downlds:',download:4,
                  '   Protokoll: ',prot,
                  '   Passwort: ',pw);

                Write(usr,'Flags gesetzt:');       {sixth line -B.B.}
                  if flags>0 then
                    begin
                      for i:=0 to 7 do
                        if test_bit(flags,i) then write(usr,' ',chr(i+48));
                      writeln(usr);
                    end
                  else writeln(usr,' Keine');

                 if (user_rec.lines<>99) and (not printer_copy) then
                   begin
                     count:=count+6;
                     if count>=user_rec.lines then
                     begin
                       pause; count:=0;
                     end;
                   end;
              end;
          NextKey(IdxF, i, key)
        end;
   end;  {valid command}
   until (ch='Q') or (not online) or caller;
  end;

overlay function chat: boolean;
{ Chat with sysop }
  var
    ch: char;
    i: integer;
    count: real;
    t: tad_array;
    Tstr: StrStd;
  begin
    OK := op_chat;
    if op_chat
      then Writeln(USR, 'Dialog-Anforderung vom Sysop...', BEL)
      else
        begin
          GetTAD(t);
          if (not chat_ok) then
            writeln(usr,'Dialog-Funktion ist momentan nicht aktiv.')
          else
          if (t[2] < ChatStart) or (t[2] > pred(ChatEnd))
            then Writeln(USR, 'Der Sysop ist erreichbar von ', ChatStart, ':00 bis ', ChatEnd, ':00 Uhr.')
            else
              begin
                Writeln(USR);
                Writeln(USR, 'Einen Moment bitte, ', user_rec.fn, ' ', user_rec.ln, '.');
                Writeln(USR, 'Der Sysop wird gerufen.  ^C bricht ab....');
                Writeln(USR);
                Write(USR, '|-------------------------------|', CR, '|');
                i := 15;
                repeat
                  Write(BEL);           { BEL is not normally sent to console }
                  Write(USR, '-+', BEL);
                  count := 1.17 * lps;       {1.17 is loop speed adjustment}
                  repeat
                    ch := GetChar;
                    count := count - 1.0
                  until (not online) or (count < 0.0) or (ch in [ETX, ESC]);
                  i := pred(i)
                until (not online) or (i <= 0) or (ch in [ETX, ESC]);
                Writeln(USR);
                if ch = ETX
                  then Writeln(USR, 'Abbruch.')
                  else if ch = ESC
                    then
                      begin
                        Writeln(USR, 'Hallo, ',user_rec.fn, '! Was gibt''s?');
                        OK := TRUE
                      end
                    else Writeln(USR, 'Der Sysop ist nicht zu erreichen.')
              end
        end;
    if OK
      then
        begin
          Writeln(USR);
          next_inpstr := '';
          repeat
            Tstr := next_inpstr;
            GetStr(Tstr, ch, len_msg, 'AEW');
            Writeln(USR)
          until (not online) or (ch = ETX);
          chat := FALSE
        end
      else chat := ask('Moechtest Du eine Nachricht zuruecklassen')
  end;

overlay procedure display_time;
{ Display current system time and date }
  var
    t: tad_array;
    Tstr: StrTAD;
    min,hr,err:integer;
    temp:real;
  begin
    GetTAD(t);
    Tstr := FormTAD(t);
    Writeln(USR, Tstr);
    if (not clock) then
      begin
       writeln(usr);
       hr:=trunc((hour_count/600.0)*(mhz/4.0));
       write(usr,'Das System denkt, es sei ',hr,':');
       min:=trunc(frac(hour_count/600)*(mhz/4.0)*60);
       if min<10 then write(usr,'0');
       writeln(usr,min, ' Uhr...');
       if (user_rec.access>=250)
         then if (ask('Zeitkorrekturfaktor aendern')) then
         begin
           writeln(usr,'Kleiner als 1.0 verlangsamt, groesser als 1.0 beschleunigt die Uhr.');
           writeln(usr,'Derzeit eingestellt ist: ',time_adjust:2:2);
           st:=prompt('Neuer Wert',4,'E');
           val(st,temp,err);
           if err=0 then time_adjust:=temp;
         end;
      end;
    if (user_rec.access > 250) or (not remote_copy)
      then if ask('Soll die Zeit neu eingestellt werden')
             then
               begin
                 Writeln(USR);              { Change login time so system doesn't hang up on us }
                 login_t[5] := strint(prompt('Jahr    ', 2, 'E'));
                 login_t[4] := strint(prompt('Monat   ', 2, 'E'));
                 login_t[3] := strint(prompt('Tag     ', 2, 'E'));
                 login_t[2] := strint(prompt('Stunde  ', 2, 'E'));
                 login_t[1] := strint(prompt('Minute  ', 2, 'E'));
                 login_t[0] := strint(prompt('Sekunde ', 2, 'E'));
                 SetTAD(login_t);
                 Tstr := FormTAD(login_t);
                 Writeln(USR, Tstr);
               end;
  end;

overlay procedure display_stats;
  var
    i, days, max: integer;
    t: tad_array;
    day_array: array[0..23] of integer;

  procedure show_graph(title: StrPr);
    var
      i, j: integer;
      factor, scale: real;
      line: StrStd;
    begin
      Writeln(USR, ' ':8, title, ' fuer die letzten ', days, ' Tage');
      Writeln(USR);
      factor := max / 15.0;
      for j := 15 downto 1 do
        begin
          line := '                                                                       ';
          scale := factor * j;
          for i := 0 to 23 do
            if day_array[i] > scale
              then
                begin
                  line[1 + 3 * i] := '*';
                  line[2 + 3 * i] := '*'
                end;
          Write(USR, scale:3:0);
          i := length(line);
          while line[i] = ' ' do
            i := pred(i);
          Writeln(USR, ' ', copy(line, 1, i))
        end;
      Writeln(USR, '    |---------------------------------------------------------------------|');
      Writeln(USR, '    24  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23')
    end;

  begin { show_stats }
    GetTAD(t);
    days := round(greg_to_jul(t[3], t[4], t[5]) - greg_to_jul(stat_rec.date[3],
      stat_rec.date[4], stat_rec.date[5]));
    if days = 0
      then days := 1;
    max := 0;
    for i := 0 to 23 do
      begin
        day_array[i] := round((100.0 * stat_rec.busy_per_hour[i]) / (60.0 * days));
        if max < day_array[i]
          then max := day_array[i]
      end;
    show_graph('Durchschnittliche Systemauslastung')
  end;

overlay procedure alter_user_params;
{ Get new user parameters }
  var
    valid, continue: boolean;
    ch: char;
    i: integer;
    temp: string[2];

  procedure protokoll_einstellen;
   var ch:char;
   begin
    repeat
     temp:=prompt('Transferprotokoll <X><K><B><?> ',1,'ES?');
     if length(temp)=1 then ch:=temp[1] else ch:='?';
     if ch in ['B','K','X'] then user_rec.prot:=ch
       else list('V');
    until (ch in ['B','K','X']) or (not online);
    write(usr,'Eingestelltes Protokoll ist ');
    if user_rec.prot='X' then writeln(usr,'Xmodem.')
     else if user_rec.prot='K' then writeln(usr,'1K-Xmodem.')
      else if user_rec.prot='B' then writeln(usr,'Batch-Ymodem.');
   end;

  begin
    repeat
      continue := false;
      st:=prompt('Parameter <B><Z><N><P><Q><S><T><?> ',80, 'ES?');
      if length(st)=1 then ch:=st[1]
      else ch:='?';
      case ch of
        'B': begin
               user_rec.noisy := not user_rec.noisy;
               if user_rec.noisy
                 then Writeln(USR, 'Prompt bell ein.')
                 else Writeln(USR, 'Prompt bell aus.')
             end;
(*
        'C': begin
               Writeln(USR, 'Gegenwaertige Einstellung Chars per Line ist ', user_rec.columns, '.');
               temp := prompt('Neue Einstellung [20-80]', 2, 'ES');
               i := strint(temp);
               if (temp=' ') or (not (i in [20..80]))
                 then Writeln(USR, 'Zeichen per Zeile unveraendert.')
                 else user_rec.columns := i
             end;
auskommentiert lt. PicsUpd.His      *)
        'Z': begin
               Writeln(USR, 'Einstellung Zeilen pro Seite ist ', user_rec.lines, '.');
               temp := prompt('Neue Einstellung [10-48 oder 99 = ohne Pausen]', 2, 'ES');
               i := strint(temp);
               if (temp = ' ') or (not (i in [10..48, 99]))
                 then Writeln(USR, 'Zeilen pro Seite unveraendert.')
                 else user_rec.lines := i
             end;
        'N': begin
               Writeln(USR, 'Gegenwaertige Einstellung: ', user_rec.nulls, ' Nullen.');
               get_nulls
             end;
        'P': begin
               get_old_password('Altes Passwort', valid);
               if valid
                 then get_new_password
                 else Writeln(USR, 'Passwort unveraendert.')
             end;
        'Q': continue:=true;
        'S': get_case;
        'T': protokoll_einstellen;
       else
             begin
               list('C');
               continue := FALSE;
             end;
      end;
    until (continue) or (not online);
    if online then putrec(datf,user_loc,user_rec);
  end;

{end of PICS2E.inc }