{$A+,B+,D-,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit cuser;

interface

uses
  crt, dos,

  {rcg11172000 no overlay under Linux.}
  {overlay,}

  common;

procedure cstuff(which,how:byte; var user:userrec);

implementation

(******************************************************************************
 procedure: cstuff(which,how:byte; var user:userrec);
---
 purpose:   Inputs user information.
---
 variables passed:

    which- 1:Address        6:Occupation  11:Screen size
           2:Age            7:User name   12:Sex
           3:ANSI status    8:Phone #     13:BBS reference
           4:City & State   9:Password    14:Zip code
           5:Computer type 10:Real name

      how- 1:New user logon in process
           2:Menu edit command
           3:Called by the user-list editor

     user- User information to modify
******************************************************************************)

var callfromarea:integer;

procedure cstuff(which,how:byte; var user:userrec);
var done,done1:boolean;
    try:integer;
    fi:text;
    s:astr;
    i:integer;

  procedure findarea;
  var c:char;
  begin
    print('Are you calling from:');
    print('  1. United States');
    print('  2. Canada');
    print('  3. Other country');
    nl;
    prt('Select (1-3) : '); onek(c,'123');
    if (hangup) then exit;
    callfromarea:=ord(c)-48;
    done1:=TRUE;
  end;
  
  procedure doaddress;
  begin
    if (how=3) then print('Enter new mailing address.')
      else print('Enter your mailing address: <House number> <Street> [APT#]');
    prt(':');
    if (how=3) then inputl(s,30) else inputcaps(s,30);
    if (s<>'') then begin
      user.street:=s;
      done1:=TRUE;
    end;
  end;

  procedure doage;
  var b:byte;
      s:astr;

    function numsok(s:astr):boolean;
    var i:integer;
    begin
      numsok:=FALSE;
      for i:=1 to 8 do
        if not ((s[i] in ['0'..'9']) or (i=3) or (i=6)) then exit;
      numsok:=TRUE;
    end;

  begin
    if (how=3) then prompt('Enter date of birth (mm/dd/yy) : ')
    else begin
      sprint('^301^5=January   ^304^5=April  ^307^5=July       ^310^5=October');
      sprint('^302^5=February  ^305^5=May    ^308^5=August     ^311^5=November');
      sprint('^303^5=March     ^306^5=June   ^309^5=September  ^312^5=December');
      nl;
      prt('Enter your date of birth (mm/dd/yy) : ');
    end;
    cl(3); input(s,8);
    if ((length(s)=8) and (s[3]='/') and (s[6]='/')) then
      if (numsok(s)) then
        if (ageuser(s)<3) then
          sprint(#3#7+'Isn''t '+cstr(ageuser(s))+' years old a little YOUNG???')
        else begin
          user.bday:=s;
          done1:=TRUE;
        end;
    if ((not done1) and (how=1)) then sprint(#3#7+'Sorry, try again!');
  end;

  procedure doansi;
  begin
    pr(#27+'[0;1;5;33;40mANSI test'); tc(14+128); writeln('ANSI test');
    nl;
    if pynq('Do you have ANSI (are the above words blinking)? ') then begin
      user.ac:=user.ac+[ansi];
      if pynq('Do you have a color monitor? ') then user.ac:=user.ac+[color];
    end;
    done1:=TRUE;
  end;

  procedure docitystate;
  var s,s1,s2:astr;
  begin
    case how of
      2:findarea;
      3:callfromarea:=1;
    end;
    if (callfromarea<>3) then begin
      if (how=3) then begin
        print('Enter new city & state: ');
        prt(':'); inputl(s,30);
        if (s<>'') then user.citystate:=s;
        done1:=TRUE;
        exit;
      end;
      case callfromarea of
        1:print('City & State entry.');
        2:print('City & Province entry.');
      end;
      nl;
      if (callfromarea=1) then s1:='state' else s1:='province';
      print('First enter your city name (do not include '+s1+'):');
      prt(':'); inputcaps(s1,26);
      while (copy(s1,1,1)=' ') do s1:=copy(s1,2,length(s1)-1);
      while (copy(s1,length(s1),1)=' ') do s1:=copy(s1,1,length(s1)-1);
      nl;
      if (length(s1)<2) then begin
        sprint(#3#7+'Why do I find it hard to believe');
        sprint(#3#7+'that that is '+#3#5+'not'+#3#7+' a real city?');
        nl;
        if (callfromarea=1) then s2:='Detroit' else s2:='Toronto';
        sprint(#3#7+'Example: "'+s2+'" is a real city.');
        exit;
      end;
      if (pos(',',s1)<>0) then begin
        if (callfromarea=1) then s2:='state' else s2:='province';
        sprint(#3#7+'NO COMMAS!  Don''t enter your '+s2+' YET,');
        sprint(#3#7+'just enter your CITY!!!  I''ll ask for your');
        sprint(#3#7+allcaps(s2)+' as soon as I know your CITY!!!');
        nl;
        if (callfromarea=1) then s2:='Detroit' else s2:='Toronto';
        sprint(#3#7+'Example: "'+s2+'" is a city!');
        exit;
      end;
      if (callfromarea=1) then s2:='state' else s2:='province';
      prompt('Now enter your 2-letter '+s2+' abbreviation: ');
      cl(3); input(s2,2);
      nl;
      if (length(s2)<2) then begin
        sprint(#3#0+'TWO '+#3#7+'characters.  '+#3#0+'TWO '+#3#7+'characters.  Can''t you count?');
        sprint(#3#7+'(Hint: notice the word "'+#3#0+'TWO'+#3#7+'")');
        exit;
      end;
      user.citystate:=s1+', '+s2;
      done1:=TRUE;
    end else begin
      print('First enter your city name, and nothing else:');
      prt(':'); inputcaps(s1,26);
      if (length(s1)<2) then exit;
      nl;
      print('Now enter your country name:');
      prt(':'); inputcaps(s2,26);
      if (length(s2)<2) then exit;
      nl;
      s:=s1+', '+s2;
      print('Final result: "'+s+'"');
      if (length(s)>30) then begin
        print('Too long!  Max total length is 30 characters.');
        print('Find some way to abbreviate.');
        exit;
      end;
      user.citystate:=s;
      done1:=TRUE;
    end;
  end;

  procedure docomputer;
  var fp:text;
      ctyp:array[1..31] of string[30];
      i,n:integer;
      s,s1:astr;
      c:char;
      abort,next,other,cexist:boolean;
  begin
    other:=TRUE; cexist:=FALSE;
    assign(fp,systat.afilepath+'computer.txt');
    {$I-} reset(fp); {$I+}
    if (ioresult=0) then begin
      cexist:=TRUE;
      other:=FALSE; i:=0;
      repeat
        inc(i);
        readln(fp,ctyp[i]);
      until eof(fp) or (i=30);
      close(fp);
      n:=i+1; ctyp[n]:='Other'; abort:=FALSE;
      for i:=1 to n do begin
        s:=#3#1+mln(cstr(i)+'.',3)+ctyp[i];
        if (odd(i)) then s1:=s else printacr(mln(s1,33)+s,abort,next);
      end;
      if (odd(n)) then printacr(s1,abort,next);
      nl;
      if (how=3) then prt('Enter new computer type: ')
        else prt('Enter your computer type: ');
      input(s,2); i:=value(s);
      if (i>=1) and (i<n) then begin
        user.computer:=ctyp[i];
        done1:=TRUE;
      end else
        if i=n then other:=TRUE;
    end;
    if (other) then begin
      if cexist then prt('Other computer type: ')
        else prt('Enter your computer type: ');
      if (how=3) then inputl(s,30) else inputcaps(s,30);
      if (s<>'') then begin
        user.computer:=s;
        done1:=TRUE;
      end;
    end;
    s:=''; i:=1;
    while (i<=length(user.computer)) do begin
      if (user.computer[i]<>#3) then s:=s+user.computer[i] else inc(i);
      inc(i);
    end;
  end;

  procedure dojob;
  begin
    if (how=3) then print('Enter new occupation.')
      else print('Enter your occupation:');
    prt(':');
    if (how=3) then inputl(s,40) else inputcaps(s,40);
    if (s<>'') then begin
      user.occupation:=s;
      done1:=TRUE;
    end;
  end;

  procedure doname;
  var i:integer;
      s1,s2:astr;
      sfo:boolean;
      sr:smalrec;
  begin
    if (systat.allowalias) then begin
      print('Enter your handle, or your first & last');
      print('name if you don''t want to use one.')
    end else
      print('Enter your first & last name.  Handles are NOT ALLOWED!');
    prt(':'); input(s,36);
    done1:=TRUE;
    nl;
    if ((not (s[1] in ['A'..'Z','?'])) or (s='')) then done1:=FALSE;
    sfo:=(filerec(sf).mode<>fmclosed);
    if (not sfo) then reset(sf);
    for i:=1 to filesize(sf)-1 do begin
      seek(sf,i); read(sf,sr);
      if (sr.name=s) then begin
        done1:=FALSE;
        sprint(#3#7+'That name is already being used.');
      end;
    end;
    if (not sfo) then close(sf);
    assign(fi,systat.afilepath+'trashcan.txt');
    {$I-} reset(fi); {$I+}
    if (ioresult=0) then begin
      s2:=' '+s+' ';
      while not eof(fi) do begin
        readln(fi,s1);
        if s1[length(s1)]=#1 then s1[length(s1)]:=' ' else s1:=s1+' ';
        s1:=' '+s1;
        for i:=1 to length(s1) do s1[i]:=upcase(s1[i]);
        if pos(s1,s2)<>0 then begin
          sprint(#3#7+'"'+copy(s1,pos(s1,s2),length(s1))+'" may not be used!');
          done1:=FALSE;
        end;
      end;
      close(fi);
    end;
    if (not done1) and (not hangup) then begin
      sprint(#3#7+^G'Sorry, can''t use that name.');
      inc(try);
      sl1('Unacceptable name : '+s);
    end;
    if (try>=3) then hangup:=TRUE;
    if (done1) then user.name:=s;
    if ((done) and (how=1) and (not systat.allowalias)) then
      user.realname:=caps(s);
  end;

  procedure dophone;
  begin
    case how of
      2:findarea;
      3:callfromarea:=1;
    end;
    if (how=3) then print('Enter new VOICE phone number:')
      else print('Enter your VOICE phone number:');
    if (((how=1) and (callfromarea=3)) or (how=3)) then begin
      prt(':'); input(s,12);
      if (length(s)>5) then begin user.ph:=s; done1:=TRUE; end;
    end else begin
      print(' ###-###-####.');
      prt(':'); input(s,12);
      if (length(s)=12) and (s[4]='-') and (s[8]='-') then begin
        user.ph:=s;
        done1:=TRUE;
      end else
        if (how=1) then sprint(#3#7+'Please enter it correctly!');
    end;
  end;

  procedure dopw;
  var s:astr;
  begin
    case how of
      1:begin
          print('Enter a password that you will use to log on again.');
          print('It must be between 4 and 20 characters in length.');
          prt(':'); input(s,20);
          if (length(s)<4) then
            sprint(#3#7+'Must be at least 4 characters long.')
          else
          if (length(s)>20) then
            sprint(#3#7+'Must be less than 20 characters long.')
          else begin
            nl;
            sprint(#3#3+'Your password: '+#3#5+s);
            done1:=pynq('Is this correct? ');
            if (done1) then user.pw:=s;
          end;
        end;
      2:begin
          sprint(#3#5+'For security reasons, when changing passwords');
          sprint(#3#5+'you must first enter your old password.');
          nl;
          sprompt(#3#0+'User password   : '+#3#5); input(s,20);
          if (s<>user.pw) then sprint(^G+#3#7+'>> INCORRECT PASSWORD <<')
          else begin
            nl;
            print('Your new password must be 4-20 chrs in length.');
            nl;
            repeat
              prt('New password: '); mpl(20); input(s,20);
              nl;
            until (((length(s)>=4) and (length(s)<=20)) or (s='') or (hangup));
            if (s<>'') then begin
              nl; nl;
              sprint(#3#3+'New Password: "'+#3#5+s+#3#3+'"');
              if pynq('Are you SURE this is what you want? ') then begin
                if (not hangup) then user.pw:=s;
                sysoplog('Changed password.');
                done1:=TRUE;
              end else
                print('Aborted.');
            end else
              print('Aborted.');
          end;
          nl;
        end;
      3:begin
          print('Enter new password.'); prt(':'); input(s,20);
          if (s<>'') then begin
            done1:=TRUE;
            user.pw:=s;
          end;
        end;
    end;
  end;

  procedure dorealname;
  var i:integer;
  begin
    if ((how=1) and (not systat.allowalias)) then begin
      user.realname:=caps(user.name);
      done1:=TRUE;
      exit;
    end;
    if (how=3) then print('Enter new REAL first & last name, or')
      else print('Enter your REAL first & last name, or');
    print('enter "=" if same as your user name.');
    prt(':');
    if (how=3) then inputl(s,36) else inputcaps(s,36);
    if (s='=') then s:=caps(user.name);
    while copy(s,1,1)=' ' do s:=copy(s,2,length(s)-1);
    while copy(s,length(s),1)=' ' do s:=copy(s,1,length(s)-1);
    if (pos(' ',s)=0) and (how<>3) then begin
      print('Enter it correctly!  First AND last name please!');
      s:='';
    end;
    if (s<>'') then begin
      user.realname:=s;
      done1:=TRUE;
    end;
  end;

  procedure doscreen;
  var v:string;
      bb:byte;
  begin
    if (how=1) then begin
      user.linelen:=systat.linelen;
      user.pagelen:=systat.pagelen;
    end;
    prt('How many columns wide is your screen (32-132) ['+
      cstr(thisuser.linelen)+'] : ');
    ini(bb); if (not badini) then user.linelen:=bb;
    prt('Number of lines per page (4-50) ['+cstr(thisuser.pagelen)+'] : ');
    ini(bb); if (not badini) then user.pagelen:=bb;
    if (user.pagelen>50) then user.pagelen:=50;
    if (user.pagelen<4) then user.pagelen:=4;
    if (user.linelen>132) then user.linelen:=132;
    done1:=TRUE;
  end;

  procedure dosex;
  var c:char;
  begin
    if (how=3) then begin
      prt('New sex (M,F) : ');
      onek(c,'MF '^M);
      if (c in ['M','F']) then user.sex:=c;
    end else begin
      user.sex:=#0;
      repeat
        prt('Your sex (M,F) ? ');
        onek(user.sex,'MF'^M);
        if (user.sex=^M) then begin
          nl;
          sprint(#3#7+'Don''t know your own sex, eh?  Better see a doctor!');
          nl;
        end;
      until ((user.sex in ['M','F']) or (hangup));
    end;
    done1:=TRUE;
  end;

  procedure dowherebbs;
  begin
    if (how=3) then print('Enter new BBS reference.')
    else begin
      print('Where did you hear about this BBS from? (be specific;');
      print('do not say, for example, "some guy on another board")');
    end;
    prt(':');
    if (how=3) then inputl(s,40) else inputcaps(s,40);
    if (s<>'') then begin user.wherebbs:=s; done1:=TRUE; end;
  end;

  procedure dozipcode;
  begin
    case how of
      2:findarea;
      3:callfromarea:=1;
    end;
    case callfromarea of
      1:begin
          if (how=3) then
            print('Enter new postal code (##### or #####-####)')
          else begin
            print('Enter your zipcode (9 digit if available)');
            print(' ##### or #####-####');
          end;
          prt(':'); input(s,10);
          if (length(s) in [5,10]) then begin user.zipcode:=s; done1:=TRUE; end;
        end;
      2:begin
          print('Enter your zipcode (@#@#@# format -- "@"=letter "#"=number)');
          prt(':'); input(s,6);
          if ((length(s)=6) and
            (s[1] in ['A'..'Z']) and (s[2] in ['0'..'9']) and
            (s[3] in ['A'..'Z']) and (s[4] in ['0'..'9']) and
            (s[5] in ['A'..'Z']) and (s[6] in ['0'..'9'])) then
            done1:=TRUE
          else
            print('Illegal format!');
        end;
      3:begin
          print('Enter your postal code:');
          prt(':'); input(s,10);
          if (length(s)>2) then begin user.zipcode:=s; done1:=TRUE; end;
        end;
    end;
  end;

  procedure forwardmail;
  var u:userrec;
      s:astr;
      i:integer;
      b,ufo:boolean;
  begin
    nl;
    print('If you forward your mail, all mail');
    print('addressed to you will go to that person');
    print('Now enter the user''s number, or just');
    print('hit <CR> to deactivate mail forwarding.');
    prt(':'); input(s,4);
    i:=value(s);
    nl;
    if (i=0) then begin
      user.forusr:=0;
      print('Forwarding deactivated.');
    end else begin
      ufo:=(filerec(uf).mode<>fmclosed);
      if (not ufo) then reset(uf);
      b:=TRUE;
      if (i>=filesize(uf)) then b:=FALSE
      else begin
        seek(uf,i); read(uf,u);
        if (u.deleted) or (nomail in u.ac) then b:=FALSE;
      end;
      if (i=usernum) then b:=FALSE;
      if (b) then begin
        user.forusr:=i;
        print('Forwarding set to: '+caps(u.name)+' #'+cstr(i));
        sysoplog('Started forwarding mail to '+caps(u.name)+' #'+cstr(i));
      end else
        print('Sorry, can''t forward to that user.');
      if (not ufo) then close(uf);
    end;
  end;

  procedure mailbox;
  begin
    if (nomail in user.ac) then begin
      user.ac:=user.ac-[nomail];
      sprint(#3#5+'Mailbox now open.');
      sysoplog('Opened mailbox.');
    end else
      if (user.forusr<>0) then begin
        user.forusr:=0;
        print('Mail no longer forwarded.');
        sysoplog('Stopped forwarding mail.');
      end else begin
        if pynq('Do you want to close your mailbox? ') then begin
          user.ac:=user.ac+[nomail];
          sprint(#3#5+'Mailbox now closed.');
          sprint(#3#5+'You >CAN NOT< recieve mail now.');
          sysoplog('Closed mailbox.');
        end else
          if pynq('Do you want your mail forwarded? ') then forwardmail;
      end;
    done1:=TRUE;
  end;

  procedure tog_ansi;
  var c:char;
  begin
    prompt('Which emulation? (1) TTY (none), (2) ANSI, (3) AVATAR : ');
    cl(3); onek(c,'123');
    user.ac:=user.ac-[ansi];
    user.ac:=user.ac-[avatar];
    case c of
      '2':user.ac:=user.ac+[ansi];
      '3':user.ac:=user.ac+[avatar];
    end;
(*
    if (ansi in user.ac) then begin
      user.ac:=user.ac-[ansi];
      print('ANSI disabled.');
    end else begin
      user.ac:=user.ac+[ansi];
      print('ANSI activated.');
    end;
*)
    done1:=TRUE;
  end;

  procedure tog_color;
  begin
    if (color in user.ac) then begin
      user.ac:=user.ac-[color];
      print('ANSI color disabled.');
    end else begin
      user.ac:=user.ac+[color];
      print('ANSI color activated.');
    end;
    done1:=TRUE;
  end;

  procedure tog_pause;
  begin
    if (pause in user.ac) then begin
      user.ac:=user.ac-[pause];
      print('No pause on screen.');
    end else begin
      user.ac:=user.ac+[pause];
      print('Pause on screen active.');
    end;
    done1:=TRUE;
  end;

  procedure tog_input;
  begin
    if (onekey in user.ac) then begin
      user.ac:=user.ac-[onekey];
      print('Full line input.');
    end else begin
      user.ac:=user.ac+[onekey];
      print('One key input.');
    end;
    done1:=TRUE;
  end;

  procedure tog_clsmsg;
  begin
    if (user.clsmsg=1) then begin
      user.clsmsg:=2;
      print('Clear screen for messages OFF.');
    end else begin
      user.clsmsg:=1;
      print('Clear screen for messages ON.');
    end;
    done1:=TRUE;
  end;

  procedure tog_avadj;
  begin
    if (user.avadjust=2) then begin
      user.avadjust:=1;
      print('AVATAR color adjustment disabled.');
    end else begin
      user.avadjust:=2;
      print('AVATAR color adjustment enabled.');
    end;
    done1:=TRUE;
  end;

  procedure tog_expert;
  begin
    if (novice in user.ac) then begin
      user.ac:=user.ac-[novice];
      chelplevel:=1;
      print('Expert mode ON.');
    end else begin
      user.ac:=user.ac+[novice];
      chelplevel:=2;
      print('Expert mode OFF.');
    end;
    done1:=TRUE;
  end;

  procedure chcolors;
  var s:astr;
      c,c1,c2:integer;
      ch:char;
      mcol,ocol:byte;
      ctyp,done:boolean;

    function colo(n:integer):astr;
    begin
      case n of
        0:colo:='Black';
        1:colo:='Blue';
        2:colo:='Green';
        3:colo:='Cyan';
        4:colo:='Red';
        5:colo:='Magenta';
        6:colo:='Yellow';
        7:colo:='White';
      end;
    end;

    function dt(n:integer):astr;
    var s:astr;
    begin
      s:=colo(n and 7)+' on '+colo((n shr 4) and 7);
      if (n and 8)<>0 then s:=s+', High Intensity';
      if (n and 128)<>0 then s:=s+', Blinking';
      dt:=s;
    end;

    function stf(n:integer):astr;
    var s:astr;
    begin
      case n of
        0:s:='Other';
        1:s:='Default';
        2:s:='Unused';
        3:s:='Yes/No';
        4:s:='Prompts';
        5:s:='Note';
        6:s:='Input line';
        7:s:='Y/N question';
        8:s:='Blinking';
        9:s:='Other';
      end;
      stf:=cstr(n)+'. '+mln(s,20);
    end;

    procedure liststf;
    var c:integer;
    begin
      nl;
      for c:=0 to 9 do begin
        setc(7); prompt(stf(c));
        setc(user.cols[ctyp][c]); print(dt(user.cols[ctyp][c]));
      end;
    end;

  begin
    ctyp:=color in user.ac;
    setc(7);
    if (ctyp) then print('Set multiple colors.') else print('Set B&W colors.');
    ch:='?'; done:=FALSE;
    repeat
      case ch of
        'Q':done:=TRUE;
        'L':liststf;
        '0'..'9':begin
              nl; setc(7); print('Current:'); nl;
              c1:=value(ch);
              setc(7); prompt(stf(c1));
              setc(user.cols[ctyp][c1]); print(dt(user.cols[ctyp,c1]));
              nl; setc(7); print('Colors:'); nl;
              for c:=0 to 7 do begin
                setc(7); prompt(cstr(c)+'. '); setc(c); prompt(mln(colo(c),12));
                setc(7); prompt(mrn(cstr(c+8),2)+'. '); setc(c+8); print(mln(colo(c)+'!',9));
              end;
              ocol:=user.cols[ctyp][c1]; nl;
              prt('Foreground: '); input(s,2);
              if (s='') then mcol:=ocol and 7 else mcol:=value(s);
              prt('Background: '); input(s,2);
              if (s='') then
                mcol:=mcol or (ocol and 112)
              else
                mcol:=mcol or (value(s) shl 4);
              if pynq('Blinking? ') then mcol:=mcol or 128;
              nl; setc(7); prompt(stf(c1)); setc(mcol); print(dt(mcol)); nl;
              if pynq('Is this correct? ') then user.cols[ctyp][c1]:=mcol;
            end;
      end;
      if (not done) then begin
        nl; prt('Colors: (0-9) (L)ist (Q)uit :'); onek(ch,'QL0123456789');
      end;
    until done or hangup;
    done1:=TRUE;
  end;

  procedure checkwantpause;
  begin
    if pynq('Should screen pausing be active? ') then
      user.ac:=user.ac+[pause]
    else
      user.ac:=user.ac-[pause];
    done1:=TRUE;
  end;

  procedure ww(www:integer);
  begin
    nl;
    case www of
      1:doaddress;   2:doage;       3:doansi;
      4:docitystate; 5:docomputer;  6:dojob;
      7:doname;      8:dophone;     9:dopw;
     10:dorealname; 11:doscreen;   12:dosex;
     13:dowherebbs; 14:dozipcode;  15:mailbox;
     16:tog_ansi;   17:tog_color;  18:tog_pause;
     19:tog_input;  20:tog_clsmsg; 21:chcolors;
     22:tog_expert; 23:findarea;   24:checkwantpause;
     25:tog_avadj;
    end;
  end;
  
begin
  try:=0; done1:=FALSE;
  case how of
    1:repeat ww(which) until (done1) or (hangup);
    2,3:begin
        ww(which);
        if not done1 then print('Function aborted!');
      end;
  end;
end;

end.