home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 189.img / TCS120S.ZIP / CONFIG.PAS < prev    next >
Pascal/Delphi Source File  |  1989-04-04  |  23KB  |  1,040 lines
  1. program config;
  2.  
  3. {$R-,S+,I-,D+,F-,V-,B-,N-,L+ }
  4. {$M 16384,5000,5000 }
  5.  
  6. uses crt,
  7.      scrnunit,scrninpt,general,prompts,
  8.      gentypes,configrt;
  9.  
  10. const normalcolor=3;
  11.       boldcolor=9;
  12.       barcolor=$1f;
  13.       inputcolor=11;
  14.       choicecolor=15;
  15.       datacolor=15;
  16.  
  17. var prompt:promptset;
  18.  
  19. procedure writeconfig;
  20. var q:file of configsettype;
  21. begin
  22.   assign (q,'TCS.CFG');
  23.   rewrite (q);
  24.   write (q,configset);
  25.   close (q)
  26. end;
  27.  
  28. procedure formatconfig;
  29. var cnt:integer;
  30. begin
  31.   versioncode:=thisversioncode;
  32.   longname:='Beta Cygnus';
  33.   shortname:='Beta Cyg';
  34.   sysopname:='Mastermind';
  35.   getdir (0,forumdir);
  36.   if forumdir[length(forumdir)]<>'\' then forumdir:=forumdir+'\';
  37.   textdir:=forumdir+'MSGS\';
  38.   uploaddir:=forumdir+'GFILES\';
  39.   boarddir:=forumdir+'BOARD\';
  40.   asciidownload:='Courtesy of -Beta Cygnus- 450+ G-Files!';
  41.   textfiledir:=forumdir+'MENUS\';
  42.   doordir:=forumdir;
  43.   modemsetupstr:='ATM0S0=1|';
  44.   modemhangupstr:='+++~~~ATH|';
  45.   modemdialprefix:='ATDT';
  46.   modemdialsuffix:='|';
  47.   defbaudrate:=2400;
  48.   usecom:=1;
  49.   hashayes:=false;
  50.   anonymouslevel:=40;
  51.   numwelcomes:=1;
  52.   mintimeout:=5;
  53.   sysoplevel:=100;
  54.   defudlevel:=0;
  55.   defudpoints:=0;
  56.   normbotcolor:=3;
  57.   normtopcolor:=9;
  58.   outlockcolor:=11;
  59.   splitcolor:=10;
  60.   statlinecolor:=3;
  61.   uploadfactor:=3;
  62.   private:=false;
  63.   autologin:=false;
  64.   useconmode:=true;
  65.   escinmsgs:=false;
  66.   bkspinmsgs:=true;
  67.   requireforms:=true;
  68.   dotchar:='/';
  69.   supportedrates:=[b1200]+[b2400];
  70.   downloadrates:=supportedrates;
  71.   availtime:='4:00 pm';
  72.   unavailtime:='9:00 pm';
  73.   xmodemopentime:='3:00 am';
  74.   xmodemclosetime:='3:00 am';
  75.   for cnt:=1 to 100 do usertime[cnt]:=cnt*2;
  76.   level2nd:=10;
  77.   udlevel2nd:=10;
  78.   udpoints2nd:=0;
  79.   postlevel:=10;
  80.   anonymousstr:='< Anonymous >';
  81.   usematrix:=true;
  82.   matrixtype:=1;
  83.   newusermatrix:=true;
  84.   systempassword:='TCS';
  85.   remotedoors:=false;
  86.   allowdoors:=false;
  87.   eventtime[0]:=#0;
  88.   eventbatch[0]:=#0;
  89.   directvideomode:=true;
  90.   checksnowmode:=true;
  91.   hangnewusers:=true;
  92.   msgnextlvl:=10;
  93.   appear:='Mastermind is here.';
  94.   disappear:='Mastermind is gone!';
  95.   telenumber:='602/234-3376';
  96.   allowloan:=false;
  97.   lvltoloan:=40;
  98.   maxloan:=5;
  99.   maxdebt:=-5;
  100.   timerestlvl:=60;
  101.   timereststart[0]:=#0;
  102.   timerestend[0]:=#0;
  103.   dszlog:='C:\DSZ.LOG';
  104.   sklog:='C:\SUPERK.LOG';
  105.   newusernote:='New User';
  106.   system2password[0]:=#0;
  107.   system3password[0]:=#0;
  108.   availstr:='Mastermind is available for chat!';
  109.   notavailstr:='Mastermind is not available for chat.';
  110.   useqr:=true;
  111.   qrlimit:=-25;
  112.   qrmultifactor:=5;
  113.   qrexempt:=60;
  114.   usecliche:=true;
  115.   cliche:='Beta Cygnus - FiRM / TCS';
  116.   ulpercent:=50;
  117.   checkautologin:=true;
  118.   usetrivia:=true;
  119.   readanonlvl:=50;
  120.   listuserlvl:=40;
  121.   ems:=false;
  122.   datascrambling:=false;
  123.   pcrexempt:=60;
  124.   xferpcr:=20;
  125.   gfpcr:=20;
  126.   doorpcr:=15;
  127.   mnplevel:=0;
  128.   matrixfback:=true;
  129.   matrixreqchat:=true;
  130.   leechzmodem:=true;
  131.   commandcom:='C:\DOS\COMMAND.COM';
  132.   editor:='C:\Q.EXE';
  133.   userumor:=true;
  134.   filepw:=true;
  135.   {}{}{}
  136.   zmodemr:='dsz.com port %1 speed %2 rz %3';
  137.   zmodems:='dsz.com port %1 speed %2 sz -s %3';
  138.   jmodemr:='jmodem.com R%1 %3';
  139.   jmodems:='jmodem.com S%1 %3';
  140.   lynxr:='lynx.exe R /%1 /%2 %3';
  141.   lynxs:='lynx.exe S /%1 /%2 %3';
  142.   xovrr:='dsz.com port %1 speed %2 ro %3';
  143.   xovrs:='dsz.com port %1 speed %2 so %3';
  144.   yovrr:='dsz.com port %1 speed %2 rb -o %3';
  145.   yovrs:='dsz.com port %1 speed %2 sb -o %3';
  146.   ymodemgr:='dsz.com port %1 speed %2 rb -g %3';
  147.   ymodemgs:='dsz.com port %1 speed %2 sb -g %3';
  148.   superkr:='superk.com p%1 s%2 rs f %3';
  149.   superks:='superk.com p%1 s%2 ss f %3';
  150.   k9xr:='superk.com p%1 s%2 rk f %3';
  151.   k9xs:='superk.com p%1 s%2 sk f %3';
  152.   zcrashr:='dsz.com port %1 speed %2 rz -r %3';
  153.   zcrashs:='dsz.com port %1 speed %2 sz -r %3';
  154.   zpcpr:='dsz.com port %1 speed %2 rz -w %3';
  155.   zpcps:='dsz.com port %1 speed %2 sz -w %3';
  156.   wxmodemr:='superk.com p%1 s%2 rw f %3';
  157.   wxmodems:='superk.com p%1 s%2 sw f %3';
  158.   zrles:='dsz.com port %1 speed %2 sz -Z %3';
  159.   lynxcrashr:='lynx.exe R /%1 /%2 /R %3';
  160.   {}{}{}
  161.   writeconfig
  162. end;
  163.  
  164. type ttypetype=(TInteger,Tsstr,Tmstr,Tlstr,TBoolean,TChar,TBaudset,
  165.                 TPath,TTime,TAttrib,Tusertime,Badtype);
  166.      ptrset=record
  167.        case integer of
  168.          0:(i:^integer);
  169.          1:(l:^lstr);
  170.          2:(b:^boolean);
  171.          3:(k:^char);
  172.          4:(baudsetptr:^baudset)
  173.      end;
  174.      thing=record
  175.        text:mstr;
  176.        descrip:lstr;
  177.        ttype:ttypetype;
  178.        p:pointer;
  179.        r1,r2:integer
  180.      end;
  181.  
  182. const ttypestr:array [ttypetype] of sstr=
  183.   ('Int','sstr','mstr','lstr','Boo','Char','Baud','Path','Time',
  184.    'Attrib','Usertime','!!!!????');
  185.       colorstr:array [0..15] of mstr=
  186.   ('Black','Blue ','Green ','Cyan ','Red ','Magenta ','Brown ','White ',
  187.    'Gray ','BLUE!','GREEN!','CYAN!','RED!','MAGENTA!','YELLOW!','WHITE!');
  188.  
  189. const maxthings=200;
  190.       dcol=30;
  191.  
  192. var top,bot,page,numpages,numthings:integer;
  193.     things:array [1..maxthings] of thing;
  194.  
  195. procedure cb;
  196. begin
  197.   setcolor (boldcolor)
  198. end;
  199.  
  200. procedure c4;
  201. begin
  202.   setcolor (4)
  203. end;
  204.  
  205. procedure cn;
  206. begin
  207.   setcolor (normalcolor)
  208. end;
  209.  
  210. procedure c7;
  211. begin
  212.   setcolor (7)
  213. end;
  214.  
  215. procedure cs;
  216. begin
  217.  setcolor (boldcolor);
  218. end;
  219.  
  220. procedure cd;
  221. begin
  222.  setcolor (normalcolor);
  223. end;
  224.  
  225. function match(a1,a2:anystr):boolean;
  226. var cnt:integer;
  227. begin
  228.   match:=false;
  229.   while a1[length(a1)]=' ' do a1[0]:=pred(a1[0]);
  230.   while a2[length(a2)]=' ' do a2[0]:=pred(a2[0]);
  231.   if length(a1)<>length(a2) then exit;
  232.   for cnt:=1 to length(a1) do
  233.     if upcase(a1[cnt])<>upcase(a2[cnt]) then exit;
  234.   match:=true
  235. end;
  236.  
  237. function yesnostr (var b:boolean):sstr;
  238. begin
  239.   if b and (ord(b)<>ord(true)) then b:=true;
  240.   if b then yesnostr:='Yes' else yesnostr:='No'
  241. end;
  242.  
  243. function strr (n:integer):mstr;
  244. var q:mstr;
  245. begin
  246.   str (n,q);
  247.   strr:=q
  248. end;
  249.  
  250. function valu (q:mstr):integer;
  251. var i,s:integer;
  252. begin
  253.   val (q,i,s);
  254.   if s=1
  255.     then valu:=0
  256.     else valu:=i
  257. end;
  258.  
  259. function whichpage (n:integer):integer;
  260. begin
  261.   whichpage:=((n-1) div 20)+1
  262. end;
  263.  
  264. function whichline (n:integer):integer;
  265. begin
  266.   whichline:=n-20*(whichpage(n)-1)+2
  267. end;
  268.  
  269. function getbaudstr (var q:baudset):lstr;
  270. var w:lstr;
  271.     cnt:baudratetype;
  272. begin
  273.   w[0]:=chr(0);
  274.   for cnt:=firstbaud to lastbaud do
  275.     if cnt in q then w:=w+strr(baudarray[cnt])+' ';
  276.   if length(w)=0 then w:='None';
  277.   getbaudstr:=w
  278. end;
  279.  
  280. function varstr (n:integer):string;
  281. var pu:pointer;
  282.     p:ptrset absolute pu;
  283. begin
  284.   pu:=things[n].p;
  285.   case things[n].ttype of
  286.     tinteger:varstr:=strr(p.i^);
  287.     tlstr,tmstr,tsstr,tpath,ttime:varstr:=p.l^;
  288.     tboolean:varstr:=yesnostr(p.b^);
  289.     tchar:varstr:=p.k^;
  290.     tbaudset:varstr:=getbaudstr (p.baudsetptr^);
  291.     tattrib:varstr:=colorstr[p.i^];
  292.     tusertime:varstr:='(Choose this choice to configure user daily time)';
  293.     else varstr:='??!?!?!'
  294.   end
  295. end;
  296.  
  297. procedure writevar (n:integer);
  298. begin
  299.   cb;
  300.   write (varstr(n));
  301.   cn; clreol;
  302.   writeln
  303. end;
  304.  
  305. procedure gotopage (p:integer);
  306. var cnt,cy:integer;
  307. begin
  308.   if p<1 then p:=1;
  309.   if p>numpages then p:=numpages;
  310.   if p<>page then begin
  311.     if page<>0 then freeprompts (prompt);
  312.     page:=p;
  313.     gotoxy (1,1);
  314.     cn; write ('TCS BBS v');
  315.     cn; write (ver);
  316.     cn; write (' Configuration - ');
  317.     cn; write ('Page ');
  318.     cb; write (page);
  319.     cn; write (' of ');
  320.     cb; write (numpages);
  321.     cn; writeln (':  ');
  322.     writeln;
  323.     top:=(page-1)*20+1;
  324.     bot:=top+19;
  325.     if bot>numthings then bot:=numthings;
  326.     beginprompts (prompt);
  327.     for cnt:=top to top+19 do begin
  328.       cy:=cnt-top+3;
  329.       gotoxy (1,cy);
  330.       cn; clreol;
  331.       if cnt<=bot then begin
  332.         addprompt (prompt,command,prompt,5,cnt-top+3,things[cnt].text+':');
  333.         setinputwid (prompt,0);
  334.         drawprompt (prompt);
  335.         gotoxy (1,cy);
  336.         cn; write (cnt:2,'. ');
  337.         gotoxy (dcol,wherey);
  338.         writevar (cnt)
  339.       end
  340.     end
  341.   end
  342. end;
  343.  
  344. procedure readdata;
  345. var q:text;
  346.     t:mstr;
  347.  
  348.   procedure dataerror (n:lstr);
  349.   begin
  350.     writeln ('Record ',numthings,': '+n);
  351.     halt
  352.   end;
  353.  
  354.   procedure illtype;
  355.   begin
  356.     dataerror ('Invalid type: '+t)
  357.   end;
  358.  
  359.   procedure getrange (t:mstr; var r1,r2:integer);
  360.   var sp,da,n1,n2:integer;
  361.   begin
  362.     sp:=pos(' ',t);
  363.     r1:=-32767;
  364.     r2:=32767;
  365.     if sp=0 then exit;
  366.     t:=copy(t,sp+1,255);
  367.     if length(t)<1 then exit;
  368.     da:=pos('-',t);
  369.     if (da=1) and (length(t)=1) then exit;
  370.     if da=0 then begin
  371.       r1:=valu(t);
  372.       r2:=r1;
  373.       exit
  374.     end;
  375.     n1:=valu(copy(t,1,da-1));
  376.     n2:=valu(copy(t,da+1,255));
  377.     if da=1 then begin
  378.       r2:=n2;
  379.       exit
  380.     end;
  381.     r1:=n1;
  382.     if da=length(t) then exit;
  383.     r2:=n2
  384.   end;
  385.  
  386.   procedure gettype (t:mstr; var tt:ttypetype);
  387.   var sp:integer;
  388.       fw:mstr;
  389.   begin
  390.     tt:=ttypetype(0);
  391.     sp:=pos(' ',t);
  392.     if sp=0
  393.       then fw:=t
  394.       else fw:=copy(t,1,sp-1);
  395.     while tt<>badtype do
  396.       begin
  397.         if match(fw,ttypestr[tt]) then exit;
  398.         tt:=succ(tt)
  399.       end;
  400.     tt:=badtype;
  401.     illtype
  402.   end;
  403.  
  404. begin
  405.   assign (q,'Config.Dat');
  406.   reset (q);
  407.   numthings:=0;
  408.   if ioresult<>0 then dataerror ('File CONFIG.DAT not found!');
  409.   while not eof(q) do begin
  410.     numthings:=numthings+1;
  411.     with things[numthings] do begin
  412.       readln (q,text);
  413.       readln (q,descrip);
  414.       readln (q,t);
  415.       gettype (t,ttype);
  416.       if ttype=tinteger then getrange (t,r1,r2)
  417.     end
  418.   end;
  419.   close (q)
  420. end;
  421.  
  422. procedure assignptrs;
  423. var cnt:integer;
  424.  
  425.   procedure s (var q);
  426.   begin
  427.     cnt:=cnt+1;
  428.     things[cnt].p:=@q
  429.   end;
  430.  
  431. begin
  432.   cnt:=0;
  433.   s (longname);
  434.   s (shortname);
  435.   s (sysopname);
  436.   s (autologin);
  437.   s (forumdir);
  438.   s (textdir);
  439.   s (boarddir);
  440.   s (uploaddir);
  441.   s (textfiledir);
  442.   s (doordir);
  443.   s (supportedrates);
  444.   s (downloadrates);
  445.   s (defbaudrate);
  446.   s (usecom);
  447.   s (hashayes);
  448.   s (modemsetupstr);
  449.   s (modemhangupstr);
  450.   s (modemdialprefix);
  451.   s (modemdialsuffix);
  452.   s (sysoplevel);
  453.   s (anonymouslevel);
  454.   s (numwelcomes);
  455.   s (private);
  456.   s (directvideomode);
  457.   s (checksnowmode);
  458.   s (useconmode);
  459.   s (escinmsgs);
  460.   s (bkspinmsgs);
  461.   s (normbotcolor);
  462.   s (normtopcolor);
  463.   s (outlockcolor);
  464.   s (splitcolor);
  465.   s (statlinecolor);
  466.   s (usertime);
  467.   s (mintimeout);
  468.   s (dotchar);
  469.   s (asciidownload);
  470.   s (defudlevel);
  471.   s (defudpoints);
  472.   s (level2nd);
  473.   s (udlevel2nd);
  474.   s (udpoints2nd);
  475.   s (postlevel);
  476.   s (uploadfactor);
  477.   s (availtime);
  478.   s (unavailtime);
  479.   s (xmodemopentime);
  480.   s (xmodemclosetime);
  481.   s (usematrix);
  482.   s (matrixtype);
  483.   s (newusermatrix);
  484.   s (systempassword);
  485.   s (system2password);
  486.   s (system3password);
  487.   s (anonymousstr);
  488.   s (requireforms);
  489.   s (remotedoors);
  490.   s (allowdoors);
  491.   s (eventtime);
  492.   s (eventbatch);
  493.   s (hangnewusers);
  494.   s (msgnextlvl);
  495.   s (appear);
  496.   s (disappear);
  497.   s (telenumber);
  498.   s (allowloan);
  499.   s (lvltoloan);
  500.   s (maxloan);
  501.   s (maxdebt);
  502.   s (timerestlvl);
  503.   s (timereststart);
  504.   s (timerestend);
  505.   s (dszlog);
  506.   s (sklog);
  507.   s (newusernote);
  508.   s (availstr);
  509.   s (notavailstr);
  510.   s (useqr);
  511.   s (qrmultifactor);
  512.   s (qrlimit);
  513.   s (qrexempt);
  514.   s (usecliche);
  515.   s (cliche);
  516.   s (usetrivia);
  517.   s (ulpercent);
  518.   s (checkautologin);
  519.   s (readanonlvl);
  520.   s (listuserlvl);
  521.   s (ems);
  522.   s (mnplevel);
  523.   s (pcrexempt);
  524.   s (xferpcr);
  525.   s (gfpcr);
  526.   s (doorpcr);
  527.   s (datascrambling);
  528.   s (matrixfback);
  529.   s (matrixreqchat);
  530.   s (leechzmodem);
  531.   s (commandcom);
  532.   s (editor);
  533.   s (userumor);
  534.   s (filepw);
  535.   {}{}{}
  536.   s (zmodemr);
  537.   s (zmodems);
  538.   s (jmodemr);
  539.   s (jmodems);
  540.   s (lynxr);
  541.   s (lynxs);
  542.   s (xovrr);
  543.   s (xovrs);
  544.   s (yovrr);
  545.   s (yovrs);
  546.   s (ymodemgr);
  547.   s (ymodemgs);
  548.   s (superkr);
  549.   s (superks);
  550.   s (k9xr);
  551.   s (k9xs);
  552.   s (zcrashr);
  553.   s (zcrashs);
  554.   s (zpcpr);
  555.   s (zpcps);
  556.   s (wxmodemr);
  557.   s (wxmodems);
  558.   s (zrles);
  559.   s (lynxcrashr);
  560.   {}{}{}
  561.   if cnt<>numthings then begin
  562.     writeln ('Error in number of items of CONFIG.DAT');
  563.     writeln ('Expected: ',numthings);
  564.     writeln ('Actual:   ',cnt);
  565.     halt
  566.   end
  567. end;
  568.  
  569. procedure byebye;
  570. begin
  571.   clearwindow (normalcolor);
  572.   gotoxy (38,24);
  573.   cb; writeln ('Bye!');
  574.   halt
  575. end;
  576.  
  577. procedure abortyn;
  578. var q:sstr;
  579. begin
  580.   gotoxy (1,24);
  581.   setcolor (datacolor);
  582.   write ('Confirm abort [y/n]: ');
  583.   cn;
  584.   clreol;
  585.   buflen:=1;
  586.   readln (q);
  587.   if length(q)>0 then if upcase(q[1])='Y' then byebye
  588. end;
  589.  
  590. procedure getinput (n:integer; editit:boolean);
  591. var y:integer;
  592.     inp:lstr;
  593.     t:thing;
  594.     pu:pointer;
  595.     p:ptrset absolute pu;
  596.  
  597.   procedure reshow;
  598.   begin
  599.     gotoxy (dcol,y);
  600.     writevar (n)
  601.   end;
  602.  
  603.   procedure showintrange;
  604.   begin
  605.     setcolor (datacolor); {c7}
  606.     with t do
  607.       if r1=-32767
  608.         then if r2=32767
  609.           then write ('No range limitation.')
  610.           else write ('Maximum value: ',r2)
  611.         else if r2=32767
  612.           then write ('Minimum value: ',r1)
  613.           else write ('Valid values range from ',r1,' to ',r2);
  614.     cn
  615.   end;
  616.  
  617.   procedure doint;
  618.   var n,s:integer;
  619.       k:char;
  620.   begin
  621.     val (inp,n,s);
  622.     gotoxy (1,24);
  623.     if s<>0
  624.       then
  625.         begin
  626.           setcolor (datacolor);
  627.           writeln ('Invalid number!  A number must be from -32767 to 32767.');
  628.           cn;
  629.           write ('Press any key...');
  630.           clreol;
  631.           k:=bioskey
  632.         end
  633.       else if (n>=t.r1) and (n<=t.r2)
  634.         then p.i^:=n
  635.         else
  636.           begin
  637.             setcolor (datacolor);
  638.             writeln ('Range error!  Must be within the above limits!  ');
  639.             cn;
  640.             write ('Press any key...');
  641.             clreol;
  642.             k:=bioskey
  643.           end
  644.   end;
  645.  
  646.   procedure dostr;
  647.   begin
  648.     if (inp='N') or (inp='n') then inp:='';
  649.     p.l^:=inp
  650.   end;
  651.  
  652.   procedure doboolean;
  653.   begin
  654.     case upcase(inp[1]) of
  655.       'Y':p.b^:=true;
  656.       'N':p.b^:=false
  657.     end
  658.   end;
  659.  
  660.   procedure dochar;
  661.   begin
  662.     p.k^:=inp[1]
  663.   end;
  664.  
  665.   procedure dopath;
  666.   var lc:char;
  667.       cur:lstr;
  668.       n:integer;
  669.   begin
  670.     lc:=inp[length(inp)];
  671.     if (length(inp)<>1) or (upcase(lc)<>'N')
  672.       then if (lc<>':') and (lc<>'\') then inp:=inp+'\';
  673.     dostr;
  674.     if inp[length(inp)]='\' then inp[0]:=pred(inp[0]);
  675.     getdir (0,cur);
  676.     chdir (inp);
  677.     n:=ioresult;
  678.     chdir (cur);
  679.     if n=0 then exit;
  680.     setcolor (datacolor);
  681.     gotoxy (1,24);
  682.     write ('Path doesn''t exist!  ');
  683.     cn; write ('Create it now? '); clreol;
  684.     readln (cur);
  685.     if length(cur)=0 then exit;
  686.     if upcase(cur[1])<>'Y' then exit;
  687.     mkdir (inp);
  688.     if ioresult=0 then exit;
  689.     gotoxy (1,24);
  690.     setcolor (datacolor);
  691.     write ('Error creating directory!  ');
  692.     cn; write ('Press any key...');
  693.     clreol;
  694.     lc:=bioskey
  695.   end;
  696.  
  697.   procedure dotime;
  698.   var c,s,l:integer;
  699.       d1,d2,d3,d4:char;
  700.       ap,m:char;
  701.  
  702.     function digit (k:char):boolean;
  703.     begin
  704.       digit:=ord(k) in [48..57]
  705.     end;
  706.  
  707.   begin
  708.     l:=length(inp);
  709.     if l=1 then begin
  710.       if upcase(inp[1])='N' then dostr;
  711.       exit
  712.     end;
  713.     if (l<7) or (l>8) then exit;
  714.     c:=pos(':',inp);
  715.     if c<>l-5 then exit;
  716.     s:=pos(' ',inp);
  717.     if s<>l-2 then exit;
  718.     d2:=inp[c-1];
  719.     if l=7
  720.       then d1:='0'
  721.       else d1:=inp[1];
  722.     d3:=inp[c+1];
  723.     d4:=inp[c+2];
  724.     ap:=upcase(inp[s+1]);
  725.     m:=upcase(inp[s+2]);
  726.     if d1='1' then if d2>'2' then d2:='!';
  727.     if (d1>='0') and (d1<='1') and digit(d2) and (d3>='0') and (d3<='5')
  728.        and digit(d4) and ((ap='A') or (ap='P')) and (m='M') then dostr
  729.   end;
  730.  
  731.   procedure dobaud;
  732.   var inp:lstr;
  733.       n:integer;
  734.       cnt:baudratetype;
  735.   label bfound,again;
  736.   begin
  737.     gotoxy (1,24);
  738.     repeat
  739.       gotoxy (wherex,24);
  740.       write ('Baud Rate to toggle [CR/Quit]: ');
  741.       clreol;
  742.       buflen:=4;
  743.       readln (inp);
  744.       gotoxy (1,24);
  745.       if length(inp)=0 then exit;
  746.       n:=valu(inp);
  747.       for cnt:=b110 to b9600 do if n=baudarray[cnt] then goto bfound;
  748.       cb; write ('Not supported!  '); cn;
  749.       goto again;
  750.       bfound:
  751.       if cnt in p.baudsetptr^
  752.         then p.baudsetptr^:=p.baudsetptr^-[cnt]
  753.         else p.baudsetptr^:=p.baudsetptr^+[cnt];
  754.       reshow;
  755.       again:
  756.     until 0=1
  757.   end;
  758.  
  759.   procedure dousertime;
  760.   var input:lstr;
  761.       n:integer;
  762.       buffer:array [1..4096] of byte;
  763.       b:block;
  764.  
  765.     procedure refresh;
  766.     var cnt:integer;
  767.     begin
  768.       clearwindow (normalcolor);
  769.       gotoxy (1,1);
  770.       cn;
  771.       writeln('Level Time │ Level Time │ Level Time │ Level Time │ Level Time');
  772.       writeln('───────────┴────────────┴────────────┴────────────┴───────────');
  773.       gotoxy (1,3);
  774.       for cnt:=1 to 100 do begin
  775.         write (cnt:4,': ',usertime[cnt]:4);
  776.         if (cnt mod 5)=0 then writeln else write (' │ ')
  777.       end
  778.     end;
  779.  
  780.     procedure setone (n,v:integer);
  781.     var x,y:integer;
  782.     begin
  783.       x:=((n-1) mod 5)*13+7;
  784.       y:=((n-1) div 5)+3;
  785.       gotoxy (x,y);
  786.       write (v:4);
  787.       usertime[n]:=v
  788.     end;
  789.  
  790.     procedure getone (n:integer);
  791.     var x,y,v:integer;
  792.     begin
  793.       x:=((n-1) mod 5)*13+7;
  794.       y:=((n-1) div 5)+3;
  795.       gotoxy (x,y);
  796.       write ('    ');
  797.       gotoxy (x,y);
  798.       buflen:=4;
  799.       readln (input);
  800.       v:=valu(input);
  801.       if (v<1) or (v>1000) then v:=usertime[n];
  802.       setone (n,v)
  803.     end;
  804.  
  805.     function getn (txt:lstr):integer;
  806.     var input:lstr;
  807.     begin
  808.       gotoxy (1,23);
  809.       write (txt,': ');
  810.       clreol;
  811.       buflen:=4;
  812.       readln (input);
  813.       getn:=valu(input)
  814.     end;
  815.  
  816.     function getlvl (txt:lstr):integer;
  817.     var n:integer;
  818.     begin
  819.       n:=getn (txt);
  820.       if (n<1) or (n>100) then n:=0;
  821.       getlvl:=n
  822.     end;
  823.  
  824.     procedure pattern;
  825.     var st,en,ba,se,cn:integer;
  826.     begin
  827.       st:=getlvl ('Starting level of pattern');
  828.       if st=0 then exit;
  829.       en:=getlvl ('Ending level of pattern');
  830.       if en<st then exit;
  831.       ba:=getn ('Time for level '+strr(st));
  832.       if (ba<1) or (ba>1000) then exit;
  833.       se:=getn ('Additional time per level');
  834.       if (se<0) or (se>1000) then exit;
  835.       cn:=st;
  836.       repeat
  837.         setone (cn,ba);
  838.         if ba+se<1000
  839.           then ba:=ba+se
  840.           else ba:=1000;
  841.         cn:=cn+1
  842.       until cn>en
  843.     end;
  844.  
  845.   var k:char;
  846.   begin
  847.     setblock (b,1,1,80,25);
  848.     readblock (b,buffer);
  849.     refresh;
  850.     repeat
  851.       repeat
  852.         gotoxy (1,24);
  853.         write ('Number to change, [P]attern, or [Q]uit: ');
  854.         clreol;
  855.         readln (input)
  856.       until length(input)>0;
  857.       k:=upcase(input[1]);
  858.       n:=valu(input);
  859.       if (n>=1) and (n<=100) then getone(n) else
  860.         case k of
  861.           'P':pattern
  862.         end
  863.     until k='Q';
  864.     writeblock (b,buffer)
  865.   end;
  866.  
  867.   procedure showattribhelp;
  868.   var cnt:integer;
  869.  
  870.     procedure demo;
  871.     begin
  872.       setcolor (cnt);
  873.       write (cnt:2,')',colorstr[cnt],' ')
  874.     end;
  875.  
  876.   begin
  877.     gotoxy (1,23);
  878.     for cnt:=0 to 7 do demo;
  879.     gotoxy (1,24);
  880.     for cnt:=8 to 15 do demo;
  881.     cn
  882.   end;
  883.  
  884.   procedure doattrib;
  885.   var cnt,v:integer;
  886.       k:char;
  887.   begin
  888.     v:=valu(inp);
  889.     if ((v=0) and (inp[1]<>'0')) or (v<0) or (v>15) then begin
  890.       v:=-1;
  891.       for cnt:=0 to 15 do if match (inp,colorstr[cnt]) then v:=cnt;
  892.       if v=-1 then exit
  893.     end;
  894.     p.i^:=v
  895.   end;
  896.  
  897. begin
  898.   t:=things[n];
  899.   pu:=t.p;
  900.   gotopage (whichpage(n));
  901.   y:=whichline(n);
  902.   if not (t.ttype in [tbaudset,tusertime]) then begin
  903.     gotoxy (1,23);
  904.     clreol;
  905.     writeln;
  906.     clreol;
  907.     writeln;
  908.     write (t.descrip);
  909.     clreol;
  910.     gotoxy (1,24);
  911.     case t.ttype of
  912.       tinteger:
  913.         begin
  914.           buflen:=6;
  915.           showintrange
  916.         end;
  917.       tsstr,ttime:buflen:=15;
  918.       tmstr:buflen:=30;
  919.       tlstr,tpath:buflen:=80;
  920.       tboolean,tchar:buflen:=1;
  921.       tattrib:showattribhelp
  922.     end;
  923.     if buflen+dcol>79 then buflen:=79-dcol;
  924.     gotoxy (dcol,y);
  925.     clreol;
  926.     if editit then setdefaultinput (varstr(n));
  927.     readln (inp)
  928.   end else inp[0]:=^A;
  929.   if length(inp)<>0 then
  930.     case t.ttype of
  931.       tinteger:doint;
  932.       tsstr,tmstr,tlstr:dostr;
  933.       tboolean:doboolean;
  934.       tchar:dochar;
  935.       tbaudset:dobaud;
  936.       tpath:dopath;
  937.       ttime:dotime;
  938.       tattrib:doattrib;
  939.       tusertime:dousertime
  940.     end;
  941.   reshow;
  942.   gotoxy (1,23);
  943.   clreol;
  944.   writeln;
  945.   clreol;
  946.   writeln;
  947.   clreol;
  948.   t.p:=pu;
  949.   things[n]:=t
  950. end;
  951.  
  952. procedure changenum (ns:integer; editit:boolean);
  953. var n:integer;
  954. begin
  955.   n:=ns+top-1;
  956.   if (n<1) or (n>numthings) then exit;
  957.   getinput (n,editit)
  958. end;
  959.  
  960. procedure maybemakeconfig;
  961. var f:file of configsettype;
  962.     s,w:integer;
  963. begin
  964.   s:=ofs(filler)-ofs(versioncode);
  965.   w:=sizeof(configsettype);
  966.   if s>w then begin
  967.     writeln;
  968.     writeln ('****** ERROR: CONFIGSETTYPE is too short!');
  969.     writeln ('              Size of configuration is: ',s);
  970.     writeln ('                   Bytes being written: ',w);
  971.     writeln;
  972.     halt
  973.   end;
  974.   assign (f,'TCS.CFG');
  975.   reset (f);
  976.   if ioresult=0 then begin
  977.     close (f);
  978.     exit
  979.   end;
  980.   fillchar (configset,sizeof(configset),0);
  981.   formatconfig
  982. end;
  983.  
  984. var command:sstr;
  985.     i:integer;
  986. begin
  987. { textmode (BW80); }
  988.   initscrnunit;
  989.   curwindowptr^.normalcolor:=normalcolor;
  990.   curwindowptr^.boldcolor:=boldcolor;
  991.   curwindowptr^.barcolor:=barcolor;
  992.   curwindowptr^.inputcolor:=inputcolor;
  993.   curwindowptr^.choicecolor:=choicecolor;
  994.   curwindowptr^.datacolor:=datacolor;
  995.   clrscr;
  996.   gotoxy (1,1);
  997.   writeln ('Loading...');
  998.   readdata;
  999.   assignptrs;
  1000.   maybemakeconfig;
  1001.   readconfig;
  1002.   i:=ioresult;
  1003.   numpages:=whichpage(numthings);
  1004.   page:=0;
  1005.   gotopage (1);
  1006.   repeat
  1007.     setfilter (checksnowmode);
  1008.     gotoxy (1,24);
  1009.     cd; write ('[');
  1010.     cs; write ('F1');
  1011.     cd; write (']:Edit Entry [');
  1012.     cs; write ('F10');
  1013.     cd; write (']:Save/Exit [');
  1014.     cs; write ('PgUp');
  1015.     cd; write (']:Last Page [');
  1016.     cs; write ('PgDn');
  1017.     cd; write (']:Next Page [');
  1018.     cs; write ('Esc');
  1019.     cd; write (']:Abort');
  1020.     i:=useprompts(prompt);
  1021.     if bioslook in [#32..#126]
  1022.       then changenum (i,false)
  1023.       else case bioskey of
  1024.         #187:begin
  1025.               gotoxy (1,1);
  1026.               write (i);
  1027.               changenum (i,true);
  1028.              end;
  1029.         #196:begin
  1030.               writeconfig;
  1031.               byebye
  1032.              end;
  1033.         #27:abortyn;
  1034.         #13:changenum (i,false);
  1035.         #201:gotopage (page-1);
  1036.         #209:gotopage (page+1)
  1037.       end
  1038.   until 0=1
  1039. end.
  1040.