home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FAQ-S.ZIP / CONFIGUR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-04  |  26.4 KB  |  849 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit configur;
  5.  
  6. interface
  7.  
  8. uses dos,crt,configrt,gentypes,userret,gensubs,subs1,subs2,flags,overlay,modem;
  9.  
  10. procedure configure;
  11. procedure configurefilelisting;
  12.  
  13. implementation
  14.  
  15. procedure getfilething (c:filelisttype);
  16. var n:integer;
  17.     name,onstr,offstr:lstr;
  18. begin
  19.   if c in urec.filelister then
  20.   urec.filelister:=urec.filelister-[c] else urec.filelister:=urec.filelister+[c];
  21. end;
  22.  
  23. procedure configurefilelisting;
  24. var q:char; totalfile:integer;
  25. begin
  26. totalfile:=75;
  27. if ffname in urec.filelister then totalfile:=totalfile-9;
  28. if ffext in urec.filelister then totalfile:=totalfile-4;
  29. if ffsize in urec.filelister then totalfile:=totalfile-10;
  30. if ffpoints in urec.filelister then totalfile:=totalfile-5;
  31. if ffuploader in urec.filelister then totalfile:=totalfile-13;
  32. if ffuploaded in urec.filelister then totalfile:=totalfile-9;
  33. if ffdown in urec.filelister then totalfile:=totalfile-4;
  34. if fffulnam in urec.filelister then totalfile:=totalfile-28;
  35. if ffofwhat in urec.filelister then totalfile:=totalfile-6;
  36. repeat
  37. clearscr;
  38. write (^R'Space: 9  ['^S'1'^R'] Filename           : '^S);
  39. if ffname in urec.filelister then writeln ('ON ') else writeln ('OFF');
  40. write (^R'Space: 4  ['^S'2'^R'] Filename Extension : '^S);
  41. if ffext in urec.filelister then writeln ('ON ') else writeln ('OFF');
  42. write (^R'Space: 10 ['^S'3'^R'] File Size          : '^S);
  43. if ffsize in urec.filelister then writeln ('ON ') else writeln ('OFF');
  44. write (^R'Space: 5  ['^S'4'^R'] File Cost          : '^S);
  45. if ffpoints in urec.filelister then writeln ('ON ') else writeln ('OFF');
  46. write (^R'Space: 13 ['^S'5'^R'] Uploader           : '^S);
  47. if ffuploader in urec.filelister then writeln ('ON ') else writeln ('OFF');
  48. write (^R'Space: 9  ['^S'6'^R'] Date Uploaded      : '^S);
  49. if ffuploaded in urec.filelister then writeln ('ON ') else writeln ('OFF');
  50. write (^R'Space: 4  ['^S'7'^R'] D/L Popularity     : '^S);
  51. if ffdown in urec.filelister then writeln ('ON ') else writeln ('OFF');
  52. write (^R'Space: 28 ['^S'8'^R'] Program Description: '^S);
  53. if fffulnam in urec.filelister then writeln ('ON ') else writeln ('OFF');
  54. write (^R'Space: 6  ['^S'9'^R'] Disk x of y        : '^S);
  55. if ffofwhat in urec.filelister then writeln ('ON ') else writeln ('OFF');
  56. write (^R'Free Space: ');
  57. writeln (^S+strr(totalfile));
  58. buflen:=1;
  59. write (^M^P'File Listing Configuration: ');
  60. q:=waitforupchar;
  61. case q of
  62. '1':begin
  63.     getfilething (ffname);
  64.     if ffname in urec.filelister then totalfile:=totalfile-9 else totalfile:=totalfile+9;
  65.     if (ffname in urec.filelister) and (totalfile<0) then begin
  66.     sound (20);
  67.     delay (50);
  68.     nosound;
  69.     urec.filelister:=urec.filelister-[ffname];
  70.     totalfile:=totalfile+9;
  71.     end; end;
  72. '2':begin
  73.     getfilething (ffext);
  74.     if ffext in urec.filelister then totalfile:=totalfile-4 else totalfile:=totalfile+4;
  75.     if (ffext in urec.filelister) and (totalfile<0) then begin
  76.     sound (20);
  77.     delay (50);
  78.     nosound;
  79.     urec.filelister:=urec.filelister-[ffext];
  80.     totalfile:=totalfile+4;
  81.     end; end;
  82. '3':begin
  83.     getfilething (ffsize);
  84.     if ffsize in urec.filelister then totalfile:=totalfile-10 else totalfile:=totalfile+10;
  85.     if (ffsize in urec.filelister) and (totalfile<0) then begin
  86.     sound (20);
  87.     delay (50);
  88.     nosound;
  89.     urec.filelister:=urec.filelister-[ffsize];
  90.     totalfile:=totalfile+10;
  91.     end; end;
  92. '4':begin
  93.     getfilething (ffpoints);
  94.     if ffpoints in urec.filelister then totalfile:=totalfile-5 else totalfile:=totalfile+5;
  95.     if (ffpoints in urec.filelister) and (totalfile<0) then begin
  96.     sound (20);
  97.     delay (50);
  98.     nosound;
  99.     urec.filelister:=urec.filelister-[ffpoints];
  100.     totalfile:=totalfile+5;
  101.     end; end;
  102. '5':begin
  103.     getfilething (ffuploader);
  104.     if ffuploader in urec.filelister then totalfile:=totalfile-13 else totalfile:=totalfile+13;
  105.     if (ffuploader in urec.filelister) and (totalfile<0) then begin
  106.     sound (20);
  107.     delay (50);
  108.     nosound;
  109.     urec.filelister:=urec.filelister-[ffuploader];
  110.     totalfile:=totalfile+13;
  111.     end; end;
  112. '6':begin
  113.     getfilething (ffuploaded);
  114.     if ffuploaded in urec.filelister then totalfile:=totalfile-9 else totalfile:=totalfile+9;
  115.     if (ffuploaded in urec.filelister) and (totalfile<0) then begin
  116.     sound (20);
  117.     delay (50);
  118.     nosound;
  119.     urec.filelister:=urec.filelister-[ffuploaded];
  120.     totalfile:=totalfile+9;
  121.     end; end;
  122. '7':begin
  123.     getfilething (ffdown);
  124.     if ffdown in urec.filelister then totalfile:=totalfile-4 else totalfile:=totalfile+4;
  125.     if (ffdown in urec.filelister) and (totalfile<0) then begin
  126.     sound (20);
  127.     delay (50);
  128.     nosound;
  129.     urec.filelister:=urec.filelister-[ffdown];
  130.     totalfile:=totalfile+4;
  131.     end; end;
  132. '8':begin
  133.     getfilething (fffulnam);
  134.     if fffulnam in urec.filelister then totalfile:=totalfile-28 else totalfile:=totalfile+28;
  135.     if (fffulnam in urec.filelister) and (totalfile<0) then begin
  136.     sound (20);
  137.     delay (50);
  138.     nosound;
  139.     urec.filelister:=urec.filelister-[fffulnam];
  140.     totalfile:=totalfile+28;
  141.     end; end;
  142. '9':begin
  143.     getfilething (ffofwhat);
  144.     if ffofwhat in urec.filelister then totalfile:=totalfile-6 else totalfile:=totalfile+6;
  145.     if (ffofwhat in urec.filelister) and (totalfile<0) then begin
  146.     sound (20);
  147.     delay (50);
  148.     nosound;
  149.     urec.filelister:=urec.filelister-[ffofwhat];
  150.     totalfile:=totalfile+6;
  151.     end; end;
  152. end;
  153. until (q='Q') or hungupon;
  154. writeurec;
  155. end;
  156.  
  157. procedure configure;
  158. var totalfile:integer;
  159.  
  160. const colorstr:array [0..7] of string[7]=
  161.         ('Black','Blue','Green','Cyan','Red','Magenta','Yellow','White');
  162.  
  163. procedure options (c:configtype; var prompt,onstr,offstr:lstr);
  164.  
  165.   procedure ret (x1,x2,x3:lstr);
  166.   begin
  167.     prompt:=x1;
  168.     onstr:=x2;
  169.     offstr:=x3
  170.   end;
  171.  
  172. begin
  173.   case c of
  174.     linefeeds:ret('Require Line Feeds','Yes','No');
  175.     eightycols:ret('Screen Width','80 columns','40 columns');
  176.     postprompts:ret('Post prompts during Newscan','Yes','No');
  177.     moreprompts:ret('Pause every screen','Yes','No');
  178.     asciigraphics:ret('Use IBM graphics characters','Yes','No');
  179.     showtime:ret('Display time left at prompts','Yes','No');
  180.     lowercase:ret('Upper/lower case','Upper or lower case','Upper case only');
  181.     fseditor:ret('Use ANSI Full-Screen Editor','Yes','No')
  182.   end
  183. end;
  184.  
  185. function getattrib (fg,bk:integer; hi,bl:boolean):integer;
  186. begin
  187.   getattrib:=fg+(byte(hi) shl 3)+(bk shl 4)+(byte(bl) shl 7)
  188. end;
  189.  
  190. procedure getcolorvar (attr:byte; var fg,bk:integer; var hi,bl:boolean);
  191. begin
  192.   fg:=attr and 7;
  193.   hi:=(attr and 8)=8;
  194.   bk:=(attr shr 4) and 7;
  195.   bl:=(attr and 128)=128
  196. end;
  197.  
  198. procedure getthing (c:configtype);
  199. var n:integer;
  200.     name,onstr,offstr:lstr;
  201. begin
  202.  {options (c,name,onstr,offstr);
  203.   writehdr (name);
  204.   write ('Current setting: '^S);}
  205.   if c in urec.config then
  206.   urec.config:=urec.config-[c] else urec.config:=urec.config+[c];
  207. { writeln (^B^M^M'Would you like:');
  208.   writeln (' [1]: ',onstr);
  209.   writeln (' [2]: ',offstr);
  210.   writestr (^M'Selection:');
  211.   n:=valu(input);
  212.   if (n>0) and (n<3) then begin
  213.     if n=2
  214.       then urec.config:=urec.config-[c]
  215.       else urec.config:=urec.config+[c];
  216.     writeurec
  217.   end}
  218. end;
  219.  
  220. procedure writecolorstr (a:byte);
  221. var fg,bk:integer;
  222.     hi,bl:boolean;
  223. begin
  224.   getcolorvar (a,fg,bk,hi,bl);
  225.   ansicolor (a);
  226.   if bl then write ('Blinking ');
  227.   if hi then write ('Highlighted ');
  228.   write (colorstr[fg]);
  229.   if bk>0 then write (' on ',colorstr[bk])
  230. end;
  231.  
  232. function colorval (str:mstr):integer;
  233. var cnt:integer;
  234. begin
  235.   colorval:=-1;
  236.   if match(str,'None') then begin
  237.     colorval:=0;
  238.     exit
  239.   end;
  240.   for cnt:=0 to 7 do
  241.     if match(str,colorstr[cnt]) then begin
  242.       colorval:=cnt;
  243.       exit
  244.     end
  245. end;
  246.  
  247. procedure badcolor;
  248. var cnt:integer;
  249. begin
  250.   writeln ('Invalid color!  Valid colors are:');
  251.   write ('Black, ');
  252.   for cnt:=1 to 7 do begin
  253.     ansicolor (cnt);
  254.     write (colorstr[cnt]);
  255.     if (cnt=7)
  256.       then writeln ('.')
  257.       else if (cnt<>7) and (cnt<>6) then write (', ');
  258.     if cnt=6
  259.       then write (', and ');
  260.   end;
  261.   writestr ('')
  262. end;
  263.  
  264. procedure getcolor (prompt:mstr; var a:byte);
  265.  
  266.   procedure getacolor (var q:integer; prompt:mstr);
  267.   var n:integer;
  268.   begin
  269.     repeat
  270.       writestr ('Enter new '+prompt+' Color:');
  271.       if hungupon or (length(input)=0) then exit;
  272.       n:=colorval(input);
  273.       if n=-1
  274.         then badcolor
  275.         else q:=n
  276.     until n<>-1
  277.   end;
  278.  
  279. var fg,bk:integer;
  280.     hi,bl:boolean;
  281. begin
  282.   if not (ansigraphics in urec.config) then begin
  283.     writestr ('You must have ANSI emulation to see color.');
  284.     exit
  285.   end;
  286.   getcolorvar (a,fg,bk,hi,bl);
  287.   write ('Current ',prompt,' Color: ');
  288.   writecolorstr (a);
  289.   writestr (^M^M);
  290.   getacolor (fg,'Foreground');
  291.   getacolor (bk,'Background');
  292.   writestr ('Highlight the Characters? [y/n]: *');
  293.   hi:=yes;
  294.   writestr ('Should the Characters Blink? [y/n]: *');
  295.   bl:=yes;
  296.   a:=getattrib (fg,bk,hi,bl)
  297. end;
  298.  
  299. procedure emulation;
  300. begin
  301.   clearscr;
  302.   tab ('Emulation:',75);
  303.   writeln(^M);
  304.   writeln ('[1] ANSI Color/VT100 [Strongly Recommended]');
  305.   writeln ('[2] VT52 Emulation   [Recommended]');
  306.   writeln ('[3] No Emulation     [Strongly Discouraged]');
  307.   writestr (^M'[Emulation]: *');
  308.   if length(input)=0 then exit;
  309.   urec.config:=urec.config-[ansigraphics,vt52];
  310.   case valu(input) of
  311.     1:urec.config:=urec.config+[ansigraphics];
  312.     2:urec.config:=urec.config+[vt52]
  313.   end
  314. end;
  315.  
  316. procedure getdisplaylen;
  317. var v:integer;
  318. begin
  319.   movexy(1,16);
  320.   writeln ('Current display length is: '^S,urec.displaylen);
  321.   movexy (1,17);
  322.   writestr ('Enter new display length [21-43]:');
  323.   if length(input)=0 then exit;
  324.   v:=valu(input);
  325.   if (v<21) or (v>43)
  326.     then writeln ('Invalid!')
  327.     else urec.displaylen:=v
  328. end;
  329.  
  330. procedure configurenewscan;
  331. var bd:boardrec;
  332.     bn:integer;
  333.     cnt:integer;
  334.     ac:accesstype;
  335. begin
  336.   cnt:=conn;
  337.   clearscr;
  338.   repeat
  339.   writestr (^R'Which Conference? [1,2,3,4,5]-[With Access]: *');
  340.   conn:=valu(input);
  341.   until (conn=0) or
  342.         (conn=1) and (length(confm[1])>0) and (urec.defcon[1]) or
  343.         (conn=2) and (length(confm[2])>0) and (urec.defcon[2]) or
  344.         (conn=3) and (length(confm[3])>0) and (urec.defcon[3]) or
  345.         (conn=4) and (length(confm[4])>0) and (urec.defcon[4]) or
  346.         (conn=5) and (length(confm[5])>0) and (urec.defcon[5]);
  347.   opentempbdfile;
  348.   seek (bdfile,0);
  349.   for bn:=0 to filesize(bdfile)-1 do begin
  350.     read (bdfile,bd);
  351.     ac:=getuseraccflag(urec,bn);
  352.     if (ac=letin) or ((ulvl>=bd.level) and (ac=bylevel)) then begin
  353.       writestr ('Newscan '^R'['^S+bd.boardname+^R'] <now '+
  354.                 yesno(not (bn in urec.newscanconfig))+'>:');
  355.       if length(input)<>0 then
  356.         if yes
  357.           then urec.newscanconfig:=urec.newscanconfig-[bn]
  358.           else urec.newscanconfig:=urec.newscanconfig+[bn]
  359.     end
  360.   end;
  361.   closetempbdfile;
  362.   conn:=cnt;
  363. end;
  364.  
  365. procedure showit (s,v:lstr);
  366. begin
  367.   if break then exit;
  368.   write (s);
  369.   writeln (^S,v)
  370. end;
  371.  
  372. procedure showthing (c:configtype);
  373. var n:integer;
  374.     name,onstr,offstr:lstr;
  375. begin
  376. if c in urec.config then
  377. write (^S'Yes ') else write(^S'No  ');
  378. { if break then exit;
  379.   options (c,name,onstr,offstr);
  380.   tab (name+':',30);
  381.   write (^S);
  382.   if c in urec.config
  383.     then write (^S,onstr)
  384.     else write (^S,offstr);
  385.   writeln
  386. }end;
  387.  
  388. procedure showemulation;
  389. var q:lstr;
  390. begin
  391. { if ansigraphics in urec.config
  392.     then q:='ANSI'
  393.     else if vt52 in urec.config
  394.       then q:='VT52'
  395.       else q:='None';}
  396. if ansigraphics in urec.config then
  397. write (^S+'ANSI') else
  398. if vt52 in urec.config then write(^S+'VT52') else write(^S+'None');
  399. { showit ('Terminal type',q)
  400. }end;
  401.  
  402. procedure showdisplaylen;
  403. begin
  404.   ansicolor (urec.statcolor);
  405.   write (strr(urec.displaylen));
  406.  {showit ('Display length',strr(urec.displaylen))
  407. }end;
  408.  
  409. procedure showcolor (prompt:mstr; attr:byte);
  410. begin
  411.   if break then exit;
  412.   tab (^R+prompt+' color:',31);
  413.   writecolorstr (attr);
  414.   ansicolor (urec.regularcolor);
  415.   writeln
  416. end;
  417.  
  418. procedure colorconfig;
  419. var mogigi:anystr;
  420. begin
  421.  repeat
  422.    clearscr;
  423.    write (^P'['^S'1'^P'] '); showcolor ('Prompt',urec.promptcolor);
  424.    write (^P'['^S'2'^P'] '); showcolor ('Input',urec.inputcolor);
  425.    write (^P'['^S'3'^P'] '); showcolor ('Regular',urec.regularcolor);
  426.    write (^P'['^S'4'^P'] '); showcolor ('Statistic',urec.statcolor);
  427.    write (^P'['^S'5'^P'] '); showcolor ('Border',urec.bordercolor);
  428.    write (^P'['^S'6'^P'] '); showcolor ('Border Status',urec.bstatuscolor);
  429.    writestr (^M^P'['^R'Color Config Menu'^P']:');
  430.  if length(input)=0 then begin
  431.   writeln;
  432.   exit
  433.  end;
  434.  mogigi:=input[1];
  435.  if mogigi='1' then begin
  436.       writeln;
  437.       getcolor ('Prompt',urec.promptcolor);
  438.       end;
  439.  if mogigi='2' then begin
  440.       writeln;
  441.       getcolor ('Input',urec.inputcolor);
  442.       end;
  443.  if mogigi='3' then begin
  444.       writeln;
  445.       getcolor ('Regular',urec.regularcolor);
  446.       end;
  447.  if mogigi='4' then begin
  448.       writeln;
  449.       getcolor ('Status',urec.statcolor);
  450.       end;
  451.  
  452.  if mogigi='5' then begin
  453.       writeln;
  454.       getcolor ('Border',urec.bordercolor);
  455.       end;
  456.  
  457.  if mogigi='6' then begin
  458.       writeln;
  459.       getcolor ('Border Status',urec.bstatuscolor);
  460.       end;
  461.  until (upstring(mogigi)='Q') or (length(mogigi)=0);
  462. end;
  463.  
  464. procedure showmacros;
  465. begin
  466.  writeln;
  467.  writeln (^R'Message Macro #1 currently shows:'^S);
  468.  writeln (urec.macro1);
  469.  writeln;
  470.  writeln (^R'Message Macro #2 currently shows:'^S);
  471.  writeln (urec.macro2);
  472.  writeln;
  473.  writeln (^R'Message Macro #3 currently shows:'^S);
  474.  writeln (urec.macro3);
  475.  writeln;
  476.  writeln (^R);
  477. end;
  478.  
  479. procedure newusernote;
  480. begin
  481.        movexy(1,16); writeln(^R'Your User Note currently reads: "'^S+urec.note+^R'"');
  482.        movexy (1,17);
  483.        writestr(^M'Enter your new User Note:');
  484.        if length(input)<>0 then urec.note:=input;
  485.        writeln;
  486. end;
  487.  
  488. {procedure yourstatus2;
  489. begin
  490. if linefeeds in urec.config then printxy(22,2,^S'Yes ') else printxy(22,2,^S'No  ');
  491. if eightycols in urec.config then printxy(22,3,^S'Yes ') else printxy(22,3,^S'No  ');
  492. if ansigraphics in urec.config then
  493. printxy (64,3,^S'ANSI') else
  494. if vt52 in urec.config then printxy(64,3,^S'VT52') else printxy(64,3,^S'None');
  495. if postprompts in urec.config then printxy(22,4,^S'Yes ') else printxy(22,4,^S'No  ');
  496. if fseditor in urec.config then printxy(64,4,^S'Yes ') else
  497. printxy(64,4,^S'No  ');
  498. if moreprompts in urec.config then printxy(22,5,^S'Yes ') else
  499. printxy(22,5,^S'No  ');
  500. printxy(64,5,^S+strr(urec.displaylen));
  501. if asciigraphics in urec.config then printxy(22,6,^S'Yes ') else
  502. printxy(22,6,^S'No  ');
  503. printxy(64,6,^S+urec.defproto);
  504. if showtime in urec.config then printxy(22,7,^S'Yes ') else
  505. printxy(22,7,^S'No  ');
  506. if urec.menutype=0 then
  507. printxy(64,7,^S'No  ') else if urec.menutype=1 then printxy(64,7,^S'Yes ');
  508. if lowercase in urec.config then printxy(22,8,^S'Yes ') else
  509. printxy(22,8,^S'No  ');
  510. printxy (18,13,^S+urec.note);
  511. movexy (1,16);
  512. writeln;
  513. end;}
  514.  
  515. procedure yourstatus;
  516. begin
  517. clearscr;
  518. if asciigraphics in urec.config then begin
  519. write   (^P' ┌─┤ '^R'User Configuration '^P'├────────────┐     ┌───────────────────────────────────┐');
  520. write   (^P' │['^S'L'^P'] '^R'Linefeeds    '^P': ');
  521. if linefeeds in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  522. write(^P'│     │['^S'Y'^P'] '^R'Personal Info'^P'                  '^P'│');
  523. write   (^P' │['^S'W'^P'] '^R'80 Columns   '^P': ');
  524. if eightycols in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  525. write  (^P'│     │['^S'E'^P'] '^R'Emulation    '^P': ');
  526. if ansigraphics in urec.config then tab (^S'ANSI',17) else
  527. if vt52 in urec.config then tab (^S'VT52',17) else tab (^S'None',17);
  528. write(^P'│');
  529. write   (^P' │['^S'O'^P'] '^R'Post Prompts '^P': ');
  530. if postprompts in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  531. write  (^P'│     │['^S'S'^P'] '^R'Screen Editor'^P': ');
  532. if fseditor in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  533. write(^P'│');
  534. write   (^P' │['^S'C'^P'] '^R'Pause Screen '^P': ');
  535. if moreprompts in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  536. write  (^P'│     │['^S'D'^P'] '^R'Screen Length'^P': ');
  537. tab (^S+strr(urec.displaylen),17);
  538. write(^P'│');
  539. write   (^P' │['^S'G'^P'] '^R'IBM Graphics '^P': ');
  540. if asciigraphics in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  541. write  (^P'│     │['^S'+'^P'] '^R'Default Prot '^P': ');
  542. if length(urec.defproto)>0 then tab (^S+urec.defproto,17) else
  543. write (^S'                  ');
  544. ansicolor (urec.statcolor);
  545. write(^P'│');
  546. write   (^P' │['^S'T'^P'] '^R'Time at Menu '^P': ');
  547. if showtime in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  548. write  (^P'│     │['^S'M'^P'] '^R'One Key Input'^P': ');
  549. if urec.menutype=1 then tab (^S'Yes',17) else
  550. if urec.menutype=0 then tab (^S'No',17);
  551. write(^P'│');
  552. write   (^P' │['^S'U'^P'] '^R'Lower Case   '^P': ');
  553. if lowercase in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  554. write(^P'│     │['^S'Z'^P'] '^R'Macro Editor '^P'                  │');
  555. write (^P' └───────────────────────────────────┘     └───────────────────────────────────┘');
  556. write (^M^P' ┌─────────────────────────────────────────────────────────────────────────────┐');
  557. write (^P' │['^S'A'^P'] '^R'Configure Colors                      '^P'['^S'!'^P'] '^R'Password'^P': '
  558. +^S'CLASSIFIED           '^P'│');
  559. write   (^P' │['^S'B'^P'] '^R'User Note'^P': ');
  560. tab (^S+urec.note,63);
  561. write (^P'│');
  562. write (^P' │['^S'N'^P'] '^R'Config Newscan                        '^P'['^S'F'^P'] '^R'Configure File Listing         '^P'│');
  563. write (^P' └─────────────────────────────────────────────────────────────────────────────┘');
  564. end else begin
  565. write   (^P' +-[ '^R'User Configuration '^P']------------+     +-----------------------------------+');
  566. write   (^P' |['^S'L'^P'] '^R'Linefeeds    '^P': ');
  567. if linefeeds in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  568. write(^P'|     |['^S'Y'^P'] '^R'Personal Info'^P'                  '^P'|');
  569. write   (^P' |['^S'W'^P'] '^R'80 Columns   '^P': ');
  570. if eightycols in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  571. write  (^P'|     |['^S'E'^P'] '^R'Emulation    '^P': ');
  572. if ansigraphics in urec.config then tab (^S'ANSI',17) else
  573. if vt52 in urec.config then tab (^S'VT52',17) else tab (^S'None',17);
  574. write(^P'|');
  575. write   (^P' |['^S'O'^P'] '^R'Post Prompts '^P': ');
  576. if postprompts in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  577. write  (^P'|     |['^S'S'^P'] '^R'Screen Editor'^P': ');
  578. if fseditor in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  579. write(^P'|');
  580. write   (^P' |['^S'C'^P'] '^R'Pause Screen '^P': ');
  581. if moreprompts in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  582. write  (^P'|     |['^S'D'^P'] '^R'Screen Length'^P': ');
  583. tab (^S+strr(urec.displaylen),17);
  584. write(^P'|');
  585. write   (^P' |['^S'G'^P'] '^R'IBM Graphics '^P': ');
  586. if asciigraphics in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  587. write  (^P'|     |['^S'+'^P'] '^R'Default Prot '^P': ');
  588. if length(urec.defproto)>0 then tab (^S+urec.defproto,17) else
  589. write (^S'                  ');
  590. ansicolor (urec.statcolor);
  591. write(^P'|');
  592. write   (^P' |['^S'T'^P'] '^R'Time at Menu '^P': ');
  593. if showtime in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  594. write  (^P'|     |['^S'M'^P'] '^R'One Key Input'^P': ');
  595. if urec.menutype=1 then tab (^S'Yes',17) else
  596. if urec.menutype=0 then tab (^S'No',17);
  597. write(^P'|');
  598. write   (^P' |['^S'U'^P'] '^R'Lower Case   '^P': ');
  599. if lowercase in urec.config then tab (^S'Yes',17) else tab (^S'No',17);
  600. write(^P'|     |['^S'Z'^P'] '^R'Macro Editor '^P'                  |');
  601. write (^P' +-----------------------------------+     +-----------------------------------+');
  602. write (^M^P' +-----------------------------------------------------------------------------+');
  603. write (^P' |['^S'A'^P'] '^R'Configure Colors                      '^P'['^S'!'^P'] '^R'Password'^P': '
  604. +^S'CLASSIFIED           '^P'|');
  605. write   (^P' |['^S'B'^P'] '^R'User Note'^P': ');
  606. tab (^S+urec.note,63);
  607. write (^P'|');
  608. write (^P' |['^S'N'^P'] '^R'Config Newscan                        '^P'['^S'F'^P'] '^R'Configure File Listing         '^P'|');
  609. write (^P' +-----------------------------------------------------------------------------+');
  610.  end;
  611. if ansigraphics in urec.config then movexy (1,16);
  612. end;
  613.  
  614. procedure getmacros;
  615. var mogigi:anystr;
  616. begin
  617.  repeat
  618.  clearscr;
  619.  showmacros;
  620.  writestr ('Macro # to change [CR/Quit]:');
  621.  if length(input)=0 then begin
  622.   writeln;
  623.   exit
  624.  end;
  625.  mogigi:=input[1];
  626.  if mogigi='?' then showmacros;
  627.  if mogigi='1' then begin
  628.        writeln;
  629.        writestr ('Enter new Macro #1: *');
  630.        if length(input)>0 then
  631.         urec.macro1:=input;
  632.        writeln;
  633.       end;
  634.  if mogigi='2' then begin
  635.        writeln;
  636.        writestr ('Enter new Macro #2: *');
  637.        if length(input)>0 then
  638.         urec.macro2:=input;
  639.        writeln;
  640.       end;
  641.  if mogigi='3' then begin
  642.        writeln;
  643.        writestr ('Enter new Macro #3: *');
  644.        if length(input)>0 then
  645.         urec.macro3:=input;
  646.        writeln;
  647.       end;
  648.  until (upstring(mogigi)='Q') or (length(mogigi)=0);
  649. end;
  650.  
  651. {
  652. procedure getansiwindows;
  653. var n:integer;
  654. begin
  655.   writehdr ('ANSI Windows');
  656.   write ('Current setting: '^S);
  657.   if urec.ansiwindows=0 then write ('Off') else write ('On');
  658.   writeln (^B^M^M'Would you like:');
  659.   writeln (' [1]: On');
  660.   writeln (' [2]: Off');
  661.   writestr (^M'Your choice:');
  662.   n:=valu(input);
  663.   if (n>0) and (n<3) then begin
  664.     if n=2
  665.       then urec.ansiwindows:=0
  666.       else urec.ansiwindows:=1;
  667.     writeurec
  668.   end
  669. end;
  670. }
  671.  
  672. procedure getmenutype;
  673. var n:integer;
  674. begin
  675.   if urec.menutype=0 then
  676.   urec.menutype:=1 else if urec.menutype=1 then urec.menutype:=0;
  677.  {writehdr ('Hotkeys');
  678.   write ('Current setting: '^S);
  679.   case urec.menutype of
  680.    0:writeln ('Standard Menus');
  681.    1:writeln ('Hotkey Menus');
  682.   end;
  683.   writeln (^B^M'Would you like:');
  684.   writeln;
  685.   writeln (' [1]: Standard Menus');
  686.   writeln (' [2]: Hotkey Menus [one-key]');
  687.   writeln;
  688.   writestr ('Your choice:');
  689.   n:=valu(input);
  690.   if (n>0) and (n<3) then begin
  691.    case n of
  692.     1:urec.menutype:=0;
  693.     2:urec.menutype:=1;
  694.    end;
  695.    writeurec
  696.   end}
  697. end;
  698.  
  699. procedure changepassword;
  700. var t:sstr;
  701. begin
  702.   buflen:=15;
  703.   echodot:=true;
  704.   write ('Choose your new password now - Return/have one generated: ');
  705.   if getpassword
  706.     then begin
  707.       echodot:=false;
  708.       writeurec;
  709.       writestr ('Password changed.');
  710.       writelog (1,1,'')
  711.     end else begin
  712.       echodot:=false;
  713.       writestr ('No change.');
  714.  end;
  715. end;
  716.  
  717. procedure changedefproto;
  718. var c,k:char;
  719. begin
  720. movexy(1,16);
  721. {if length(urec.defproto)>0 then writeln(^R'Current Default Protocol is '^S+urec.defproto+^R) else
  722.         writeln(^R'No Default Protocol is defined.');
  723.   writeln ('The complete protocol list is available in the transfer area.');
  724.   writeln ('The protocol you choose here will be your default for all');
  725.   writeln ('uploads and downloads.');
  726.   writeln;}
  727.   writestr ('Enter new Default Protocol [CR/Quit]: *');
  728.   if length(input)=0 then exit;
  729.   urec.defproto:=upcase(input[1])
  730. end;
  731.  
  732. procedure yourstat2;
  733. var q:char;
  734.     first,last:string;
  735. begin
  736. repeat
  737. clearscr;
  738. writeln (^R'['^S'A'^R'] Real Name : '^S+urec.realname);
  739. writeln (^R'['^S'B'^R'] Sex-M/F   : '^S+urec.sex);
  740. writeln (^R'['^S'C'^R'] Age/Years : '^S+strr(urec.age));
  741. writeln (^R'['^S'D'^R'] City/State: '^S+urec.citystate);
  742. writeln (^R'['^S'E'^R'] Country   : '^S+urec.country);
  743. writeln (^R'['^S'F'^R'] Zip Code  : '^S+urec.zipcode);
  744. writeln (^R'['^S'Q'^R'] Quit');
  745. buflen:=1;
  746. write (^M^R'[Personal Stats Edit]: *');
  747. q:=waitforupchar;
  748. case q of
  749. 'A':begin
  750.           buflen:=41;
  751.           writestr(^R'Enter your real name [first and last]: *');
  752.           urec.realname:=input;
  753.     writeln;
  754.     end;
  755. 'B':begin
  756.     buflen:=1;
  757.     writestr(^R'Enter your sex [M/F]: *');
  758.     urec.sex:=upstring(input);
  759.   if (urec.sex='M') or (urec.sex='F') or (urec.sex='m') or (urec.sex='f') then begin
  760.    if urec.sex='m' then urec.sex:='M';
  761.    if urec.sex='f' then urec.sex:='F';
  762.    writeln;
  763.      end;
  764.     end;
  765. 'C':begin
  766.     buflen:=3;
  767.     writestr(^R'Enter your age: *');
  768.     if length(input)=0 then urec.age:=urec.age;
  769.     urec.age:=valu(input);
  770.     writeln;
  771.     end;
  772. 'D':begin
  773.     buflen:=34;
  774.     writeln(^R'Enter your city and state: Format [City/State]:');
  775.     writestr(^R'City/State: *');
  776.     urec.citystate:=input;
  777.     writeln;
  778.     end;
  779. 'E':begin
  780.     buflen:=20;
  781.     writestr(^R'Enter your country: *');
  782.     urec.country:=input;
  783.     writeln;
  784.     end;
  785. 'F':begin
  786.     buflen:=10;
  787.     writeln(^R'Enter your zip code: Format [xxxxx or xxxxx-xxxx]:');
  788.     writestr(^R'Zip Code: *');
  789.     urec.zipcode:=input;
  790.     writeln;
  791.     end;
  792. end;
  793. until (input='Q') or (input='q');
  794. writeurec;
  795. end;
  796.  
  797. var q:char;
  798.     i:integer;
  799. prompt:lstr;
  800. mname:mstr;
  801. begin
  802.   repeat
  803.     yourstatus;
  804. {yourstatus2;}
  805.     if (not (lowercase in urec.config)) and (ansigraphics in urec.config)
  806.       then begin
  807.         urec.config:=urec.config+[lowercase];
  808.         writestr ('You may not use ANSI in uppercase-only mode.')
  809.       end;
  810.     if (fseditor in urec.config) and
  811.        (urec.config=urec.config-[ansigraphics,vt52])
  812.       then begin
  813.         urec.config:=urec.config-[fseditor];
  814.         writestr ('You may not use the full-screen editor without ANSI or VT52 emulation.')
  815.       end;
  816.     if ansigraphics in urec.config then movexy (1,16);
  817.     write (^P'['^R+'User Configuration'+^P']'^S': ');
  818.     {q:=menu ('User Configuration','CONFIG','QLWOCGTUEDNYFHZAM!+B');}
  819.     q:=waitforupchar;
  820.     case q of
  821.       'L':begin getthing (linefeeds); end;
  822.       'W':begin getthing (eightycols); end;
  823.       'O':begin getthing (postprompts); end;
  824.       'C':begin getthing (moreprompts); end;
  825.       'G':begin getthing (asciigraphics); end;
  826.       'T':begin getthing (showtime); end;
  827.       'U':begin getthing (lowercase); end;
  828.       'E':begin emulation; end;
  829.       'D':begin getdisplaylen; end;
  830.       'N':begin configurenewscan; end;
  831.       'Y':begin yourstat2; end;
  832.       'S':begin getthing (fseditor); end;
  833.       'Z':begin getmacros; end;
  834.       'A':begin colorconfig; end;
  835.       'M':begin getmenutype; end;
  836.       '!':begin changepassword; end;
  837.       '+':begin changedefproto; end;
  838.       'B':begin if ulvl>defuserlevel then begin newusernote; end else
  839.        writeln ('You are still a new user.');
  840.        end;
  841.       'F':configurefilelisting;
  842.     end;
  843.     writeurec
  844.   until (q='Q') or hungupon
  845. end;
  846.  
  847. begin
  848. end.
  849.