home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FORUM25C.ZIP / MENU.SUB < prev    next >
Encoding:
Text File  |  1989-02-06  |  2.2 KB  |  87 lines
  1. Function menu (mname:mstr; mfn:sstr; choices:anystr):integer;
  2. VAR k:char;
  3.     sysmenu,percent,needsys:boolean;
  4.     n,p,i:integer;
  5.     prompt:lstr;
  6. begin
  7.   sysmenu:=false;
  8.   percent:=false;
  9.   for p:=1 to length(choices)-1 do
  10.     if choices[p]='%'
  11.       then if choices[p+1]='@'
  12.         then percent:=true
  13.         else
  14.       else if choices[p+1]='@'
  15.         then sysmenu:=true;
  16.   writeln (^B);
  17.   repeat
  18.     if chatmode
  19.       then for n:=1 to 3 do summonbeep;
  20.     if (timeleft<1) or (timetillevent<=3) then begin
  21.       printfile (textfiledir+'Timesup');
  22.       forcehangup:=true;
  23.       menu:=0;
  24.       exit
  25.     end;
  26.     if showtime in urec.config THEN
  27.      Begin
  28.       Prompt := '[' + strr(timeleft)+' left] '
  29.      End
  30.     ELSE
  31.       Prompt := '';
  32.     prompt := prompt+mname+' menu [?=help';
  33.     if percent and issysop then prompt:=prompt+', %=sysop';
  34.     prompt:=prompt+']:';
  35.     writestr (prompt);
  36.     n:=0;
  37.     if length(input)=0
  38.       then k:='_'
  39.       else
  40.         begin
  41.           if match(input,'/OFF') then begin
  42.             forcehangup:=true;
  43.             menu:=0;
  44.             exit
  45.           end;
  46.           n:=valu(input);
  47.           if n>0
  48.             then k:='#'
  49.             else k:=upcase(input[1])
  50.         end;
  51.     p:=1;
  52.     i:=1;
  53.     if k='?'
  54.       then
  55.         begin
  56.           printfile (textfiledir+mfn+'M');
  57.           if sysmenu and issysop then printfile (textfiledir+mfn+'S')
  58.         end
  59.       else
  60.         while p<=length(choices) do begin
  61.           needsys:=false;
  62.           if p<length(choices)
  63.             then if choices[p+1]='@'
  64.               then needsys:=true;
  65.           if upcase(choices[p])=k
  66.             then if needsys and (not issysop)
  67.               then
  68.                 begin
  69.                   reqlevel (sysoplevel);
  70.                   p:=255;
  71.                   needsys:=false
  72.                 end
  73.               else p:=256
  74.             else
  75.               begin
  76.                 p:=p+1;
  77.                 if needsys then p:=p+1;
  78.                 i:=i+1
  79.               end
  80.         end
  81.   until (p=256) or hungupon;
  82.   writeln (^B^M);
  83.   if hungupon
  84.     then menu:=0
  85.     else
  86.       if k='#' then menu:=-n else menu:=i
  87. end;