home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 189.img / TCS120S.ZIP / CONFIGUR.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-25  |  13KB  |  500 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 configrt,gentypes,userret,gensubs,subs1,subs2,flags;
  9.  
  10. procedure configure;
  11.  
  12. implementation
  13.  
  14. procedure configure;
  15.  
  16. const colorstr:array [0..7] of string[7]=
  17.         ('Black','Blue','Green','Cyan','Red','Magenta','Yellow','White');
  18.  
  19. procedure options (c:configtype; var prompt,onstr,offstr:lstr);
  20.  
  21.   procedure ret (x1,x2,x3:lstr);
  22.   begin
  23.     prompt:=x1;
  24.     onstr:=x2;
  25.     offstr:=x3
  26.   end;
  27.  
  28. begin
  29.   case c of
  30.     linefeeds:ret('Require Line Feeds','Yes','No');
  31.     eightycols:ret('Screen Width','80 columns','40 columns');
  32.     postprompts:ret('Post prompts during Newscan','Yes','No');
  33.     moreprompts:ret('Pause every screen','Yes','No');
  34.     asciigraphics:ret('Use IBM graphics characters','Yes','No');
  35.     showtime:ret('Display time left at prompts','Yes','No');
  36.     lowercase:ret('Upper/lower case','Upper or lower case','Upper case only');
  37.     fseditor:ret('Use ANSI Full-Screen Editor','Yes','No')
  38.   end
  39. end;
  40.  
  41. function getattrib (fg,bk:integer; hi,bl:boolean):byte;
  42. begin
  43.   getattrib:=fg+(byte(hi) shl 3)+(bk shl 4)+(byte(bl) shl 7)
  44. end;
  45.  
  46. procedure getcolorvar (attr:byte; var fg,bk:integer; var hi,bl:boolean);
  47. begin
  48.   fg:=attr and 7;
  49.   hi:=(attr and 8)=8;
  50.   bk:=(attr shr 4) and 7;
  51.   bl:=(attr and 128)=128
  52. end;
  53.  
  54. procedure getthing (c:configtype);
  55. var n:integer;
  56.     name,onstr,offstr:lstr;
  57. begin
  58.   options (c,name,onstr,offstr);
  59.   writehdr (name);
  60.   write ('Current setting: '^S);
  61.   if c in urec.config then write (onstr) else write (offstr);
  62.   writeln (^B^M^M'Would you like:');
  63.   writeln (' [1]: ',onstr);
  64.   writeln (' [2]: ',offstr);
  65.   writestr (^M'Selection:');
  66.   n:=valu(input);
  67.   if (n>0) and (n<3) then begin
  68.     if n=2
  69.       then urec.config:=urec.config-[c]
  70.       else urec.config:=urec.config+[c];
  71.     writeurec
  72.   end
  73. end;
  74.  
  75. procedure writecolorstr (a:byte);
  76. var fg,bk:integer;
  77.     hi,bl:boolean;
  78. begin
  79.   getcolorvar (a,fg,bk,hi,bl);
  80.   ansicolor (a);
  81.   if bl then write ('Blinking ');
  82.   if hi then write ('Highlighted ');
  83.   write (colorstr[fg]);
  84.   if bk>0 then write (' on ',colorstr[bk])
  85. end;
  86.  
  87. function colorval (str:mstr):integer;
  88. var cnt:integer;
  89. begin
  90.   colorval:=-1;
  91.   if match(str,'None') then begin
  92.     colorval:=0;
  93.     exit
  94.   end;
  95.   for cnt:=0 to 7 do
  96.     if match(str,colorstr[cnt]) then begin
  97.       colorval:=cnt;
  98.       exit
  99.     end
  100. end;
  101.  
  102. procedure badcolor;
  103. var cnt:integer;
  104. begin
  105.   writeln ('Invalid color!  Valid colors are:');
  106.   write ('Black, ');
  107.   for cnt:=1 to 7 do begin
  108.     ansicolor (cnt);
  109.     write (colorstr[cnt]);
  110.     if cnt=7
  111.       then writeln ('.')
  112.       else write (', ');
  113.     if cnt=6
  114.       then write (', and ');
  115.   end;
  116.   writestr ('')
  117. end;
  118.  
  119. procedure getcolor (prompt:mstr; var a:byte);
  120.  
  121.   procedure getacolor (var q:integer; prompt:mstr);
  122.   var n:integer;
  123.   begin
  124.     repeat
  125.       writestr ('Enter new '+prompt+' Color:');
  126.       if hungupon or (length(input)=0) then exit;
  127.       n:=colorval(input);
  128.       if n=-1
  129.         then badcolor
  130.         else q:=n
  131.     until n<>-1
  132.   end;
  133.  
  134. var fg,bk:integer;
  135.     hi,bl:boolean;
  136. begin
  137.   if not (ansigraphics in urec.config) then begin
  138.     writestr ('You must have ANSI emulation to see color.');
  139.     exit
  140.   end;
  141.   getcolorvar (a,fg,bk,hi,bl);
  142.   write ('Current ',prompt,' Color: ');
  143.   writecolorstr (a);
  144.   writestr (^M^M);
  145.   getacolor (fg,'Foreground');
  146.   getacolor (bk,'Background');
  147.   writestr ('Highlight the Characters [y/n]? *');
  148.   hi:=yes;
  149.   writestr ('Should the Characters Blink [y/n]? *');
  150.   bl:=yes;
  151.   a:=getattrib (fg,bk,hi,bl)
  152. end;
  153.  
  154. procedure emulation;
  155. begin
  156.   writeln (^B^M'Note:  ANSI is required for color.');
  157.   writeln (    '       VT52 or ANSI is required for the Full-Screen Editor.');
  158.   writeln;
  159.   writeln (^B'Please choose your terminal type:'^M^M,
  160.            '  [1]: ANSI Color'^M,
  161.            '  [2]: VT52 Emulation'^M,
  162.            '  [3]: None'^M);
  163.   writestr ('Emulation:');
  164.   if length(input)=0 then exit;
  165.   urec.config:=urec.config-[ansigraphics,vt52];
  166.   case valu(input) of
  167.     1:urec.config:=urec.config+[ansigraphics];
  168.     2:urec.config:=urec.config+[vt52]
  169.   end
  170. end;
  171.  
  172. procedure getdisplaylen;
  173. var v:integer;
  174. begin
  175.   writeln ('Current display length is: '^S,urec.displaylen);
  176.   writestr (^M'Enter new display length [21-43]:');
  177.   if length(input)=0 then exit;
  178.   v:=valu(input);
  179.   if (v<21) or (v>43)
  180.     then writeln ('Invalid!')
  181.     else urec.displaylen:=v
  182. end;
  183.  
  184. procedure configurenewscan;
  185. var bd:boardrec;
  186.     bn:integer;
  187.     ac:accesstype;
  188. begin
  189.   opentempbdfile;
  190.   seek (bdfile,0);
  191.   for bn:=0 to filesize(bdfile)-1 do begin
  192.     read (bdfile,bd);
  193.     ac:=getuseraccflag(urec,bn);
  194.     if (ac=letin) or ((ulvl>=bd.level) and (ac=bylevel)) then begin
  195.       writestr ('Newscan ['^S+bd.boardname+^R'] (now '+
  196.                 yesno(not (bn in urec.newscanconfig))+'):');
  197.       if length(input)<>0 then
  198.         if yes
  199.           then urec.newscanconfig:=urec.newscanconfig-[bn]
  200.           else urec.newscanconfig:=urec.newscanconfig+[bn]
  201.     end
  202.   end;
  203.   closetempbdfile
  204. end;
  205.  
  206. procedure showit (s,v:lstr);
  207. begin
  208.   if break then exit;
  209.   tab (s+':',30);
  210.   writeln (^S,v)
  211. end;
  212.  
  213. procedure showthing (c:configtype);
  214. var n:integer;
  215.     name,onstr,offstr:lstr;
  216. begin
  217.   if break then exit;
  218.   options (c,name,onstr,offstr);
  219.   tab (name+':',30);
  220.   write (^S);
  221.   if c in urec.config
  222.     then write (^S,onstr)
  223.     else write (^S,offstr);
  224.   writeln
  225. end;
  226.  
  227. procedure showemulation;
  228. var q:lstr;
  229. begin
  230.   if ansigraphics in urec.config
  231.     then q:='ANSI Color'
  232.     else if vt52 in urec.config
  233.       then q:='VT52 Emulation'
  234.       else q:='None';
  235.   showit ('Terminal type',q)
  236. end;
  237.  
  238. procedure showdisplaylen;
  239. begin
  240.   showit ('Display length',strr(urec.displaylen))
  241. end;
  242.  
  243. procedure showcolor (prompt:mstr; attr:byte);
  244. begin
  245.   if break then exit;
  246.   tab ('  '+prompt+' color:',30);
  247.   writecolorstr (attr);
  248.   ansicolor (urec.regularcolor);
  249.   writeln
  250. end;
  251.  
  252. procedure showmacros;
  253. begin
  254.  writeln;
  255.  writeln (^R'Message Macro #1 currently shows:'^S);
  256.  writeln (urec.macro1);
  257.  writeln;
  258.  writeln (^R'Message Macro #2 currently shows:'^S);
  259.  writeln (urec.macro2);
  260.  writeln;
  261.  writeln (^R'Message Macro #3 currently shows:'^S);
  262.  writeln (urec.macro3);
  263.  writeln;
  264.  writeln (^R);
  265. end;
  266.  
  267. procedure yourstatus;
  268. begin
  269.   writehdr ('Your Configuration');
  270.   showthing (linefeeds);
  271.   showthing (eightycols);
  272.   showthing (postprompts);
  273.   showthing (moreprompts);
  274.   showthing (asciigraphics);
  275.   showthing (showtime);
  276.   showthing (lowercase);
  277.   showemulation;
  278.   showthing (fseditor);
  279.   showdisplaylen;
  280.   write (^R);
  281.   tab ('Default Protocol:',30);
  282.   write (^S);
  283.   if urec.defproto in validprotos then begin
  284.    case urec.defproto of
  285.     'X':writeln ('Xmodem');
  286.     'C':writeln ('Xmodem-CRC');
  287.     'Y':writeln ('Ymodem');
  288.     'Z':writeln ('Zmodem');
  289.     'J':writeln ('Jmodem');
  290.     'L':writeln ('Lynx');
  291.     'G':writeln ('Ymodem-G');
  292.     'O':writeln ('Xmodem OverThruster');
  293.     '1':writeln ('Ymodem OverThruster');
  294.     'S':writeln ('Super8k');
  295.     'K':writeln ('K9Xmodem');
  296.     'R':writeln ('Zmodem Crash Recovery');
  297.     'P':writeln ('PCPursuit Zmodem');
  298.    end
  299.   end;
  300.   write (^R);
  301.   if ansigraphics in urec.config then begin
  302.    showcolor ('Prompt',urec.promptcolor);
  303.    showcolor ('Input',urec.inputcolor);
  304.    showcolor ('Regular',urec.regularcolor);
  305.    showcolor ('Statistic',urec.statcolor)
  306.   end;
  307.   writeln;
  308.   writestr ('Show your Message Macros [y/n]? *');
  309.   if yes then showmacros;
  310. end;
  311.  
  312. procedure getmacros;
  313. var mogigi:anystr;
  314. begin
  315.  repeat
  316.  showmacros;
  317.  writestr ('Macro # to change [CR/Quit]:');
  318.  if length(input)=0 then begin
  319.   writeln;
  320.   exit
  321.  end;
  322.  mogigi:=input[1];
  323.  if mogigi='?' then showmacros;
  324.  if mogigi='1' then begin
  325.        writeln;
  326.        writestr ('Enter new Macro #1: *');
  327.        if length(input)>0 then
  328.         urec.macro1:=input;
  329.        writeln;
  330.       end;
  331.  if mogigi='2' then begin
  332.        writeln;
  333.        writestr ('Enter new Macro #2: *');
  334.        if length(input)>0 then
  335.         urec.macro2:=input;
  336.        writeln;
  337.       end;
  338.  if mogigi='3' then begin
  339.        writeln;
  340.        writestr ('Enter new Macro #3: *');
  341.        if length(input)>0 then
  342.         urec.macro3:=input;
  343.        writeln;
  344.       end;
  345.  until (upstring(mogigi)='Q') or (length(mogigi)=0);
  346. end;
  347.  
  348. {
  349. procedure getansiwindows;
  350. var n:integer;
  351. begin
  352.   writehdr ('ANSI Windows');
  353.   write ('Current setting: '^S);
  354.   if urec.ansiwindows=0 then write ('Off') else write ('On');
  355.   writeln (^B^M^M'Would you like:');
  356.   writeln (' [1]: On');
  357.   writeln (' [2]: Off');
  358.   writestr (^M'Your choice:');
  359.   n:=valu(input);
  360.   if (n>0) and (n<3) then begin
  361.     if n=2
  362.       then urec.ansiwindows:=0
  363.       else urec.ansiwindows:=1;
  364.     writeurec
  365.   end
  366. end;
  367. }
  368.  
  369. procedure getmenutype;
  370. var n:integer;
  371. begin
  372.   writehdr ('Menu Type');
  373.   write ('Current setting: '^S);
  374.   case urec.menutype of
  375.    0:writeln ('Standard Menus');
  376.    1:writeln ('Hotkey Menus');
  377.    2:writeln ('Pulldown Menus');
  378.   end;
  379.   writeln (^B^M'Would you like:');
  380.   writeln;
  381.   writeln (' [0]: Standard Menus');
  382.   writeln (' [1]: Hotkey Menus [one-key]');
  383.   writeln (' [2]: Pulldown Menus [Ansi required]');
  384.   writeln;
  385.   writestr (^M'Your choice:');
  386.   n:=valu(input);
  387.   if (n>-1) and (n<3) then begin
  388.    case n of
  389.     0:urec.menutype:=0;
  390.     1:urec.menutype:=1;
  391.     2:urec.menutype:=2;
  392.    end;
  393.    writeurec
  394.   end
  395. end;
  396.  
  397. procedure changepassword;
  398. var t:sstr;
  399. begin
  400.   writehdr ('Password Change');
  401.   dots:=true;
  402.   buflen:=15;
  403.   writeln ('Enter your new password now, or');
  404.   writeln ('Press [Return] to have on generated.');
  405.   write ('-> ');
  406.   if getpassword
  407.     then begin
  408.       writeurec;
  409.       writestr ('Password changed.');
  410.       writelog (1,1,'')
  411.     end else
  412.       writestr ('Not changed.')
  413. end;
  414.  
  415. procedure changedefproto;
  416. var c,k:char;
  417. begin
  418.   write (^R'Current Default Xfer Protocol is: '^S);
  419.   k:=urec.defproto;
  420.   if k in validprotos then begin
  421.    case k of
  422.     'X':writeln ('Xmodem');
  423.     'Y':writeln ('Ymodem');
  424.     'Z':writeln ('Zmodem');
  425.     'J':writeln ('Jmodem');
  426.     'L':writeln ('Lynx');
  427.     'G':writeln ('Ymodem-G');
  428.     'O':writeln ('Xmodem OverThruster');
  429.     '1':writeln ('Ymodem OverThruster');
  430.     'S':writeln ('Super8k');
  431.     'K':writeln ('K9Xmodem');
  432.     'R':writeln ('Zmodem Crash Recovery');
  433.     'P':writeln ('PCPursuit Zmodem');
  434.    end
  435.   end else
  436.   writeln ('None');
  437.   writeln (^R);
  438.   writeln (^S'           Xfer Protocols available:'^R);
  439.   writeln;
  440.   writeln (^R' ['^S'X'^R']-Xmodem            ['^S'Y'^R']-Ymodem ');
  441.   writeln (^R' ['^S'Z'^R']-Zmodem            ['^S'J'^R']-Jmodem');
  442.   writeln (^R' ['^S'L'^R']-Lynx             '^S'*'^R'['^S'G'^R']-Ymodem-G');
  443.   writeln (^R' ['^S'S'^R']-Super8k           ['^S'K'^R']-K9Xmodem');
  444.   writeln (^R' ['^S'R'^R']-Zmodem Recovery   ['^S'P'^R']-PCPursuit Zmodem');
  445.   writeln (^S'*'^R'['^S'O'^R']-Xmodem OvrThrust '^S'*'^R'['^S'1'^R']-Ymodem OvrThrust');
  446.   writeln (^S' * = '^R'Registered DSZ required');
  447.   writeln;
  448.   writestr ('Enter new Default Protocol [CR/Quit]: *');
  449.   if length(input)=0 then exit;
  450.   c:=upcase(input[1]);
  451.   if c in validprotos then urec.defproto:=c else
  452.   writeln (^M'Invalid Protocol!'^M);
  453. end;
  454.  
  455. var q:integer;
  456. begin
  457.   repeat
  458.     if (not (lowercase in urec.config)) and (ansigraphics in urec.config)
  459.       then begin
  460.         urec.config:=urec.config+[lowercase];
  461.         writestr ('You may not use ANSI in uppercase-only mode.')
  462.       end;
  463.     if (fseditor in urec.config) and
  464.        (urec.config=urec.config-[ansigraphics,vt52])
  465.       then begin
  466.         urec.config:=urec.config-[fseditor];
  467.         writestr ('You may not use the full-screen editor without ANSI or VT52 emulation.')
  468.       end;
  469.     q:=menu ('User Configuration','CONFIG','QLWOCGTUEDPIRSNYFHZAM!+');
  470.     case q of
  471.       2:getthing (linefeeds);
  472.       3:getthing (eightycols);
  473.       4:getthing (postprompts);
  474.       5:getthing (moreprompts);
  475.       6:getthing (asciigraphics);
  476.       7:getthing (showtime);
  477.       8:getthing (lowercase);
  478.       9:emulation;
  479.       10:getdisplaylen;
  480.       11:getcolor ('Prompt',urec.promptcolor);
  481.       12:getcolor ('Input',urec.inputcolor);
  482.       13:getcolor ('Regular',urec.regularcolor);
  483.       14:getcolor ('Status',urec.statcolor);
  484.       15:configurenewscan;
  485.       16:yourstatus;
  486.       17:getthing (fseditor);
  487.       18:showmacros;
  488.       19:getmacros;
  489.       20:{getansiwindows};
  490.       21:getmenutype;
  491.       22:changepassword;
  492.       23:changedefproto
  493.     end;
  494.     writeurec
  495.   until (q=1) or hungupon
  496. end;
  497.  
  498. begin
  499. end.
  500.