home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / vi_si_on / configur.pas < prev    next >
Pascal/Delphi Source File  |  1991-03-31  |  18KB  |  577 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  2.  
  3. unit configur;
  4.  
  5. interface
  6.  
  7. uses windows,gentypes,userret,gensubs,subs1,subs2,flags;
  8.  
  9. procedure configure;
  10.  
  11. implementation
  12.  
  13. procedure configure;
  14.  
  15. const colorstr:array [0..7] of string[7]=
  16.         ('Black','Blue','Green','Cyan','Red','Magenta','Brown','White');
  17.  
  18. procedure options (c:configtype; var prompt,onstr,offstr:lstr);
  19.  
  20.   procedure ret (x1,x2,x3:lstr);
  21.   begin
  22.     prompt:=x1;
  23.     onstr:=x2;
  24.     offstr:=x3
  25.   end;
  26.  
  27. begin
  28.   case c of
  29.     linefeeds:ret('Require line feeds','Yes','No');
  30.     eightycols:ret('Screen width','80','40');
  31.     postprompts:ret('Post prompts during newscan','Yes','No');
  32.     moreprompts:ret('Pause every screen','Yes','No');
  33.     asciigraphics:ret('Use IBM graphics characters','Yes','No');
  34.     showtime:ret('Display time left at prompts','Yes','No');
  35.     lowercase:ret('Upper/lower case','Yes','No');
  36.     fseditor:ret('Use full-screen editor','Yes','No')
  37.   end
  38. end;
  39.  
  40. function getattrib (fg,bk:integer; hi,bl:boolean):byte;
  41. begin
  42.   getattrib:=fg+(byte(hi) shl 3)+(bk shl 4)+(byte(bl) shl 7)
  43. end;
  44.  
  45. procedure getcolorvar (attr:byte; var fg,bk:integer; var hi,bl:boolean);
  46. begin
  47.   fg:=attr and 7;
  48.   hi:=(attr and 8)=8;
  49.   bk:=(attr shr 4) and 7;
  50.   bl:=(attr and 128)=128
  51. end;
  52.  
  53. procedure getthing (c:configtype);
  54. var n:integer;
  55.     name,onstr,offstr:lstr;
  56. begin
  57.   options (c,name,onstr,offstr);
  58.   writehdr (name);
  59.   write ('Current setting: '^S);
  60.   if c in urec.config then write (onstr) else write (offstr);
  61.   writeln (^B^M^M'Would you like:');
  62.   writeln ('  1. ',onstr);
  63.   writeln ('  2. ',offstr);
  64.   writestr (^M'Your choice:');
  65.   n:=valu(input);
  66.   if (n>0) and (n<3) then begin
  67.     if n=2
  68.       then urec.config:=urec.config-[c]
  69.       else urec.config:=urec.config+[c];
  70.     writeurec
  71.   end
  72. end;
  73.  
  74. procedure writecolorstr (a:byte);
  75. var fg,bk:integer;
  76.     hi,bl:boolean;
  77. begin
  78.   getcolorvar (a,fg,bk,hi,bl);
  79.   ansicolor (a);
  80.   if bl then write ('Blinking ');
  81.   if hi then write ('Highlighted ');
  82.   write (colorstr[fg]);
  83.   if bk>0 then write (' on ',colorstr[bk]);
  84.   ansicolor(urec.regularcolor);
  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.   write ('Invalid color!  Valid colors are:'^M'Black, ');
  106.   for cnt:=1 to 5 do begin
  107.     ansicolor (cnt);
  108.     write (colorstr[cnt],', ');
  109.     end;
  110.     writeln;
  111.     for cnt:=6 to 7 do begin
  112.     ansicolor(cnt);
  113.     write(colorstr[cnt]);
  114.     if cnt=7
  115.       then writeln ('.');
  116.     if cnt=6
  117.       then write(', and ');
  118.   end;
  119.   writestr ('')
  120. end;
  121.  
  122. procedure getmacros;
  123. var n:integer;
  124. begin
  125.      writestr(^M^P'Which Macro to change [1-3]: *');
  126.      if input='' then exit;
  127.      n:=valu(input);
  128.      if (n<1) or (n>3) then writeln(^M'Invalid Range!');
  129.      writestr(^M'Enter new macro (Return=no change) : *');
  130.      if input='' then exit;
  131.      if (n=1) then urec.macro1:=input;
  132.      if (n=2) then urec.macro2:=input;
  133.      if (n=3) then urec.macro3:=input;
  134. end;
  135.  
  136. procedure getcolor (prompt:mstr; var a:byte);
  137.  
  138.   procedure getacolor (var q:integer; prompt:mstr);
  139.   var n:integer;
  140.   begin
  141.     repeat
  142.       writestr ('Enter new '+prompt+' color:');
  143.       if hungupon or (length(input)=0) then exit;
  144.       n:=colorval(input);
  145.       if n=-1
  146.         then badcolor
  147.         else q:=n
  148.     until n<>-1
  149.   end;
  150.  
  151. var fg,bk:integer;
  152.     hi,bl:boolean;
  153. begin
  154.   if not (ansigraphics in urec.config) then begin
  155.     writestr ('You must have ANSI emulation to see color.');
  156.     exit
  157.   end;
  158.   getcolorvar (a,fg,bk,hi,bl);
  159.   write ('Current ',prompt,' color: ');
  160.   writecolorstr (a);
  161.   writestr (^M^M);
  162.   getacolor (fg,'foreground');
  163.   getacolor (bk,'background');
  164.   writestr ('Highlight the characters? *');
  165.   hi:=yes;
  166.   writestr ('Should the characters blink? *');
  167.   bl:=yes;
  168.   a:=getattrib (fg,bk,hi,bl)
  169. end;
  170.  
  171. procedure emulation;
  172. begin
  173.   writeln (^B^M'Note:  ANSI is required for color.');
  174.   writeln (    '       ANSI is required for the full-screen editor.');
  175.   writeln;
  176.   writeln (^B'Please choose your terminal type.'^M^M,
  177.            '   1. ANSI Color'^M,
  178.            '   2. None'^M);
  179.   writestr ('Emulation type:');
  180.   if length(input)=0 then exit;
  181.   urec.config:=urec.config-[ansigraphics,vt52];
  182.   if valu(input)=1 then urec.config:=urec.config+[ansigraphics];
  183. end;
  184.  
  185. procedure getdisplaylen;
  186. var v:integer;
  187. begin
  188.   writeln ('Current display length is: '^S,urec.displaylen);
  189.   writestr (^M'Enter new display length:');
  190.   if length(input)=0 then exit;
  191.   v:=valu(input);
  192.   if (v<21) or (v>43)
  193.     then writeln ('Invalid!')
  194.     else urec.displaylen:=v
  195. end;
  196.  
  197. procedure configurenewscan;
  198. var bd:boardrec;
  199.     bn:integer;
  200.     ac:accesstype;
  201. begin
  202.   opentempbdfile;
  203.   seek (bdfile,0);
  204.   for bn:=0 to filesize(bdfile)-1 do begin
  205.     read (bdfile,bd);
  206.     if (bd.conference=0) or (urec.confset[bd.conference]>0) then
  207.     begin
  208.     ac:=getuseraccflag(urec,bn);
  209.     if (ac=letin) or ((ulvl>=bd.level) and (ac=bylevel)) then begin
  210.       writestr ('Newscan '+bd.boardname+' (now '+
  211.                 yesno(not (bn in urec.newscanconfig))+'):');
  212.       if length(input)<>0 then
  213.         if yes
  214.           then urec.newscanconfig:=urec.newscanconfig-[bn]
  215.          else urec.newscanconfig:=urec.newscanconfig+[bn];
  216.       end
  217.   end;
  218.   end;
  219.   closetempbdfile
  220. end;
  221.  
  222. procedure showit (s,v:lstr);
  223. begin
  224.   if break then exit;
  225.   write(^R);
  226. (*  tab (s+':',30); *)
  227.   writeln (^S,v)
  228. end;
  229.  
  230. procedure showthing (c:configtype);
  231. var n:integer;
  232.     name,onstr,offstr:lstr;
  233. begin
  234.   if break then exit;
  235.   write(^R);
  236.   options (c,name,onstr,offstr);
  237. (*  tab (name+':',30); *)
  238.   write (^S);
  239.   if c in urec.config
  240.     then write (^S,onstr)
  241.     else write (^S,offstr);
  242.   writeln
  243. end;
  244.  
  245. procedure showemulation;
  246. var q:lstr;
  247. begin
  248.   if ansigraphics in urec.config
  249.     then q:='ANSI'
  250.     else if vt52 in urec.config
  251.       then q:='VT52'
  252.       else q:='None';
  253.   showit ('',q)
  254. end;
  255.  
  256. procedure showdisplaylen;
  257. begin
  258.   showit ('',strr(urec.displaylen))
  259. end;
  260.  
  261. procedure showcolor (prompt:mstr; attr:byte);
  262. begin
  263.   write(^R);
  264.   if break then exit;
  265.   writecolorstr (attr);
  266.   write(^S);
  267. end;
  268.  
  269. Procedure GetMenuType;
  270. Var I:Integer;
  271. Begin
  272.   If Not (AnsiGraphics in Urec.Config) then Begin
  273.     WriteLn(^M^M'You NEED Ansi Graphics in order to choose Pull Down Menus.');
  274.     Exit;
  275.   End;
  276.   Writeln(^M^M^P'Pull Down Menus - In order to use pull down menus you MUST have Ansi Emulation');
  277.   WriteLn('Turned on.'^M^M);
  278.   WriteStr('Would you like to use Ansi Pull Down Menus? *');
  279.   If yes then Urec.Avatar:=1 else Urec.Avatar:=0;
  280. End;
  281.  
  282. procedure yourstatus;
  283. begin
  284.   clearscr;
  285.   if not (ansigraphics in urec.config) then begin
  286.   tab('',32);
  287.   WriteLn(^S'Your Configuration');
  288.   writeln;
  289.   showthing (linefeeds);
  290.   showthing (eightycols);
  291.   showthing (postprompts);
  292.   showthing (moreprompts);
  293.   showthing (asciigraphics);
  294.   showthing (showtime);
  295.   showthing (lowercase);
  296.   showemulation;
  297.   showthing (fseditor);
  298.   showdisplaylen;
  299.   tab('Macro 1:',30);
  300.   writeln(urec.macro1);
  301.   tab('Macro 2:',30);
  302.   writeln(urec.macro2);
  303.   tab('Macro 3:',30);
  304.   writeln(urec.macro3);
  305.   if ansigraphics in urec.config then begin
  306.     showcolor ('Prompt',urec.promptcolor);
  307.     showcolor ('Input',urec.inputcolor);
  308.     showcolor ('Regular',urec.regularcolor);
  309.     showcolor ('Statistic',urec.statcolor);
  310.     showcolor ('Menu Background',urec.menuback);
  311.     showcolor ('Menu Boarder',urec.menuboard);
  312.     showcolor ('Windows Boarder',urec.blowboard);
  313.     showcolor ('Windows Inside',urec.blowinside);
  314.     Tab('Menu Type:',30);
  315.     Case Urec.Avatar of
  316.       0:WriteLn('Normal Menus');
  317.       1:WriteLn('Pull Down Menus');
  318.     End;
  319.   end;
  320.   end
  321.   Else
  322.     Begin
  323.      ansicolor(urec.menuboard);
  324.      fuckup(1,29,22,3);
  325.      ansicolor(urec.menuback);
  326.      fuckxy(2,30,' Your Configuration ');
  327.      ansicolor(urec.statcolor);
  328.      BlowUp(4,1,39,12);
  329.      printxy(5,3,'');
  330.      showthing(linefeeds);
  331.      printxy(6,3,'');
  332.      showthing(eightycols);
  333.      printxy(7,3,'');
  334.      showthing(postprompts);
  335.      printxy(8,3,'');
  336.      showthing(moreprompts);
  337.      printxy(9,3,'');
  338.      showthing(asciigraphics);
  339.      printxy(10,3,'');
  340.      showthing(showtime);
  341.      printxy(11,3,'');
  342.      showthing(lowercase);
  343.      printxy(12,3,'');
  344.      showthing(fseditor);
  345.      printxy(13,3,'');
  346.      showemulation;
  347.      printxy(14,3,'');
  348.      showdisplaylen;
  349.          blowup(4,40,40,14);
  350.          PrintXy(16,49,'»» Color Configuration ««');
  351.          printxy(15,42,'');
  352.          ShowColor('Status Box',urec.statusboxcolor);
  353.          printxy(14,42,'');
  354.          showcolor('Windows Highlight',urec.menuhighlight);
  355.      printxy(13,42,'');
  356.      showcolor('Windows Inside',urec.blowinside);
  357.      printxy(12,42,'');
  358.      showcolor('Windows Border',urec.blowboard);
  359.      printxy(11,42,'');
  360.      showcolor('Menu Border',urec.menuboard);
  361.      printxy(10,42,'');
  362.      showcolor('Menu Back',urec.menuback);
  363.      printxy(9,42,'');
  364.      Showcolor('Statistic',urec.statcolor);
  365.      printxy(8,42,'');
  366.      showcolor('Regular',urec.regularcolor);
  367.      printxy(7,42,'');
  368.      showcolor('Input',urec.inputcolor);
  369.      printxy(6,42,'');
  370.      showcolor('Prompt',urec.promptcolor);
  371.      printxy(5,42,'');
  372.      Write(^R'Menu Type:');
  373.      If Urec.Avatar=1 then Write(^S'Pull Down Windows') else Write(^S'Normal Menus');
  374.          BlowUp(16,1,39,5);
  375.      PrintXy(17,3,'');
  376.      Write(^R'Macro 1:');
  377.      Printxy(18,3,'');
  378.      Write(^R'Macro 2:');
  379.      PrintXy(19,3,'');
  380.      Write(^R'Macro 3:');
  381.      PrintXy(19,11,'');
  382.      Write(^S,Urec.Macro3);
  383.      PrintXy(18,11,'');
  384.      Write(^S,Urec.Macro2);
  385.      printxy(17,11,'');
  386.      write(^S,Urec.Macro1);
  387.      PrintXy(21,1,'');
  388.     end;
  389. end;
  390.  
  391.  
  392.  
  393. Procedure ViSiON_UC;
  394. Var it:char;
  395.     leave:boolean;
  396.  
  397.     Procedure gox;
  398.     Begin
  399.     PrintXy(20,1,'');
  400.     End;
  401.  
  402.     Procedure Bust_A_Nut;
  403.     Begin
  404.       ClearScr;
  405. WriteLn(^O'╒═════════════════════════════════════════════════════════════════════════════╕');
  406. WriteLn(^O'│ '^A'Command'^P':                    '^A'ViSiON v0.82 Full Screen User Configuration     '^O'│');
  407. WriteLn(^O'│ ■'^U' Your Status '^O'■           ■ '^U'Your Colors '^O'■           ■ '^U'('^S'Q'^U')uit '^O'■              │');
  408. WriteLn(^O'│                                                                             │');
  409. WriteLn(^O'│ '^F'L'^R') Linefeeds       '^P':      '^F'1'^R') Regular  '^P':                                     '^O'│');
  410. WriteLn(^O'│ '^F'E'^R') 80 Columns      '^P':      '^F'2'^R') Status   '^P':                                     '^O'│');
  411. WriteLn(^O'│ '^F'N'^R') Prompt Newscan  '^P':      '^F'3'^R') Prompt   '^P':                                     '^O'│');
  412. WriteLn(^O'│ '^F'P'^R') Pause On Screen '^P':      '^F'4'^R') Input    '^P':                                     '^O'│');
  413. WriteLn(^O'│ '^F'G'^R') IBM Graphics    '^P':      '^F'5'^R') Regular 2'^P':                                     '^O'│');
  414. WriteLn(^O'│ '^F'T'^R') Time At Prompt  '^P':      '^F'6'^R') Status 2 '^P':                                     '^O'│');
  415. WriteLN(^O'│ '^F'C'^R') Lower Case      '^P':      '^F'7'^R') Prompt 2 '^P':                                     '^O'│');
  416. WriteLn(^O'│ '^F'F'^R') Full Screen Ed. '^P':      '^F'8'^R') Menu Back'^P':                                     '^O'│');
  417. WriteLn(^O'│ '^F'A'^R') Emulation       '^P':      '^F'9'^R') Menu Fore'^P':                                     '^O'│');
  418. WriteLn(^O'│ '^F'D'^R') Display Length  '^P':      '^F'!'^R') Menu 2   '^P':                                     '^O'│');
  419. WriteLn(^O'│ '^F'='^R') Prompt Type     '^P':      '^F'S'^R') Configure NewScan                              '^O'│');
  420. WriteLn(^O'│ '^F'-'^R') Config Prompt                                                            '^O'│');
  421. WriteLn(^O'│ '^F'M'^R') Macro 1 '^P':                                                                '^O'│');
  422. WriteLn(^O'│ '^F'M'^R') Macro 2 '^P':                                                                '^O'│');
  423. WriteLn(^O'│ '^F'M'^R') Macro 3 '^P':                                                                '^O'│');
  424. WriteLn(^O'╘═════════════════════════════════════════════════════════════════════════════╛');
  425.       PrintXy(5,23,''); showthing (linefeeds);
  426.       Printxy(6,23,''); showthing (eightycols);
  427.       Printxy(7,23,''); showthing (postprompts);
  428.       Printxy(8,23,''); showthing (moreprompts);
  429.       Printxy(9,23,''); showthing (asciigraphics);
  430.       Printxy(10,23,'');showthing (showtime);
  431.       Printxy(11,23,'');showthing (lowercase);
  432.       Printxy(12,23,'');showthing (fseditor);
  433.       Printxy(13,23,'');showemulation;
  434.       Printxy(14,23,'');showdisplaylen;
  435.       Printxy(15,23,strr(urec.prompttype));
  436.       Printxy(17,15,urec.macro1);
  437.       Printxy(18,15,urec.macro2);
  438.       Printxy(19,15,urec.macro3);
  439.       Printxy(5,43,''); showcolor('',urec.regularcolor);
  440.       Printxy(6,43,''); showcolor('',urec.statcolor);
  441.       Printxy(7,43,''); showcolor('',urec.promptcolor);
  442.       Printxy(8,43,''); showcolor('',urec.inputcolor);
  443.       Printxy(9,43,''); showcolor('',urec.statusboxcolor);
  444.       Printxy(10,43,''); showcolor('',urec.blowboard);
  445.       Printxy(11,43,''); showcolor('',urec.blowinside);
  446.       Printxy(12,43,''); showcolor('',urec.menuback);
  447.       Printxy(13,43,''); showcolor('',urec.menuboard);
  448.       Printxy(14,43,''); showcolor('',urec.menuhighlight);
  449.     End;
  450.  
  451.  
  452. Procedure Spoo_Man_Chew;
  453. Begin
  454. IT:=' ';
  455.   Repeat
  456.     Repeat
  457.       If hungupon then exit;
  458.       Until Charready or hungupon;
  459.     It:=ReadChar;
  460.     If Length(it)=0 then it:=' ';
  461.     It:=Upcase(It)
  462.     Until (Pos(It,'LENPGTCFADMS=123456789-!Q')>0) or hungupon;
  463.     If it='-' then Begin
  464.        gox; User_Prompt; End;
  465.     If It='L' then Begin
  466.        gox; getthing (lowercase); End;
  467.     If It='E' then Begin
  468.        gox; getthing (eightycols); End;
  469.     If It='N' then Begin
  470.        gox; getthing (postprompts); End;
  471.     If it='P' then Begin
  472.        gox; getthing (moreprompts); End;
  473.     If it='G' then Begin
  474.         gox; getthing (asciigraphics); End;
  475.     If it='T' then Begin
  476.         gox; getthing (showtime); End;
  477.     If it='C' then Begin
  478.         gox; getthing (lowercase); End;
  479.     If it='F' then Begin
  480.         gox; getthing (fseditor); End;
  481.     If it='A' then Begin
  482.         gox; emulation; Leave:=True; end;
  483.     If it='D' then Begin
  484.         gox; getdisplaylen; end;
  485.     If it='M' then Begin
  486.         gox; getmacros; end;
  487.     If it='1' then Begin
  488.         gox; getcolor ('Regular',urec.regularcolor); end;
  489.     If it='2' then Begin
  490.         gox; getcolor ('Status',urec.statcolor); end;
  491.     If it='3' then Begin
  492.         gox; getcolor ('Prompt',urec.promptcolor); end;
  493.     If it='4' then Begin
  494.         gox; getcolor ('Input',urec.inputcolor); end;
  495.     If it='5' then Begin
  496.         gox; getcolor ('Regular Color 2',urec.statusboxcolor); end;
  497.     If it='6' then Begin
  498.         gox; getcolor ('Status Color 2',urec.blowboard); end;
  499.     If it='7' then Begin
  500.         gox; getcolor ('Prompt Color 2',urec.blowinside); end;
  501.     If it='8' then Begin
  502.         gox; getcolor ('Menu Background',urec.menuback); End;
  503.     If it='9' then Begin
  504.         gox; getcolor ('Menu Border',urec.menuboard); end;
  505.     If it='!' then Begin
  506.         gox; getcolor ('Menu High-Lite',urec.menuhighlight); end;
  507.     If it='S' then Begin
  508.         gox; configurenewscan; end;
  509.     If it='=' then Begin
  510.         gox; getyaprompt; end;
  511.     If it='Q' Then LEAVE:=TRUE;
  512.   End;
  513.  
  514. Begin
  515.   Leave:=False;
  516.   Repeat
  517.     Bust_A_Nut;
  518.     goxy(12,2);
  519.     Spoo_Man_Chew;
  520.   Until Leave=True;
  521. End;
  522.  
  523. var q:integer;
  524. begin
  525.   If (ansigraphics in urec.config) then begin
  526.   ViSiON_UC;
  527.   Exit;
  528.   End Else
  529.   Begin
  530.   repeat
  531.     if (not (lowercase in urec.config)) and (ansigraphics in urec.config)
  532.       then begin
  533.         urec.config:=urec.config+[lowercase];
  534.         writestr ('You may not use ANSI in uppercase-only mode.')
  535.       end;
  536.     if (fseditor in urec.config) and
  537.        (urec.config=urec.config-[ansigraphics,vt52])
  538.       then begin
  539.         urec.config:=urec.config-[fseditor];
  540.         writestr ('You may not use the full-screen editor without ANSI or VT52 emulation.')
  541.       end;
  542.         q:=menu ('Configuration','CONFIG','QLWOMGTUEDPIRSNYFBCJKZAHV=');
  543.         case q of
  544.             2:getthing (linefeeds);
  545.             3:getthing (eightycols);
  546.             4:getthing (postprompts);
  547.             5:getthing (moreprompts);
  548.             6:getthing (asciigraphics);
  549.             7:getthing (showtime);
  550.             8:getthing (lowercase);
  551.             9:emulation;
  552.             10:getdisplaylen;
  553.             11:getcolor ('prompt',urec.promptcolor);
  554.             12:getcolor ('input',urec.inputcolor);
  555.             13:getcolor ('regular',urec.regularcolor);
  556.             14:getcolor ('statistic',urec.statcolor);
  557.             15:configurenewscan;
  558.             16:yourstatus;
  559.             17:getthing (fseditor);
  560.             18:getcolor ('Menu Boarder',urec.menuboard);
  561.             19:getcolor ('Menu Background',urec.menuback);
  562.             20:getcolor ('Windows Boarder',urec.blowboard);
  563.             21:getcolor ('Windows Inside',urec.blowinside);
  564.             22:getmacros;
  565.             23:GetMenuType;
  566.             24:getcolor('Menu Highlight',urec.menuhighlight);
  567.             25:getcolor('Status Box Color',urec.statusboxcolor);
  568.                         26:getyaprompt;
  569.         end;
  570.         writeurec
  571.   until (q=1) or hungupon
  572. end;
  573. end;
  574.  
  575. begin
  576. end.
  577.