home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
f
/
faq-s.zip
/
CONFIGUR.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-04
|
27KB
|
849 lines
{$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
{$M 65500,0,0 }
unit configur;
interface
uses dos,crt,configrt,gentypes,userret,gensubs,subs1,subs2,flags,overlay,modem;
procedure configure;
procedure configurefilelisting;
implementation
procedure getfilething (c:filelisttype);
var n:integer;
name,onstr,offstr:lstr;
begin
if c in urec.filelister then
urec.filelister:=urec.filelister-[c] else urec.filelister:=urec.filelister+[c];
end;
procedure configurefilelisting;
var q:char; totalfile:integer;
begin
totalfile:=75;
if ffname in urec.filelister then totalfile:=totalfile-9;
if ffext in urec.filelister then totalfile:=totalfile-4;
if ffsize in urec.filelister then totalfile:=totalfile-10;
if ffpoints in urec.filelister then totalfile:=totalfile-5;
if ffuploader in urec.filelister then totalfile:=totalfile-13;
if ffuploaded in urec.filelister then totalfile:=totalfile-9;
if ffdown in urec.filelister then totalfile:=totalfile-4;
if fffulnam in urec.filelister then totalfile:=totalfile-28;
if ffofwhat in urec.filelister then totalfile:=totalfile-6;
repeat
clearscr;
write (^R'Space: 9 ['^S'1'^R'] Filename : '^S);
if ffname in urec.filelister then writeln ('ON ') else writeln ('OFF');
write (^R'Space: 4 ['^S'2'^R'] Filename Extension : '^S);
if ffext in urec.filelister then writeln ('ON ') else writeln ('OFF');
write (^R'Space: 10 ['^S'3'^R'] File Size : '^S);
if ffsize in urec.filelister then writeln ('ON ') else writeln ('OFF');
write (^R'Space: 5 ['^S'4'^R'] File Cost : '^S);
if ffpoints in urec.filelister then writeln ('ON ') else writeln ('OFF');
write (^R'Space: 13 ['^S'5'^R'] Uploader : '^S);
if ffuploader in urec.filelister then writeln ('ON ') else writeln ('OFF');
write (^R'Space: 9 ['^S'6'^R'] Date Uploaded : '^S);
if ffuploaded in urec.filelister then writeln ('ON ') else writeln ('OFF');
write (^R'Space: 4 ['^S'7'^R'] D/L Popularity : '^S);
if ffdown in urec.filelister then writeln ('ON ') else writeln ('OFF');
write (^R'Space: 28 ['^S'8'^R'] Program Description: '^S);
if fffulnam in urec.filelister then writeln ('ON ') else writeln ('OFF');
write (^R'Space: 6 ['^S'9'^R'] Disk x of y : '^S);
if ffofwhat in urec.filelister then writeln ('ON ') else writeln ('OFF');
write (^R'Free Space: ');
writeln (^S+strr(totalfile));
buflen:=1;
write (^M^P'File Listing Configuration: ');
q:=waitforupchar;
case q of
'1':begin
getfilething (ffname);
if ffname in urec.filelister then totalfile:=totalfile-9 else totalfile:=totalfile+9;
if (ffname in urec.filelister) and (totalfile<0) then begin
sound (20);
delay (50);
nosound;
urec.filelister:=urec.filelister-[ffname];
totalfile:=totalfile+9;
end; end;
'2':begin
getfilething (ffext);
if ffext in urec.filelister then totalfile:=totalfile-4 else totalfile:=totalfile+4;
if (ffext in urec.filelister) and (totalfile<0) then begin
sound (20);
delay (50);
nosound;
urec.filelister:=urec.filelister-[ffext];
totalfile:=totalfile+4;
end; end;
'3':begin
getfilething (ffsize);
if ffsize in urec.filelister then totalfile:=totalfile-10 else totalfile:=totalfile+10;
if (ffsize in urec.filelister) and (totalfile<0) then begin
sound (20);
delay (50);
nosound;
urec.filelister:=urec.filelister-[ffsize];
totalfile:=totalfile+10;
end; end;
'4':begin
getfilething (ffpoints);
if ffpoints in urec.filelister then totalfile:=totalfile-5 else totalfile:=totalfile+5;
if (ffpoints in urec.filelister) and (totalfile<0) then begin
sound (20);
delay (50);
nosound;
urec.filelister:=urec.filelister-[ffpoints];
totalfile:=totalfile+5;
end; end;
'5':begin
getfilething (ffuploader);
if ffuploader in urec.filelister then totalfile:=totalfile-13 else totalfile:=totalfile+13;
if (ffuploader in urec.filelister) and (totalfile<0) then begin
sound (20);
delay (50);
nosound;
urec.filelister:=urec.filelister-[ffuploader];
totalfile:=totalfile+13;
end; end;
'6':begin
getfilething (ffuploaded);
if ffuploaded in urec.filelister then totalfile:=totalfile-9 else totalfile:=totalfile+9;
if (ffuploaded in urec.filelister) and (totalfile<0) then begin
sound (20);
delay (50);
nosound;
urec.filelister:=urec.filelister-[ffuploaded];
totalfile:=totalfile+9;
end; end;
'7':begin
getfilething (ffdown);
if ffdown in urec.filelister then totalfile:=totalfile-4 else totalfile:=totalfile+4;
if (ffdown in urec.filelister) and (totalfile<0) then begin
sound (20);
delay (50);
nosound;
urec.filelister:=urec.filelister-[ffdown];
totalfile:=totalfile+4;
end; end;
'8':begin
getfilething (fffulnam);
if fffulnam in urec.filelister then totalfile:=totalfile-28 else totalfile:=totalfile+28;
if (fffulnam in urec.filelister) and (totalfile<0) then begin
sound (20);
delay (50);
nosound;
urec.filelister:=urec.filelister-[fffulnam];
totalfile:=totalfile+28;
end; end;
'9':begin
getfilething (ffofwhat);
if ffofwhat in urec.filelister then totalfile:=totalfile-6 else totalfile:=totalfile+6;
if (ffofwhat in urec.filelister) and (totalfile<0) then begin
sound (20);
delay (50);
nosound;
urec.filelister:=urec.filelister-[ffofwhat];
totalfile:=totalfile+6;
end; end;
end;
until (q='Q') or hungupon;
writeurec;
end;
procedure configure;
var totalfile:integer;
const colorstr:array [0..7] of string[7]=
('Black','Blue','Green','Cyan','Red','Magenta','Yellow','White');
procedure options (c:configtype; var prompt,onstr,offstr:lstr);
procedure ret (x1,x2,x3:lstr);
begin
prompt:=x1;
onstr:=x2;
offstr:=x3
end;
begin
case c of
linefeeds:ret('Require Line Feeds','Yes','No');
eightycols:ret('Screen Width','80 columns','40 columns');
postprompts:ret('Post prompts during Newscan','Yes','No');
moreprompts:ret('Pause every screen','Yes','No');
asciigraphics:ret('Use IBM graphics characters','Yes','No');
showtime:ret('Display time left at prompts','Yes','No');
lowercase:ret('Upper/lower case','Upper or lower case','Upper case only');
fseditor:ret('Use ANSI Full-Screen Editor','Yes','No')
end
end;
function getattrib (fg,bk:integer; hi,bl:boolean):integer;
begin
getattrib:=fg+(byte(hi) shl 3)+(bk shl 4)+(byte(bl) shl 7)
end;
procedure getcolorvar (attr:byte; var fg,bk:integer; var hi,bl:boolean);
begin
fg:=attr and 7;
hi:=(attr and 8)=8;
bk:=(attr shr 4) and 7;
bl:=(attr and 128)=128
end;
procedure getthing (c:configtype);
var n:integer;
name,onstr,offstr:lstr;
begin
{options (c,name,onstr,offstr);
writehdr (name);
write ('Current setting: '^S);}
if c in urec.config then
urec.config:=urec.config-[c] else urec.config:=urec.config+[c];
{ writeln (^B^M^M'Would you like:');
writeln (' [1]: ',onstr);
writeln (' [2]: ',offstr);
writestr (^M'Selection:');
n:=valu(input);
if (n>0) and (n<3) then begin
if n=2
then urec.config:=urec.config-[c]
else urec.config:=urec.config+[c];
writeurec
end}
end;
procedure writecolorstr (a:byte);
var fg,bk:integer;
hi,bl:boolean;
begin
getcolorvar (a,fg,bk,hi,bl);
ansicolor (a);
if bl then write ('Blinking ');
if hi then write ('Highlighted ');
write (colorstr[fg]);
if bk>0 then write (' on ',colorstr[bk])
end;
function colorval (str:mstr):integer;
var cnt:integer;
begin
colorval:=-1;
if match(str,'None') then begin
colorval:=0;
exit
end;
for cnt:=0 to 7 do
if match(str,colorstr[cnt]) then begin
colorval:=cnt;
exit
end
end;
procedure badcolor;
var cnt:integer;
begin
writeln ('Invalid color! Valid colors are:');
write ('Black, ');
for cnt:=1 to 7 do begin
ansicolor (cnt);
write (colorstr[cnt]);
if (cnt=7)
then writeln ('.')
else if (cnt<>7) and (cnt<>6) then write (', ');
if cnt=6
then write (', and ');
end;
writestr ('')
end;
procedure getcolor (prompt:mstr; var a:byte);
procedure getacolor (var q:integer; prompt:mstr);
var n:integer;
begin
repeat
writestr ('Enter new '+prompt+' Color:');
if hungupon or (length(input)=0) then exit;
n:=colorval(input);
if n=-1
then badcolor
else q:=n
until n<>-1
end;
var fg,bk:integer;
hi,bl:boolean;
begin
if not (ansigraphics in urec.config) then begin
writestr ('You must have ANSI emulation to see color.');
exit
end;
getcolorvar (a,fg,bk,hi,bl);
write ('Current ',prompt,' Color: ');
writecolorstr (a);
writestr (^M^M);
getacolor (fg,'Foreground');
getacolor (bk,'Background');
writestr ('Highlight the Characters? [y/n]: *');
hi:=yes;
writestr ('Should the Characters Blink? [y/n]: *');
bl:=yes;
a:=getattrib (fg,bk,hi,bl)
end;
procedure emulation;
begin
clearscr;
tab ('Emulation:',75);
writeln(^M);
writeln ('[1] ANSI Color/VT100 [Strongly Recommended]');
writeln ('[2] VT52 Emulation [Recommended]');
writeln ('[3] No Emulation [Strongly Discouraged]');
writestr (^M'[Emulation]: *');
if length(input)=0 then exit;
urec.config:=urec.config-[ansigraphics,vt52];
case valu(input) of
1:urec.config:=urec.config+[ansigraphics];
2:urec.config:=urec.config+[vt52]
end
end;
procedure getdisplaylen;
var v:integer;
begin
movexy(1,16);
writeln ('Current display length is: '^S,urec.displaylen);
movexy (1,17);
writestr ('Enter new display length [21-43]:');
if length(input)=0 then exit;
v:=valu(input);
if (v<21) or (v>43)
then writeln ('Invalid!')
else urec.displaylen:=v
end;
procedure configurenewscan;
var bd:boardrec;
bn:integer;
cnt:integer;
ac:accesstype;
begin
cnt:=conn;
clearscr;
repeat
writestr (^R'Which Conference? [1,2,3,4,5]-[With Access]: *');
conn:=valu(input);
until (conn=0) or
(conn=1) and (length(confm[1])>0) and (urec.defcon[1]) or
(conn=2) and (length(confm[2])>0) and (urec.defcon[2]) or
(conn=3) and (length(confm[3])>0) and (urec.defcon[3]) or
(conn=4) and (length(confm[4])>0) and (urec.defcon[4]) or
(conn=5) and (length(confm[5])>0) and (urec.defcon[5]);
opentempbdfile;
seek (bdfile,0);
for bn:=0 to filesize(bdfile)-1 do begin
read (bdfile,bd);
ac:=getuseraccflag(urec,bn);
if (ac=letin) or ((ulvl>=bd.level) and (ac=bylevel)) then begin
writestr ('Newscan '^R'['^S+bd.boardname+^R'] <now '+
yesno(not (bn in urec.newscanconfig))+'>:');
if length(input)<>0 then
if yes
then urec.newscanconfig:=urec.newscanconfig-[bn]
else urec.newscanconfig:=urec.newscanconfig+[bn]
end
end;
closetempbdfile;
conn:=cnt;
end;
procedure showit (s,v:lstr);
begin
if break then exit;
write (s);
writeln (^S,v)
end;
procedure showthing (c:configtype);
var n:integer;
name,onstr,offstr:lstr;
begin
if c in urec.config then
write (^S'Yes ') else write(^S'No ');
{ if break then exit;
options (c,name,onstr,offstr);
tab (name+':',30);
write (^S);
if c in urec.config
then write (^S,onstr)
else write (^S,offstr);
writeln
}end;
procedure showemulation;
var q:lstr;
begin
{ if ansigraphics in urec.config
then q:='ANSI'
else if vt52 in urec.config
then q:='VT52'
else q:='None';}
if ansigraphics in urec.config then
write (^S+'ANSI') else
if vt52 in urec.config then write(^S+'VT52') else write(^S+'None');
{ showit ('Terminal type',q)
}end;
procedure showdisplaylen;
begin
ansicolor (urec.statcolor);
write (strr(urec.displaylen));
{showit ('Display length',strr(urec.displaylen))
}end;
procedure showcolor (prompt:mstr; attr:byte);
begin
if break then exit;
tab (^R+prompt+' color:',31);
writecolorstr (attr);
ansicolor (urec.regularcolor);
writeln
end;
procedure colorconfig;
var mogigi:anystr;
begin
repeat
clearscr;
write (^P'['^S'1'^P'] '); showcolor ('Prompt',urec.promptcolor);
write (^P'['^S'2'^P'] '); showcolor ('Input',urec.inputcolor);
write (^P'['^S'3'^P'] '); showcolor ('Regular',urec.regularcolor);
write (^P'['^S'4'^P'] '); showcolor ('Statistic',urec.statcolor);
write (^P'['^S'5'^P'] '); showcolor ('Border',urec.bordercolor);
write (^P'['^S'6'^P'] '); showcolor ('Border Status',urec.bstatuscolor);
writestr (^M^P'['^R'Color Config Menu'^P']:');
if length(input)=0 then begin
writeln;
exit
end;
mogigi:=input[1];
if mogigi='1' then begin
writeln;
getcolor ('Prompt',urec.promptcolor);
end;
if mogigi='2' then begin
writeln;
getcolor ('Input',urec.inputcolor);
end;
if mogigi='3' then begin
writeln;
getcolor ('Regular',urec.regularcolor);
end;
if mogigi='4' then begin
writeln;
getcolor ('Status',urec.statcolor);
end;
if mogigi='5' then begin
writeln;
getcolor ('Border',urec.bordercolor);
end;
if mogigi='6' then begin
writeln;
getcolor ('Border Status',urec.bstatuscolor);
end;
until (upstring(mogigi)='Q') or (length(mogigi)=0);
end;
procedure showmacros;
begin
writeln;
writeln (^R'Message Macro #1 currently shows:'^S);
writeln (urec.macro1);
writeln;
writeln (^R'Message Macro #2 currently shows:'^S);
writeln (urec.macro2);
writeln;
writeln (^R'Message Macro #3 currently shows:'^S);
writeln (urec.macro3);
writeln;
writeln (^R);
end;
procedure newusernote;
begin
movexy(1,16); writeln(^R'Your User Note currently reads: "'^S+urec.note+^R'"');
movexy (1,17);
writestr(^M'Enter your new User Note:');
if length(input)<>0 then urec.note:=input;
writeln;
end;
{procedure yourstatus2;
begin
if linefeeds in urec.config then printxy(22,2,^S'Yes ') else printxy(22,2,^S'No ');
if eightycols in urec.config then printxy(22,3,^S'Yes ') else printxy(22,3,^S'No ');
if ansigraphics in urec.config then
printxy (64,3,^S'ANSI') else
if vt52 in urec.config then printxy(64,3,^S'VT52') else printxy(64,3,^S'None');
if postprompts in urec.config then printxy(22,4,^S'Yes ') else printxy(22,4,^S'No ');
if fseditor in urec.config then printxy(64,4,^S'Yes ') else
printxy(64,4,^S'No ');
if moreprompts in urec.config then printxy(22,5,^S'Yes ') else
printxy(22,5,^S'No ');
printxy(64,5,^S+strr(urec.displaylen));
if asciigraphics in urec.config then printxy(22,6,^S'Yes ') else
printxy(22,6,^S'No ');
printxy(64,6,^S+urec.defproto);
if showtime in urec.config then printxy(22,7,^S'Yes ') else
printxy(22,7,^S'No ');
if urec.menutype=0 then
printxy(64,7,^S'No ') else if urec.menutype=1 then printxy(64,7,^S'Yes ');
if lowercase in urec.config then printxy(22,8,^S'Yes ') else
printxy(22,8,^S'No ');
printxy (18,13,^S+urec.note);
movexy (1,16);
writeln;
end;}
procedure yourstatus;
begin
clearscr;
if asciigraphics in urec.config then begin
write (^P' ┌─┤ '^R'User Configuration '^P'├────────────┐ ┌───────────────────────────────────┐');
write (^P' │['^S'L'^P'] '^R'Linefeeds '^P': ');
if linefeeds in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write(^P'│ │['^S'Y'^P'] '^R'Personal Info'^P' '^P'│');
write (^P' │['^S'W'^P'] '^R'80 Columns '^P': ');
if eightycols in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write (^P'│ │['^S'E'^P'] '^R'Emulation '^P': ');
if ansigraphics in urec.config then tab (^S'ANSI',17) else
if vt52 in urec.config then tab (^S'VT52',17) else tab (^S'None',17);
write(^P'│');
write (^P' │['^S'O'^P'] '^R'Post Prompts '^P': ');
if postprompts in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write (^P'│ │['^S'S'^P'] '^R'Screen Editor'^P': ');
if fseditor in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write(^P'│');
write (^P' │['^S'C'^P'] '^R'Pause Screen '^P': ');
if moreprompts in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write (^P'│ │['^S'D'^P'] '^R'Screen Length'^P': ');
tab (^S+strr(urec.displaylen),17);
write(^P'│');
write (^P' │['^S'G'^P'] '^R'IBM Graphics '^P': ');
if asciigraphics in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write (^P'│ │['^S'+'^P'] '^R'Default Prot '^P': ');
if length(urec.defproto)>0 then tab (^S+urec.defproto,17) else
write (^S' ');
ansicolor (urec.statcolor);
write(^P'│');
write (^P' │['^S'T'^P'] '^R'Time at Menu '^P': ');
if showtime in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write (^P'│ │['^S'M'^P'] '^R'One Key Input'^P': ');
if urec.menutype=1 then tab (^S'Yes',17) else
if urec.menutype=0 then tab (^S'No',17);
write(^P'│');
write (^P' │['^S'U'^P'] '^R'Lower Case '^P': ');
if lowercase in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write(^P'│ │['^S'Z'^P'] '^R'Macro Editor '^P' │');
write (^P' └───────────────────────────────────┘ └───────────────────────────────────┘');
write (^M^P' ┌─────────────────────────────────────────────────────────────────────────────┐');
write (^P' │['^S'A'^P'] '^R'Configure Colors '^P'['^S'!'^P'] '^R'Password'^P': '
+^S'CLASSIFIED '^P'│');
write (^P' │['^S'B'^P'] '^R'User Note'^P': ');
tab (^S+urec.note,63);
write (^P'│');
write (^P' │['^S'N'^P'] '^R'Config Newscan '^P'['^S'F'^P'] '^R'Configure File Listing '^P'│');
write (^P' └─────────────────────────────────────────────────────────────────────────────┘');
end else begin
write (^P' +-[ '^R'User Configuration '^P']------------+ +-----------------------------------+');
write (^P' |['^S'L'^P'] '^R'Linefeeds '^P': ');
if linefeeds in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write(^P'| |['^S'Y'^P'] '^R'Personal Info'^P' '^P'|');
write (^P' |['^S'W'^P'] '^R'80 Columns '^P': ');
if eightycols in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write (^P'| |['^S'E'^P'] '^R'Emulation '^P': ');
if ansigraphics in urec.config then tab (^S'ANSI',17) else
if vt52 in urec.config then tab (^S'VT52',17) else tab (^S'None',17);
write(^P'|');
write (^P' |['^S'O'^P'] '^R'Post Prompts '^P': ');
if postprompts in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write (^P'| |['^S'S'^P'] '^R'Screen Editor'^P': ');
if fseditor in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write(^P'|');
write (^P' |['^S'C'^P'] '^R'Pause Screen '^P': ');
if moreprompts in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write (^P'| |['^S'D'^P'] '^R'Screen Length'^P': ');
tab (^S+strr(urec.displaylen),17);
write(^P'|');
write (^P' |['^S'G'^P'] '^R'IBM Graphics '^P': ');
if asciigraphics in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write (^P'| |['^S'+'^P'] '^R'Default Prot '^P': ');
if length(urec.defproto)>0 then tab (^S+urec.defproto,17) else
write (^S' ');
ansicolor (urec.statcolor);
write(^P'|');
write (^P' |['^S'T'^P'] '^R'Time at Menu '^P': ');
if showtime in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write (^P'| |['^S'M'^P'] '^R'One Key Input'^P': ');
if urec.menutype=1 then tab (^S'Yes',17) else
if urec.menutype=0 then tab (^S'No',17);
write(^P'|');
write (^P' |['^S'U'^P'] '^R'Lower Case '^P': ');
if lowercase in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
write(^P'| |['^S'Z'^P'] '^R'Macro Editor '^P' |');
write (^P' +-----------------------------------+ +-----------------------------------+');
write (^M^P' +-----------------------------------------------------------------------------+');
write (^P' |['^S'A'^P'] '^R'Configure Colors '^P'['^S'!'^P'] '^R'Password'^P': '
+^S'CLASSIFIED '^P'|');
write (^P' |['^S'B'^P'] '^R'User Note'^P': ');
tab (^S+urec.note,63);
write (^P'|');
write (^P' |['^S'N'^P'] '^R'Config Newscan '^P'['^S'F'^P'] '^R'Configure File Listing '^P'|');
write (^P' +-----------------------------------------------------------------------------+');
end;
if ansigraphics in urec.config then movexy (1,16);
end;
procedure getmacros;
var mogigi:anystr;
begin
repeat
clearscr;
showmacros;
writestr ('Macro # to change [CR/Quit]:');
if length(input)=0 then begin
writeln;
exit
end;
mogigi:=input[1];
if mogigi='?' then showmacros;
if mogigi='1' then begin
writeln;
writestr ('Enter new Macro #1: *');
if length(input)>0 then
urec.macro1:=input;
writeln;
end;
if mogigi='2' then begin
writeln;
writestr ('Enter new Macro #2: *');
if length(input)>0 then
urec.macro2:=input;
writeln;
end;
if mogigi='3' then begin
writeln;
writestr ('Enter new Macro #3: *');
if length(input)>0 then
urec.macro3:=input;
writeln;
end;
until (upstring(mogigi)='Q') or (length(mogigi)=0);
end;
{
procedure getansiwindows;
var n:integer;
begin
writehdr ('ANSI Windows');
write ('Current setting: '^S);
if urec.ansiwindows=0 then write ('Off') else write ('On');
writeln (^B^M^M'Would you like:');
writeln (' [1]: On');
writeln (' [2]: Off');
writestr (^M'Your choice:');
n:=valu(input);
if (n>0) and (n<3) then begin
if n=2
then urec.ansiwindows:=0
else urec.ansiwindows:=1;
writeurec
end
end;
}
procedure getmenutype;
var n:integer;
begin
if urec.menutype=0 then
urec.menutype:=1 else if urec.menutype=1 then urec.menutype:=0;
{writehdr ('Hotkeys');
write ('Current setting: '^S);
case urec.menutype of
0:writeln ('Standard Menus');
1:writeln ('Hotkey Menus');
end;
writeln (^B^M'Would you like:');
writeln;
writeln (' [1]: Standard Menus');
writeln (' [2]: Hotkey Menus [one-key]');
writeln;
writestr ('Your choice:');
n:=valu(input);
if (n>0) and (n<3) then begin
case n of
1:urec.menutype:=0;
2:urec.menutype:=1;
end;
writeurec
end}
end;
procedure changepassword;
var t:sstr;
begin
buflen:=15;
echodot:=true;
write ('Choose your new password now - Return/have one generated: ');
if getpassword
then begin
echodot:=false;
writeurec;
writestr ('Password changed.');
writelog (1,1,'')
end else begin
echodot:=false;
writestr ('No change.');
end;
end;
procedure changedefproto;
var c,k:char;
begin
movexy(1,16);
{if length(urec.defproto)>0 then writeln(^R'Current Default Protocol is '^S+urec.defproto+^R) else
writeln(^R'No Default Protocol is defined.');
writeln ('The complete protocol list is available in the transfer area.');
writeln ('The protocol you choose here will be your default for all');
writeln ('uploads and downloads.');
writeln;}
writestr ('Enter new Default Protocol [CR/Quit]: *');
if length(input)=0 then exit;
urec.defproto:=upcase(input[1])
end;
procedure yourstat2;
var q:char;
first,last:string;
begin
repeat
clearscr;
writeln (^R'['^S'A'^R'] Real Name : '^S+urec.realname);
writeln (^R'['^S'B'^R'] Sex-M/F : '^S+urec.sex);
writeln (^R'['^S'C'^R'] Age/Years : '^S+strr(urec.age));
writeln (^R'['^S'D'^R'] City/State: '^S+urec.citystate);
writeln (^R'['^S'E'^R'] Country : '^S+urec.country);
writeln (^R'['^S'F'^R'] Zip Code : '^S+urec.zipcode);
writeln (^R'['^S'Q'^R'] Quit');
buflen:=1;
write (^M^R'[Personal Stats Edit]: *');
q:=waitforupchar;
case q of
'A':begin
buflen:=41;
writestr(^R'Enter your real name [first and last]: *');
urec.realname:=input;
writeln;
end;
'B':begin
buflen:=1;
writestr(^R'Enter your sex [M/F]: *');
urec.sex:=upstring(input);
if (urec.sex='M') or (urec.sex='F') or (urec.sex='m') or (urec.sex='f') then begin
if urec.sex='m' then urec.sex:='M';
if urec.sex='f' then urec.sex:='F';
writeln;
end;
end;
'C':begin
buflen:=3;
writestr(^R'Enter your age: *');
if length(input)=0 then urec.age:=urec.age;
urec.age:=valu(input);
writeln;
end;
'D':begin
buflen:=34;
writeln(^R'Enter your city and state: Format [City/State]:');
writestr(^R'City/State: *');
urec.citystate:=input;
writeln;
end;
'E':begin
buflen:=20;
writestr(^R'Enter your country: *');
urec.country:=input;
writeln;
end;
'F':begin
buflen:=10;
writeln(^R'Enter your zip code: Format [xxxxx or xxxxx-xxxx]:');
writestr(^R'Zip Code: *');
urec.zipcode:=input;
writeln;
end;
end;
until (input='Q') or (input='q');
writeurec;
end;
var q:char;
i:integer;
prompt:lstr;
mname:mstr;
begin
repeat
yourstatus;
{yourstatus2;}
if (not (lowercase in urec.config)) and (ansigraphics in urec.config)
then begin
urec.config:=urec.config+[lowercase];
writestr ('You may not use ANSI in uppercase-only mode.')
end;
if (fseditor in urec.config) and
(urec.config=urec.config-[ansigraphics,vt52])
then begin
urec.config:=urec.config-[fseditor];
writestr ('You may not use the full-screen editor without ANSI or VT52 emulation.')
end;
if ansigraphics in urec.config then movexy (1,16);
write (^P'['^R+'User Configuration'+^P']'^S': ');
{q:=menu ('User Configuration','CONFIG','QLWOCGTUEDNYFHZAM!+B');}
q:=waitforupchar;
case q of
'L':begin getthing (linefeeds); end;
'W':begin getthing (eightycols); end;
'O':begin getthing (postprompts); end;
'C':begin getthing (moreprompts); end;
'G':begin getthing (asciigraphics); end;
'T':begin getthing (showtime); end;
'U':begin getthing (lowercase); end;
'E':begin emulation; end;
'D':begin getdisplaylen; end;
'N':begin configurenewscan; end;
'Y':begin yourstat2; end;
'S':begin getthing (fseditor); end;
'Z':begin getmacros; end;
'A':begin colorconfig; end;
'M':begin getmenutype; end;
'!':begin changepassword; end;
'+':begin changedefproto; end;
'B':begin if ulvl>defuserlevel then begin newusernote; end else
writeln ('You are still a new user.');
end;
'F':configurefilelisting;
end;
writeurec
until (q='Q') or hungupon
end;
begin
end.