807 lines
22 KiB
ObjectPascal
807 lines
22 KiB
ObjectPascal
{$A+,B+,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
|
|
{rcg11272000 y2k stuff.}
|
|
{if (how=3) then prompt('Enter date of birth (mm/dd/yy) : ')}
|
|
|
|
if (how=3) then prompt('Enter date of birth (mm/dd/yyyy) : ')
|
|
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;
|
|
{rcg11272000 y2k stuff.}
|
|
{prt('Enter your date of birth (mm/dd/yy) : ');}
|
|
prt('Enter your date of birth (mm/dd/yyyy) : ');
|
|
end;
|
|
|
|
{rcg11272000 y2k stuff.}
|
|
{
|
|
cl(3); input(s,8);
|
|
if ((length(s)=8) and (s[3]='/') and (s[6]='/')) then
|
|
}
|
|
|
|
cl(3); input(s,10);
|
|
if ((length(s)=10) 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.
|