home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 153.img / TELES.ZIP / MENUEDT.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-14  |  10KB  |  429 lines
  1. {$R-}    {Range checking off}
  2. {$B+}    {Boolean complete evaluation on}
  3. {$S+}    {Stack checking on}
  4. {$I+}    {I/O checking on}
  5. {$N-}    {No numeric coprocessor}
  6. {$V-}
  7.  
  8. Unit MenuEdt;
  9.  
  10. Interface
  11.  
  12. Uses
  13.   Crt,
  14.   Common;
  15.  
  16. Procedure Menu_Edit;
  17.  
  18. Var
  19.   C:Integer;
  20.   Changed:Boolean;
  21.   Exist:Boolean;
  22.  
  23. Implementation
  24.  
  25. function cstr(i:integer):astr;
  26. var c:astr;
  27. begin
  28.   str(i,c); cstr:=c;
  29. end;
  30.  
  31. function mln(i:astr; l:integer):astr;
  32. begin
  33.   while length(i)<l do i:=i+' ';
  34.   mln:=i;
  35. end;
  36.  
  37. function mn(i,l:integer):astr;
  38. begin
  39.   mn:=mln(cstr(i),l);
  40. end;
  41.  
  42. procedure makenewfile;
  43. var f:text;
  44. begin
  45.   cl(3);
  46.   prompt(n+' is a new file. Creating...');
  47.   assign(f,n);
  48.   rewrite(f);
  49.   writeln(f,'NULL');
  50.   writeln(f,'Command? ');
  51.   writeln(f,'?');
  52.   writeln(f,'0');
  53.   writeln(f,'77');
  54.   writeln(f,'0');
  55.   writeln(f,' ');
  56.   close(f);
  57.   print('Ok');
  58. end;
  59.  
  60. procedure inputn(var i:integer; ml:integer);
  61. var s:astr;
  62. begin
  63.   str(i,s);
  64.   input1(s,ml,false);
  65.   i:=value(s);
  66. end;
  67.  
  68. procedure cmdline;
  69. begin
  70. end;
  71.  
  72. {procedure cmdline;
  73. var x,y:integer; i:astr;
  74. begin
  75.   getdir(0,i);
  76.   x:=wherex; y:=wherey;
  77.   window(1,1,80,25);
  78.   cl(0); textbackground(1);
  79.   clreol; gotoxy(1,1);
  80.   prompt('Commands on Menu: ',c,' │ Editing: ',n,' │ Active Directory: '+i);
  81.   window(1,2,80,25);
  82.   tb(0); gotoxy(x,y);
  83. end;}
  84.  
  85. procedure display;
  86. var i:integer; done,abort:boolean;
  87. begin
  88.   nl; nl;
  89.   done:=false; abort:=false;
  90.   cl(0);
  91.   printacr('NN Command        MSL Type Option data Option String',abort,next);
  92.   cl(9);
  93.   printacr('-- -------------- --- ---- ----------- ----------------------------------------',abort,next);
  94.   i:=1;
  95.   while (i<=c) and (not abort) do
  96.     begin
  97.       printacr(mn(i,3)+mln(cmdl[i],15)+mn(msl[i],4)+mn(cmdtype[i],5)+
  98.       mn(optdata[i],12)+optstr[i],abort,next);
  99.       i:=i+1;
  100.     end;
  101. end;
  102.  
  103. procedure editcmd;
  104. var i,x,z:integer; r:char; s:astr;
  105. begin
  106.   display;
  107.   nl;
  108.   cl(3);
  109.   prompt('Enter # to Edit   : ');
  110.   cl(9);
  111.   inputn(i,2);
  112.   if (i>0) and (i<c+1) then
  113.   repeat
  114.     nl;
  115.     cl(5); print('CMD Information');
  116.     nl;
  117.     cl(3); prompt('1> ');
  118.     cl(3);
  119.     prompt('Command String  :');
  120.     cl(9);
  121.     print(cmdl[i]);
  122.     cl(3); prompt('2> ');
  123.     cl(3);
  124.     prompt('Security Level  :');
  125.     cl(9);
  126.     print(cstr(msl[i]));
  127.     cl(3); prompt('3> ');
  128.     cl(3);
  129.     prompt('Command Type    :');
  130.     cl(9);
  131.     print(cstr(cmdtype[i]));
  132.     cl(3); prompt('4> ');
  133.     cl(3);
  134.     prompt('Optional Data   :');
  135.     cl(9);
  136.     print(cstr(optdata[i]));
  137.     cl(3); prompt('5> ');
  138.     cl(3);
  139.     prompt('Optional String :');
  140.     cl(9);
  141.     print(optstr[i]);
  142.     nl;
  143.     cl(7);
  144.     prompt('Enter Selection [1-5] or Q=Quit  : ');
  145.     cl(9);
  146.     onek(r,'12345Q');
  147.     if r='1' then begin
  148.       nl; cl(3); prompt('Enter new command string   : '); cl(9);
  149.       input(s,14); cmdl[i]:=s;
  150.     end;
  151.     if r='2' then begin
  152.       nl; cl(3); prompt('Enter new Security Level   : '); cl(9);
  153.       inputn(z,3); msl[i]:=z;
  154.     end;
  155.     if r='3' then begin
  156.       nl; cl(3); prompt('Enter new Command Type     : '); cl(9);
  157.       inputn(z,3); cmdtype[i]:=z;
  158.     end;
  159.     if r='4' then begin
  160.       nl; cl(3); prompt('Enter new Optional Data    : '); cl(9);
  161.       inputn(z,3); optdata[i]:=z;
  162.     end;
  163.     if r='5' then begin
  164.       nl; cl(3); prompt('Enter new Optional String  : '); cl(9);
  165.       inputl(s,40); optstr[i]:=s;
  166.     end;
  167.   until (r='Q') or hangup;
  168. end;
  169.  
  170. procedure deletecmd;
  171. var i:integer; x:integer;
  172. begin
  173.   display;
  174.   nl;
  175.   cl(3);prompt('Enter # to delete  : ');
  176.   cl(9);
  177.   inputn(i,2);
  178.   if (i>0) and (i<c+1) then begin
  179.     for x:=i+1 to c do begin
  180.       cmdl[x-1]:=cmdl[x];
  181.       msl[x-1]:=msl[x];
  182.       cmdtype[x-1]:=cmdtype[x];
  183.       optdata[x-1]:=optdata[x];
  184.       optstr[x-1]:=optstr[x];
  185.     end;
  186.     c:=c-1;
  187.     cmdline;
  188.   end;
  189. end;
  190.  
  191. procedure addcmd;
  192. var s:astr; z:integer;
  193. begin
  194.   if c<30 then begin
  195.   nl;
  196.   nl;
  197.   cl(7);
  198.   print('Please enter following information');
  199.   nl;
  200.   cl(3);
  201.   prompt('Command string   : '); cl(9); input(s,14);
  202.   if s<>'' then begin
  203.     c:=c+1; cmdl[c]:=s;
  204.     cl(3);
  205.     prompt('Security Level   : '); cl(9); inputn(z,3); msl[c]:=z;
  206.     cl(3);
  207.     prompt('Command Type     : '); cl(9); inputn(z,3); cmdtype[c]:=z;
  208.     cl(3);
  209.     prompt('Optional Data    : '); cl(9); inputn(z,3); optdata[c]:=z;
  210.     cl(3);
  211.     prompt('Optional String  : '); cl(9); inputl(s,40); optstr[c]:=s;
  212.     cl(7);
  213.     prompt('Cmd #'+cstr(c)+' added.');
  214.     cmdline;
  215.   end;
  216.   end else writeln('You are limited to 30 commands per menu.');
  217. end;
  218.  
  219. procedure insertcmd;
  220. var z,ic,x:integer; s:astr;
  221. begin
  222.   if c<30 then begin
  223.     nl; nl;
  224.     cl(9);Prompt('Insert before (1-'+cstr(c)+') : '); cl(0);
  225.     input(s,2); if s<>'' then begin
  226.       ic:=value(s);
  227.       c:=c+1;
  228.       for x:=c downto ic do begin
  229.         cmdl[x]:=cmdl[x-1];
  230.         msl[x]:=msl[x-1];
  231.         cmdtype[x]:=cmdtype[x-1];
  232.         optdata[x]:=optdata[x-1];
  233.         optstr[x]:=optstr[x-1];
  234.       end;
  235.       cl(7);
  236.       print('Please enter following information');
  237.       nl;
  238.       cl(3);
  239.       prompt('Command string   : '); cl(9); input(s,14);
  240.       if s<>'' then begin
  241.         cmdl[ic]:=s;
  242.         cl(3);
  243.         prompt('Security Level   : '); cl(9); inputn(z,3); msl[ic]:=z;
  244.         cl(3);
  245.         prompt('Command Type     : '); cl(9); inputn(z,3); cmdtype[ic]:=z;
  246.         cl(3);
  247.         prompt('Optional Data    : '); cl(9); inputn(z,3); optdata[ic]:=z;
  248.         cl(3);
  249.         prompt('Optional String  : '); cl(9); inputl(s,40); optstr[ic]:=s;
  250.         cl(7);
  251.         prompt('Cmd #'+cstr(ic)+' added.');
  252.       end;
  253.     end;
  254.   end else writeln('You already have 30 commands, delete some to make room.');
  255. end;
  256.  
  257. procedure savemenu;
  258. var filv:text; i:integer;
  259. begin
  260.   nl; nl; cl(3);
  261.   assign(filv,n);
  262.   rewrite(filv);
  263.   writeln(filv,directive);
  264.   writeln(filv,menuprompt);
  265.   for i:=1 to c do begin
  266.     writeln(filv,cmdl[i]);
  267.     writeln(filv,msl[i]);
  268.     writeln(filv,cmdtype[i]);
  269.     writeln(filv,optdata[i]);
  270.     writeln(filv,optstr[i]);
  271.   end;
  272.   close(filv); print('Menu saved.');
  273.   changed:=false;
  274. end;
  275.  
  276. procedure asksave;
  277. var save:boolean; r:char;
  278. begin
  279.   nl;
  280.   cl(3);
  281.   prompt(n+' not saved.  Save (Y/N) ? ');
  282.   cl(9);
  283.   if yn then save:=true else save:=false;
  284.   if save then savemenu;
  285. end;
  286.  
  287. procedure readin;
  288. begin
  289.   c:=0;
  290.   assign(filv,n);
  291.   {$I-} reset(filv); {$I+}
  292.   if ioresult<>0 then begin print(n+' does not exist.'); exist:=false; end else
  293.   BEGIN
  294.   changed:=false;
  295.   readln(filv,directive);
  296.   readln(filv,menuprompt);
  297.   repeat
  298.     c:=c+1;
  299.     readln(filv,cmdl[c]);
  300.     readln(filv,msl[c]);
  301.     readln(filv,cmdtype[c]);
  302.     readln(filv,optdata[c]);
  303.     readln(filv,optstr[c]);
  304.   until (eof(filv));
  305.   close(filv);
  306.   cmdline;
  307.   EXIST:=TRUE;
  308.   END;
  309. end;
  310.  
  311. procedure workfile;
  312. var s:astr;
  313. begin
  314.   nl;
  315.   if changed then asksave;
  316.   cl(3);
  317.   prompt('Enter new work file  : ');
  318.   cl(9);
  319.   input(s,8);
  320.   if s<>'' then begin
  321.     N:=s;
  322.     n:=systat.menupath+n+'.MNU';
  323.     readin;
  324.     if exist=false then begin makenewfile; readin; end;
  325.   end;
  326. end;
  327.  
  328. procedure directives;
  329. var s:astr; R:Char;
  330. begin
  331.   repeat
  332.   nl;
  333.   cl(7);
  334.   prompt('Current Directives:');
  335.   nl;
  336.   cl(3);
  337.   prompt('1> ');
  338.   cl(3);
  339.   print('File Printed   : '+directive);
  340.   cl(3);
  341.   prompt('2> ');
  342.   cl(3);
  343.   print('Menu Prompt    : '+menuprompt);
  344.   nl; cl(3);
  345.   prompt('Enter Selection [1-2] or Q to quit : ');
  346.   cl(9);
  347.   onek(r,'12Q');
  348.   if (r='1') then begin
  349.     print('Enter file printed.  DO NOT mark a extension if you want it to');
  350.     print('also print ANSI files to ansi users.'); nl;
  351.     cl(3); prompt('File Printed    : ');
  352.     cl(9); input(s,12); directive:=s;
  353.   end;
  354.   if r='2' then begin
  355.      print('Enter new menu prompt.  Use "^" for a command marker');
  356.      print('Use ^n where n is 0-9 for color, and @ for cmd letters in');
  357.      print('strings.');
  358.      nl;
  359.      cl(3); prompt('Menu Prompt    : ');
  360.      cl(9);
  361.      inputl(s,50); menuprompt:=s;
  362.    end;
  363.   until (r='Q') or (hangup);
  364. end;
  365.  
  366. procedure menuhelp;
  367. Begin
  368.   nl; nl;
  369.   cl(5);
  370.   prompt('W');cl(0);prompt('ork file      ');cl(5);
  371.   prompt('A');cl(0);prompt('dd cmd to menu');
  372.   nl;cl(5);
  373.   prompt('D');cl(0);prompt('isplay list   ');cl(5);
  374.   prompt('Q');cl(0);prompt('uit to BBS'); NL; cl(5);
  375.   prompt('S');cl(0);prompt('ave menu file ');cl(5);
  376.   prompt('?');cl(0);prompt('This menu'); NL; cl(5);
  377.   prompt('T');cl(0);prompt('erminate cmd  ');cl(5);
  378.   prompt('E');cl(0);prompt('dit a cmd'); nl; cl(5);
  379.   prompt('X');cl(0);prompt('Menu prompts  '); cl(5);
  380.   prompt('I');cl(0);prompt('nsert a cmd');
  381.   nl; nl;
  382. end;
  383.  
  384. procedure menu;
  385. var r:char;
  386. begin
  387.   repeat
  388.   nl;
  389.   cl(4);
  390.   prompt('MenuEdit Cmd (?=Menu) ->'); cl(2);
  391.   ONEK(R,'IDAWSTEXQ?');
  392.   if (r='A') or (r='T') or (r='I') or (r='E') or (r='X') then changed:=true;
  393.   if r='?' then menuhelp;
  394.   if r='D' then display;
  395.   if r='A' then addcmd;
  396.   if r='I' then insertcmd;
  397.   if r='W' then workfile;
  398.   if r='S' then savemenu;
  399.   if r='T' then deletecmd;
  400.   if r='E' then editcmd;
  401.   IF R='X' THEN directives;
  402.   until (r='Q') or (hangup);
  403.   if changed then asksave;
  404. end;
  405.  
  406. Procedure Menu_Edit;
  407. var i:integer; r:char;
  408. begin
  409.   cls;
  410.   changed:=false;
  411.   for i:=1 to 50 do begin
  412.     cmdl[i]:='';
  413.     msl[i]:=0;
  414.     cmdtype[i]:=0;
  415.     optdata[i]:=0;
  416.     optstr[i]:='';
  417.   end;
  418.   n:=systat.menupath+'MAIN.MNU'; readin;
  419.   clrscr;
  420.   cmdline;
  421.   nl;
  422.   cl(9);
  423.   prompt('Telegard BBS MenuEdit -- V 1.0 By Carl Mueller');
  424.   nl;
  425.   menuhelp;
  426.   menu;
  427. end;
  428.  
  429. END.