home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 270.img / FORUM25C.ZIP / CONFIGUR.PAS < prev    next >
Pascal/Delphi Source File  |  1989-02-06  |  9KB  |  345 lines
  1. {$R-,S-,I-,D-,V-,B-,N-,L- }
  2. {$O+}
  3.  
  4. unit configur;
  5.  
  6.  
  7. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  8.  
  9. interface
  10.  
  11. uses gentypes,userret,gensubs,subs1,subs2,flags;
  12.  
  13. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  14.  
  15. Procedure configure;
  16.  
  17. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  18.  
  19. implementation
  20.  
  21. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  22.  
  23. Procedure configure;
  24.  
  25. const colorstr:array [0..7] of string[7]=
  26.         ('Black','Blue','Green','Cyan','Red','Magenta','Brown','White');
  27.  
  28. Procedure options (c:configtype; VAR prompt,onstr,offstr:lstr);
  29.  
  30.   Procedure ret (x1,x2,x3:lstr);
  31.   begin
  32.     prompt:=x1;
  33.     onstr:=x2;
  34.     offstr:=x3
  35.   end;
  36.  
  37. begin
  38.   case c of
  39.     linefeeds     : ret('Require line feeds','Yes','No');
  40.     eightycols    : ret('Screen width','80 columns','40 columns');
  41.     postprompts   : ret('Post prompts during newscan','Yes','No');
  42.     moreprompts   : ret('Pause every screen','Yes','No');
  43.     asciigraphics : ret('Use IBM graphics characters','Yes','No');
  44.     showtime      : ret('Display time left at prompts','Yes','No');
  45.     lowercase     : ret('Upper/lower case','Upper or lower case','Upper case only');
  46.     fseditor      : ret('Use full-screen editor','Yes','No');
  47.     ExtClrScr     : Ret('Clear screen between posts (extended newscan)',
  48.                         'Yes','No');
  49.   End
  50. End;
  51.  
  52. Function getattrib (fg,bk:integer; hi,bl:boolean):byte;
  53. begin
  54.   getattrib:=fg+(byte(hi) shl 3)+(bk shl 4)+(byte(bl) shl 7)
  55. end;
  56.  
  57. Procedure getcolorvar (attr:byte; VAR fg,bk:integer; VAR hi,bl:boolean);
  58. begin
  59.   fg:=attr and 7;
  60.   hi:=(attr and 8)=8;
  61.   bk:=(attr shr 4) and 7;
  62.   bl:=(attr and 128)=128
  63. end;
  64.  
  65. Procedure getthing (c:configtype);
  66. VAR n:integer;
  67.     name,onstr,offstr:lstr;
  68. begin
  69.   options (c,name,onstr,offstr);
  70.   writehdr (name);
  71.   write ('Current setting: '^S);
  72.   if c in urec.config then write (onstr) else write (offstr);
  73.   writeln (^B^M^M'Would you like:');
  74.   writeln ('  1. ',onstr);
  75.   writeln ('  2. ',offstr);
  76.   writestr (^M'Your choice:');
  77.   n:=valu(input);
  78.   if (n>0) and (n<3) then begin
  79.     if n=2
  80.       then urec.config:=urec.config-[c]
  81.       else urec.config:=urec.config+[c];
  82.     writeurec
  83.   end
  84. end;
  85.  
  86. Procedure writecolorstr (a:byte);
  87. VAR fg,bk:integer;
  88.     hi,bl:boolean;
  89. begin
  90.   getcolorvar (a,fg,bk,hi,bl);
  91.   ansicolor (a);
  92.   if bl then write ('Blinking ');
  93.   if hi then write ('Highlighted ');
  94.   write (colorstr[fg]);
  95.   if bk>0 then write (' on ',colorstr[bk])
  96. end;
  97.  
  98. Function colorval (str:mstr):integer;
  99. VAR cnt:integer;
  100. begin
  101.   colorval:=-1;
  102.   if match(str,'None') then begin
  103.     colorval:=0;
  104.     exit
  105.   end;
  106.   for cnt:=0 to 7 do
  107.     if match(str,colorstr[cnt]) then begin
  108.       colorval:=cnt;
  109.       exit
  110.     end
  111. end;
  112.  
  113. Procedure badcolor;
  114. VAR cnt:integer;
  115. begin
  116.   write ('Invalid color!  Valid colors are Black, ');
  117.   for cnt:=1 to 7 do begin
  118.     ansicolor (cnt);
  119.     write (colorstr[cnt]);
  120.     if cnt=7
  121.       then writeln ('.')
  122.       else write (', ');
  123.     if cnt=6
  124.       then write (', and ');
  125.   end;
  126.   writestr ('')
  127. end;
  128.  
  129. Procedure getcolor (prompt:mstr; VAR a:byte);
  130.  
  131.   Procedure getacolor (VAR q:integer; prompt:mstr);
  132.   VAR n:integer;
  133.   begin
  134.     repeat
  135.       writestr ('Enter new '+prompt+' color:');
  136.       if hungupon or (length(input)=0) then exit;
  137.       n:=colorval(input);
  138.       if n=-1
  139.         then badcolor
  140.         else q:=n
  141.     until n<>-1
  142.   end;
  143.  
  144. VAR fg,bk:integer;
  145.     hi,bl:boolean;
  146. begin
  147.   if not (ansigraphics in urec.config) then begin
  148.     writestr ('You must have ANSI emulation to see color.');
  149.     exit
  150.   end;
  151.   getcolorvar (a,fg,bk,hi,bl);
  152.   write ('Current ',prompt,' color: ');
  153.   writecolorstr (a);
  154.   writestr (^M^M);
  155.   getacolor (fg,'foreground');
  156.   getacolor (bk,'background');
  157.   writestr ('Highlight the characters? *');
  158.   hi:=yes;
  159.   writestr ('Should the characters blink? *');
  160.   bl:=yes;
  161.   a:=getattrib (fg,bk,hi,bl)
  162. end;
  163.  
  164. Procedure emulation;
  165. begin
  166.   writeln (^B^M'Note:  ANSI is required for color.');
  167.   writeln (    '       VT52 or ANSI is required for the full-screen editor.');
  168.   writeln;
  169.   writeln (^B'Please choose your terminal type.'^M^M,
  170.            '   1. ANSI Color'^M,
  171.            '   2. VT52 Emulation'^M,
  172.            '   3. None'^M);
  173.   writestr ('Emulation type:');
  174.   if length(input)=0 then exit;
  175.   urec.config:=urec.config-[ansigraphics,vt52];
  176.   case valu(input) of
  177.     1:urec.config:=urec.config+[ansigraphics];
  178.     2:urec.config:=urec.config+[vt52]
  179.   end
  180. end;
  181.  
  182. Procedure Define_editor;
  183. Begin
  184.   writeln (^B^M'Note:  ANSI is required for color.');
  185.   writeln (    '       VT52 or ANSI is required for the full-screen editor.');
  186.   writeln;
  187.   writeln (^B'Please choose your editor type.'^M^M,
  188.            '   1. ANSI Full screen'^M,
  189.            '   2. Standard Line'^M);
  190.   writestr ('Editor type:');
  191.   if length(input)=0 then exit;
  192.   urec.config := urec.config-[Fseditor];
  193.   case valu(input) of
  194.     1 : urec.config := Urec.Config+[fseditor];
  195.     2 : urec.config := Urec.Config-[Fseditor];
  196.   end
  197. end;
  198.  
  199. Procedure getdisplaylen;
  200. VAR v:integer;
  201. begin
  202.   writeln ('Current display length is: '^S,urec.displaylen);
  203.   writestr (^M'Enter new display length:');
  204.   if length(input)=0 then exit;
  205.   v:=valu(input);
  206.   if (v<21) or (v>43)
  207.     then writeln ('Invalid!')
  208.     else urec.displaylen:=v
  209. end;
  210.  
  211. Procedure configurenewscan;
  212. VAR bd:boardrec;
  213.     bn:integer;
  214.     ac:accesstype;
  215. begin
  216.   opentempbdfile;
  217.   seek (bdfile,0);
  218.   for bn:=0 to filesize(bdfile)-1 do begin
  219.     read (bdfile,bd);
  220.     ac:=getuseraccflag(urec,bn);
  221.     if (ac=letin) or ((ulvl>=bd.level) and (ac=bylevel)) then begin
  222.       writestr ('Newscan '+bd.boardname+' (now '+
  223.                 yesno(not (bn in urec.newscanconfig))+'):');
  224.       if length(input)<>0 then
  225.         if yes
  226.           then urec.newscanconfig:=urec.newscanconfig-[bn]
  227.           else urec.newscanconfig:=urec.newscanconfig+[bn]
  228.     end
  229.   end;
  230.   closetempbdfile
  231. end;
  232.  
  233. Procedure showit (s,v:lstr);
  234. begin
  235.   if break then exit;
  236.   tab (s+':',30);
  237.   writeln (^S,v)
  238. end;
  239.  
  240. Procedure showthing (c:configtype);
  241. VAR n:integer;
  242.     name,onstr,offstr:lstr;
  243. begin
  244.   if break then exit;
  245.   options (c,name,onstr,offstr);
  246.   tab (name+':',30);
  247.   write (^S);
  248.   if c in urec.config
  249.     then write (^S,onstr)
  250.     else write (^S,offstr);
  251.   writeln
  252. end;
  253.  
  254. Procedure showemulation;
  255. VAR q:lstr;
  256. begin
  257.   if ansigraphics in urec.config
  258.     then q:='ANSI Color'
  259.     else if vt52 in urec.config
  260.       then q:='VT52 Emulation'
  261.       else q:='None';
  262.   showit ('Terminal type',q)
  263. end;
  264.  
  265. Procedure showdisplaylen;
  266. begin
  267.   showit ('Display length',strr(urec.displaylen))
  268. end;
  269.  
  270. Procedure showcolor (prompt:mstr; attr:byte);
  271. begin
  272.   if break then exit;
  273.   tab ('  '+prompt+' color:',30);
  274.   writecolorstr (attr);
  275.   writeln
  276. end;
  277.  
  278. Procedure yourstatus;
  279. begin
  280.   writehdr ('Your Configuration');
  281.   showthing (linefeeds);
  282.   showthing (eightycols);
  283.   showthing (postprompts);
  284.   showthing (moreprompts);
  285.   showthing (asciigraphics);
  286.   showthing (showtime);
  287.   showthing (lowercase);
  288.   showemulation;
  289.   showthing (fseditor);
  290.   showdisplaylen;
  291.   if ansigraphics in urec.config then begin
  292.     showcolor ('Prompt',urec.promptcolor);
  293.     showcolor ('Input',urec.inputcolor);
  294.     showcolor ('Regular',urec.regularcolor);
  295.     showcolor ('Statistic',urec.statcolor)
  296.   end
  297. end;
  298.  
  299. VAR q:integer;
  300. begin
  301.   repeat
  302.     if (not (lowercase in urec.config)) and (ansigraphics in urec.config)
  303.       then begin
  304.         urec.config:=urec.config+[lowercase];
  305.         writestr ('You may not use ANSI in uppercase-only mode.')
  306.       end;
  307.     if (fseditor in urec.config) and
  308.        (urec.config=urec.config-[ansigraphics,vt52])
  309.       then begin
  310.         urec.config := urec.config - [fseditor];
  311.         writestr ('You may not use the full-screen editor without ANSI or VT52 emulation.')
  312.       end;
  313.     q:=menu ('Configuration','CONFIG','QLWOMGTUEDPIRSNYFC');
  314.     case q of
  315.       2  : getthing (linefeeds);
  316.       3  : getthing (eightycols);
  317.       4  : getthing (postprompts);
  318.       5  : getthing (moreprompts);
  319.       6  : getthing (asciigraphics);
  320.       7  : getthing (showtime);
  321.       8  : getthing (lowercase);
  322.       9  : emulation;
  323.       10 : getdisplaylen;
  324.       11 : getcolor ('prompt',urec.promptcolor);
  325.       12 : getcolor ('input',urec.inputcolor);
  326.       13 : getcolor ('regular',urec.regularcolor);
  327.       14 : getcolor ('statistic',urec.statcolor);
  328.       15 : configurenewscan;
  329.       16 : yourstatus;
  330.       17 : Define_Editor;
  331.       18 : GetThing(ExtClrScr);
  332.     end;
  333.     writeurec
  334.   until (q=1) or hungupon
  335. end;
  336.  
  337. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  338.  
  339. {initialization}
  340.  
  341. {/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}
  342.  
  343. begin
  344. end.
  345.