Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/SYSPC22.ZIP/SUBS2.PAS

Pascal/Delphi Source File | 1988-05-13 | 23.7 KB | 1,104 lines

const ingetstr:boolean=false;

procedure specialmsg (q:anystr);
begin
  pushdevice;
  textcolor (outlockcolor);
  writeln (usr,q);
  if not modemoutlock then textcolor (normbotcolor);
  popdevice
end;

PROCEDURE XMITBLK (jack:anystr);
var cnt:integer;
begin
if  carrier then begin
for cnt:=1 to length(jack) do begin
sendchar (jack[cnt]);end;
end;
end;

procedure ansicls;
begin
clrscr;
xmitblk (#27+'[2J');
end;

procedure bottomline;
var o:integer;

begin
  if inuse=0 then exit;
  pushdevice;
  o:=inuse;
  wholescreen;
  gotoxy (1,24);
  textcolor (0);
  textbackground (statlinecolor);
  if timelock then settimeleft (lockedtime);
  write (usr,'[',unam,'] [',urec.phonenum,'] [',timeleft,' left]');
  if chatmode
    then write (usr,' CHAT!')
    else write (usr,' [',sysopavailstr,']');
  if urec.numon>1 then write (usr,' [Last on ',lastonda,']') else
  write (usr,' [First Login]');
  clreol;
  gotoxy (1,25);
  write (usr,'[Lvl:',ulvl,'] [F-Lvl:',urec.udlevel,'] [GF-Lvl:',urec.gflvl,']');
  if timelock then write (usr,' [Timelock]');
  if modeminlock then write (usr,' [InLock]');
  if modemoutlock then write (usr,' [OutLock]');
  if tempsysop then write (usr,' [Sysop]');
(*  if texttrap then write (usr,' [Trap]');
  if printerecho then write (usr,' [Print]'); *)
  clreol;
  usewind (o);
  popdevice
end;

function hungupon {:boolean};
begin
  hungupon:=online and not (carrier or modeminlock or modemoutlock)
end;

function ansi:boolean;
 begin
   ansi:=(ansigraphics in urec.config);
 end;

procedure beepbeep;
begin
{  nosound;
  sound (200);
  delay (10);
  nosound  }
end;

procedure movexy (x,y:integer);
var b:boolean;
   joe:lstr;
begin
  y:=y-1;
    write (^B+#27+'['+strr(y)+';'+strr(x)+'H');
end;

procedure summonbeep;
var cnt:integer;
begin
  nosound;
  cnt:=1330;
  repeat
    sound (cnt);
    delay (10);
    cnt:=cnt+200;
  until cnt>4300;
  nosound
end;

procedure abortttfile (er:integer);
var n:integer;
begin
  specialmsg ('<Texttrap error '+strr(er)+'>');
  texttrap:=false;
  textclose (ttfile);
  n:=ioresult
end;

procedure openttfile;
var n:integer;
begin
  appendfile ('Texttrap',ttfile);
  n:=ioresult;
  if n=0
    then begin
    texttrap:=true;
    specialmsg ('(Text trap on)')
    end
    else abortttfile (n)
end;

procedure clearbreak;
begin
  break:=false;
  xpressed:=false;
  dontstop:=false;
  nobreak:=false
end;

procedure ansicolor (attrib:byte);
var tc:byte;
    b:boolean;
const colorid:array [0..7] of byte=(30,34,32,36,31,35,33,37);
begin
  if not (ansigraphics in urec.config) or (attrib=0) or (usecapsonly)
     or (attrib=curattrib) or break then exit;
  curattrib:=attrib;
  pushdevice;
  b:=nobreak;
  nobreak:=true;
  write (#27'[0');
  tc:=attrib and 7;
 if tc<>7 then write (';',colorid[tc]);
  tc:=(attrib shr 4) and 7;
  if tc<>0 then write (';',colorid[tc]+10);
  if (attrib and 8)=8 then write (';1');
  if (attrib and 128)=128 then write (';5');
  write ('m');
  nobreak:=b;
  popdevice
end;

procedure ansireset;
var b:boolean;
begin
  if usecapsonly then exit;
  if urec.regularcolor<>0 then begin
    ansicolor (urec.regularcolor);
    exit
  end;
  if (not (ansigraphics in urec.config)) or (curattrib=0) or break then exit;
  pushdevice;
  b:=nobreak;
  nobreak:=true;
  write (#27'[0m');
  curattrib:=0;
  nobreak:=b;
  popdevice
end;

procedure writeturbo (* (k:char) *);
begin
  inline ($8A/$86/k/$50/$ff/$16/turbooutptr)
end;

procedure writecon (k:char);
var r:regs;
begin
  if (k=^J) or (not useconmode) then writeturbo (k) else begin
    r.dl:=ord(k);
    r.ah:=2;
    intr($21,r)
  end
end;

procedure writeusr (k:char);
begin
  inline ($8A/$86/k/$50/$ff/$16/usroutptr)
end;

procedure writelst (k:char);
begin
  inline ($8A/$86/k/$50/$ff/$16/lstoutptr)
end;

procedure writeaux (k:char);
begin
  inline ($8A/$86/k/$50/$ff/$16/auxoutptr)
end;

procedure toggleavail;
begin
  if sysopavail=notavailable
    then sysopavail:=available
    else sysopavail:=succ(sysopavail)
end;

function keyhit:boolean;
var r:regs;
begin
  r.ah:=1;
  intr ($16,r);
  keyhit:=(r.flags and 64)=0
end;

function charready (* :boolean *) ;
var k:char;
begin
  if modeminlock then while numchars>0 do k:=getchar;
  if hungupon or keyhit
    then charready:=true
    else if online
      then charready:=(not modeminlock) and (numchars>0)
      else charready:=false
end;

function bioskey:char;
var r:regs;
begin
  r.ah:=0;
  intr ($16,r);
  if r.al=0
    then bioskey:=chr(r.ah+128)
    else bioskey:=chr(r.al)
end;

procedure setoutlock (b:boolean);
begin
  modemoutlock:=b;
  if b
    then winds[2].color:=outlockcolor
    else winds[2].color:=normbotcolor;
  if inuse=2 then usewind (2)
end;

function readchar (* :char   FORWARD *) ;

  overlay procedure toggletempsysop;
  begin
    if tempsysop
      then ulvl:=regularlevel
      else
        begin
          regularlevel:=ulvl;
          ulvl:=sysoplevel
        end;
    tempsysop:=not tempsysop
  end;

  overlay procedure togviewstats;
  begin
    pushdevice;
    if splitmode
      then unsplit
      else
        begin
          splitscreen (7);
          top;
          clrscr;
          write (usr,'File Level:  ',urec.udlevel,
                 ^M^J'File Points: ',urec.udpoints,
                 ^M^J'Uploads:     ',urec.uploads,
                 ^M^J'Downloads:   ',urec.downloads);
          window (40,1,80,5);
          gotoxy (1,1);
          write (usr,'Posts:       ',urec.nbu,
                 ^M^J'Uploads:     ',urec.gfup,
                 ^M^J'Downloads:   ',urec.gfdown,
                 ^M^J'Total Time:  ',urec.totaltime:0:0,
                 ^M^J'Num. calls:  ',urec.numon);
          window (1,1,80,5);
          bottom
        end;
    popdevice
  end;

  overlay procedure showhelp;
  begin
    pushdevice;
    if splitmode
      then unsplit
      else begin
        splitscreen (10);
        top;
        clrscr;
        write (usr,
'Chat with user: F1               Sysop commands: F2'^M^J,
'Lock the timer: F8               Lock out all modem input: F9'^M^J,
'Lock all modem output: F10       View users''s status: Alt-V'^M^J,
'Chat availabily toggle: Alt-A    Grant temporary sysop powers: Alt-T'^M^J,
'Grant user more time: Alt-M      Take away user''s time: Alt-L'^M^J,
'Take away ALL time: Alt-K        Refresh the bottom line: Alt-B'^M^J,
'Toggle printer echo: Ctrl-PrtSc  Toggle text trap: Alt-E');

    end;
    popdevice
  end;

  overlay procedure toggletexttrap;
  var n:integer;
  begin
    if texttrap
      then
        begin
          textclose (ttfile);
          n:=ioresult;
          if n<>0 then abortttfile (n);
          texttrap:=false
        end
      else openttfile
  end;

var k:char;
    ret:char;
    dorefresh:boolean;
begin
  requestchat:=false;
  requestcom:=false;
  reqspecial:=false;
  if keyhit
    then
      begin
        k:=bioskey;
        ret:=k;
        if ord(k)>127 then begin
          ret:=#0;
          dorefresh:=ingetstr;
          case ord(k)-128 of
            availtogglechar:
              begin
                toggleavail;
                chatmode:=false;
                dorefresh:=true
              end;
            sysopcomchar:
              begin
                requestcom:=true;
                requestchat:=true
              end;
            breakoutchar:breakout;
            lesstimechar:urec.timetoday:=urec.timetoday-1;
            moretimechar:urec.timetoday:=urec.timetoday+1;
            notimechar:settimeleft (-1);
            chatchar:requestchat:=true;
            sysnextchar:sysnext:=not sysnext;
            timelockchar:if timelock then timelock:=false else begin
                           timelock:=true;
                           lockedtime:=timeleft
                         end;
            inlockchar:modeminlock:=not modeminlock;
            outlockchar:setoutlock (not modemoutlock);
            tempsysopchar:toggletempsysop;
            bottomchar:bottomline;
            viewstatchar:togviewstats;
            sysophelpchar:if dorefresh then showhelp;
            texttrapchar:toggletexttrap;
            printerechochar:printerecho:=not printerecho;
            72:ret:=^E;
            75:ret:=^S;
            77:ret:=^D;
            80:ret:=^X;
            115:ret:=^A;
            116:ret:=^F;
            73:ret:=^R;
            81:ret:=^C;
            71:ret:=^Q;
            79:ret:=^W;
            83:ret:=^G;
            82:ret:=^V;
            117:ret:=^P;
          end;
          if dorefresh then bottomline
        end
      end
    else
      begin
        k:=getchar;
        if modeminlock
          then ret:=#0
          else ret:=k
      end;
  if ret='+' then write (' '^H);
  readchar:=ret
end;

function waitforchar:char;
var t:integer;
    k:char;
begin
  t:=timer+mintimeout;
  if t>=1440 then t:=t-1440;
  repeat
    if timer=t then disconnect
  until charready;
  waitforchar:=readchar
end;

procedure clearchain;
begin
  chainstr[0]:=#0
end;

function charpressed (k:char):boolean;  { TRUE if K is in typeahead }
begin
  charpressed:=pos(k,chainstr)>0
end;

procedure addtochain (l:lstr);
begin
  if length(chainstr)<>0 then chainstr:=chainstr+',';
  chainstr:=chainstr+l
end;

procedure writechar (k:char);
var sendtomodem:boolean;

  procedure normalchar (k:char);
  var n:integer;
  begin
    if inuse<>1
      then writecon (k)
      else begin
        bottom;
        writecon (k);
        top
      end;
    if wherey>lasty then begin
      gotoxy (wherex,lasty);
      writeturbo (^J)
    end;
    if sendtomodem then sendchar (k);
    if texttrap then begin
      pushdevice;
      write (ttfile,k);
      popdevice;
      n:=ioresult;
      if n<>0 then abortttfile (n)
    end;
    if printerecho then writelst (k)
  end;

  procedure endofline;

    procedure write13 (k:char);
    var n:integer;
    begin
      for n:=1 to 13 do normalchar (k)
    end;

  var b:boolean;
  begin
    normalchar (#13);
    b:=sendtomodem;
    sendtomodem:=sendtomodem and uselinefeeds;
    normalchar (#10);
    sendtomodem:=b;
    if timelock then settimeleft (lockedtime);
    if curattrib=urec.statcolor then ansicolor (urec.regularcolor);
    linecount:=linecount+1;
    if (linecount>=urec.displaylen-1) and (not dontstop)
          and (moreprompts in urec.config) then begin
      linecount:=1;
      pushdevice;
      write ('More (Y/N/C)?');
      repeat
        k:=upcase(waitforchar)
      until (k in [^M,' ','C','N','Y']) or hungupon;
      write13 (^H);
      write13 (' ');
      write13 (^H);
      popdevice;
      if k='N' then break:=true else if k='C' then dontstop:=true
    end
  end;

  procedure handleincoming;
  var k:char;
  begin
    k:=readchar;
    case upcase(k) of
      'X',^X,^K,^C,#27,' ':begin
        nobreak:=true;
        writeln;
        nobreak:=false;
        break:=true;
        linecount:=0;
        xpressed:=(upcase(k)='X') or (k=^X);
        if xpressed then clearchain
      end;
      ^S:k:=waitforchar;
      else if length(chainstr)<255 then chainstr:=chainstr+k
    end
  end;

begin
  if hungupon then exit;
  sendtomodem:=online and (not modemoutlock);
  if k<=^Z then
    case k of
      ^J,#0:exit;
      ^Q:k:=^H;
      ^B:begin
           clearbreak;
           exit
         end
     end;
   if break then exit;
   if k<=^Z then begin
     case k of
       ^G:beepbeep;
       ^L:cls;
       ^N,^R:ansireset;
       ^S:ansicolor (urec.statcolor);
       ^P:ansicolor (urec.promptcolor);
       ^U:ansicolor (urec.inputcolor);
       ^H:normalchar (k);
       ^M:endofline
     end;
     exit
   end;
   if usecapsonly then k:=upcase(k);
   normalchar (k);
   if (keyhit or ((not modemoutlock) and online and (numchars>0)))
     and (not nobreak) then handleincoming
end;

procedure getstr;
var marker,cnt:integer;
    p:byte absolute input;
    k:char;
    oldinput,s:anystr;
    done,wrapped:boolean;
    wordtowrap:lstr;

  procedure bkspace;

    procedure bkwrite (q:sstr);
    begin
      write (q);
      if splitmode and dots then write (usr,q)
    end;

  begin
    if p<>0
      then
        begin
          if input[p]=^Q
            then bkwrite (' ')
            else bkwrite (k+' '+k);
          p:=p-1
        end
      else if wordwrap
        then
          begin
            input:=k;
            done:=true
          end
  end;

  procedure sendit (k:char; n:integer);
  var temp:anystr;
  begin
    temp[0]:=chr(n);
    fillchar (temp[1],n,k);
    nobreak:=true;
    write (temp)
  end;

  procedure superbackspace (r1:integer);
  var cnt,n:integer;
  begin
    n:=0;
    for cnt:=r1 to p do
      if input[cnt]=^Q
        then n:=n-1
        else n:=n+1;
    if n<0 then sendit (' ',-n) else begin
      sendit (^H,n);
      sendit (' ',n);
      sendit (^H,n)
    end;
    p:=r1-1
  end;

  procedure cancelent;
  begin
    superbackspace (1)
  end;

  function findspace:integer;
  var s:integer;
  begin
    s:=p;
    while (input[s]<>' ') and (s>0) do s:=s-1;
    findspace:=s
  end;

  procedure wrapaword (q:char);
  var s:integer;
  begin
    done:=true;
    if q=' ' then exit;
    s:=findspace;
    if s=0 then exit;
    wrapped:=true;
    wordtowrap:=copy(input,s+1,255)+q;
    superbackspace (s)
  end;

  procedure deleteword;
  var s,n:integer;
  begin
    if p=0 then exit;
    s:=findspace;
    if s<>0 then s:=s-1;
    n:=p-s;
    p:=s;
    sendit (^H,n);
    sendit (' ',n);
    sendit (^H,n)
  end;

  procedure addchar (k:char);
  begin
    if p<buflen
      then if (k<>' ') or (p>0) or wordwrap
        then
          begin
            p:=p+1;
            input[p]:=k;
            if dots
              then
                begin
                  writechar (dotchar);
                  if splitmode then writeusr (k)
                end
             else if echo then writechar (k)
          end
        else
      else if wordwrap then wrapaword (k)
  end;

  procedure repeatent;
  var cnt:integer;
  begin
    for cnt:=1 to length(oldinput) do addchar (oldinput[cnt])
  end;

  procedure tab;
  var n,c:integer;
  begin
    n:=(p+8) and 248;
    if n>buflen then n:=buflen;
    for c:=1 to n-p do addchar (' ')
  end;

  procedure getinput;

    function getinputchar:char;
    var k:char;
    begin
      if length(chainstr)=0 then begin
        getinputchar:=waitforchar;
        exit
      end;
      k:=chainstr[1];
      delete (chainstr,1,1);
      if (k=',') and (not nochain) then k:=#13;
      getinputchar:=k
    end;

  begin
    oldinput:=input;
    ingetstr:=true;
    done:=false;
    bottomline;
    if splitmode and dots then top;
    p:=0;
    repeat
      clearbreak;
      nobreak:=true;
      k:=getinputchar;
      if hungupon then begin
        input:='';
        k:=#13;
        done:=true
      end;
      case k of
        ^I:tab;
        ^H:bkspace;
        ^M:begin
           if endp then begin
           dots:=false;
           ansicolor (urec.promptcolor);
           addchar (']');
           end;
           done:=true;
           end;
        ^R:repeatent;
        ^X,#27:cancelent;
        ^W:deleteword;
        ' '..'~':addchar (k);
        ^Q:if wordwrap and bkspinmsgs then addchar (k)
      end;
      if requestchat then begin
        p:=0;
        writeln (^B^N^M^M^B);
        chat (requestcom);
        write (^B^M^M^P,lastprompt);
        requestchat:=false
      end
    until done;
    if endp then begin
    s:=input;
    s:=copy(s,1,length(s)-1);
    input:=s;
    endp:=false;
    end;
    writeln;
    if splitmode and dots then begin
      writeln (usr);
      bottom
    end;
    ingetstr:=false;
    ansireset
  end;

  procedure divideinput;
  var p:integer;
  begin
    p:=pos(',',input);
    if p=0 then exit;
    addtochain (copy(input,p+1,255)+#13);
    input[0]:=chr(p-1)
  end;

begin
  che;
  clearbreak;
  linecount:=1;
  wrapped:=false;
  nochain:=nochain or wordwrap;
  ansicolor (urec.inputcolor);
  getinput;
  if not nochain then divideinput;
  while input[length(input)]=' ' do input[0]:=pred(input[0]);
  if not wordwrap then
    while (length(input)>0) and (input[1]=' ') do delete (input,1,1);
  if wrapped then chainstr:=wordtowrap;
  wordwrap:=false;
  nochain:=false;
  dots:=false;
  buflen:=80;
  linecount:=1
end;

procedure readline (var xx);
var a:anystr absolute xx;
    t1,t2,t3:integer;
begin
  t1:=coninptr;
  t2:=conoutptr;
  t3:=constptr;
  coninptr:=turboinptr;
  conoutptr:=turbooutptr;
  constptr:=ofs(keyhit);
  readln (a);
  coninptr:=t1;
  conoutptr:=t2;
  constptr:=t3
end;

procedure writestr (* (s:anystr)  FORWARD *) ;
var k:char;
    ex:boolean;
begin
  che;
  clearbreak;
  ansireset;
  uselinefeeds:=linefeeds in urec.config;
  usecapsonly:=not (lowercase in urec.config);
  k:=s[length(s)];
  s:=copy(s,1,length(s)-1);
  endp:=false;
  case k of
    ':':begin
          write (^P,s,': ');
          lastprompt:=s+': ';
          getstr
        end;
    ';':write (s);
    '*':begin
          endp:=true;
          write (^P,s,'[');
          lastprompt:=s;
          getstr
        end;
    '@':begin
          write (^P,s);
          lastprompt:=s;
          getstr
        end;
    '&':begin
          nochain:=true;
          write (^P,s);
          lastprompt:=s;
          getstr
        end
    else writeln (s,k)
  end;
  clearbreak
end;

procedure cls;
begin
  bottom;
  clrscr;
  bottomline
end;

procedure writehdr (q:anystr);
var cnt:integer;
begin
  writeln (^B^M);
  for cnt:=1 to (40-length(q)) div 2 do write (' ');
  write (q,^M^M^B)
end;

function issysop:boolean;
begin
  issysop:=(ulvl>=sysoplevel) or (cursection in urec.config)
end;

procedure reqlevel (l:integer);
begin
  writeln (^B'Nice try, but level ',l,' is required.')
end;

procedure printfile (fn:lstr);

  procedure getextension (var fname:mstr);

    procedure tryfiles (a,b,c,d:integer);
    var q:boolean;

      function tryfile (n:integer):boolean;
      const exts:array [1..4] of string[3]=('','ANS','ASC','40');
      begin
        if not exist (fname+'.'+exts[n]) then tryfile:=false else begin
          tryfile:=true;
          fname:=fname+'.'+exts[n]
        end
      end;

    begin
      if tryfile (a) then exit;
      if tryfile (b) then exit;
      if tryfile (c) then exit;
      q:=tryfile (d)
    end;

  begin
    if pos ('.',fname)<>0 then exit;
    if ansigraphics in urec.config  then tryfiles (2,3,1,4) else
    if asciigraphics in urec.config then tryfiles (3,1,4,2) else
    if eightycols in urec.config    then tryfiles (1,4,3,2) else
                                         tryfiles (4,1,3,2)
  end;

var tf:text;
    k:char;
begin
  clearbreak;
  writeln;
  getextension (fn);
  assign (tf,fn);
  reset (tf);
  iocode:=ioresult;
  if iocode<>0 then begin
    fileerror ('Printfile',fn);
    exit
  end;
  clearbreak;
  while not (eof(tf) or break or hungupon) do
    begin
      read (tf,k);
      write (k)
    end;
  if break then writeln (^B);
  writeln;
  textclose (tf);
  curattrib:=0;
  ansireset
end;


overlay procedure windowit(x,y,a,b:integer);
var
z,c:integer;
begin
 movexy(a,b);
 write ('┌');
 for z:=1 to x-2 do write ('─');
 write ('┐');
 c:=1;
 repeat
 movexy (a,(b+c));
 write ('│');
 movexy ((a+x-1),(b+c));
 write ('│');
 c:=c+1;
 until c>=(y-1);
 movexy (a,(b+y-1));
 write ('└');
 for z:=1 to (x-2) do write ('─');
 write ('┘');
 end;

overlay procedure printtexttopoint (var tf:text);
var l:lstr;
begin
  l:='';
  clearbreak;
  while not (eof(tf) or hungupon) and (l<>'.') do begin
    if not break then writeln (l);
    readln (tf,l)
  end
end;

overlay procedure skiptopoint (var tf:text);
var l:lstr;
begin
  l:='';
  while not eof(tf) and (l<>'.') do
    readln (tf,l)
end;



overlay function minstr (blocks:integer):sstr;
var min,sec:integer;
    rsec:real;
    ss:sstr;
begin
  rsec:=1.38 * blocks * (1200/baudrate);
  min:=trunc (rsec/60.0);
  sec:=trunc (rsec-(min*60.0));
  ss:=strr(sec);
  if length(ss)<2 then ss:='0'+ss;
  minstr:=strr(min)+':'+ss
end;

overlay procedure parserange (numents:integer; var f,l:integer);
var rf,rl:mstr;
    p,v1,v2:integer;
begin
  f:=0;
  l:=0;
  if numents<1 then exit;
  repeat
    writestr ('Range [1-'+strr(numents)+', CR=all, ?=help]:');
    if input='?' then printfile ('Rangehlp');
    if (length(input)>0) and (upcase(input[1])='Q') then exit
  until (input<>'?') or hungupon;
  if hungupon then exit;
  if length(input)=0 then begin
    f:=1;
    l:=numents
  end else begin
    p:=pos('-',input);
    v1:=valu(copy(input,1,p-1));
    v2:=valu(copy(input,p+1,255));
    if p=0 then begin
      f:=v2;
      l:=v2
    end else if p=1 then begin
      f:=1;
      l:=v2
    end else if p=length(input) then begin
      f:=v1;
      l:=numents
    end else begin
      f:=v1;
      l:=v2
    end
  end;
  if (f<1) or (l>numents) or (f>l) then begin
    f:=0;
    l:=0;
    writestr ('Invalid range!')
  end;
  writeln (^B)
end;

overlay function menu (mname:mstr; mfn:sstr; choices:anystr):integer;
var k:char;
    sysmenu,percent,needsys:boolean;
    n,p,i:integer;
    prompt:lstr;

begin
  sysmenu:=false;
  percent:=false;
  fin:=true;
  for p:=1 to length(choices)-1 do
    if choices[p]='%'
      then if choices[p+1]='@'
        then percent:=true
        else
      else if choices[p+1]='@'
        then sysmenu:=true;
  writeln (^B);
  repeat
    if chatmode
      then for n:=1 to 3 do summonbeep;
    if (timeleft<1) or (timetillevent<=3) then begin
      printfile (textfiledir+'Timesup');
      if not hungupon then disconnect;
      menu:=0;
      exit
    end;
    if usedit then
    prompt:='[Edit: '+edit_user+'] Command (?=help' else
    prompt:='['+mname+' menu] Command (?=help';
    if percent and issysop then prompt:=prompt+', %=sysop';
    prompt:=prompt+'): ';
    writeln(^P'['+strr(timeleft)+'] minutes remaining');
    writestr (prompt+'*');
    n:=0;
   if length(input)=0
      then k:='_'
      else
        begin
          if match(input,'/OFF') then begin
           disconnect;
            menu:=0;
            exit
          end;
          n:=valu(input);
          if n>0
            then k:='#'
            else k:=upcase(input[1]);
          mnu:=false;
        end;
    p:=1;
    i:=1;
    if k='?'
      then
        begin
          printfile (textfiledir+mfn+'M');
          if sysmenu and issysop then printfile (textfiledir+mfn+'S')
        end
      else
        while p<=length(choices) do begin
          needsys:=false;
          if p<length(choices)
            then if choices[p+1]='@'
              then needsys:=true;
          if upcase(choices[p])=k
            then if needsys and (not issysop)
              then
                begin
                  reqlevel (sysoplevel);
                  p:=255;
                  needsys:=false
                end
              else p:=256
            else
              begin
                p:=p+1;
                if needsys then p:=p+1;
                i:=i+1
              end
        end
  until (p=256) or hungupon;
  writeln (^B^M);
  if hungupon
    then menu:=0
    else
      if k='#' then menu:=-n else menu:=i
end;

var wasopen:boolean;
procedure opentempbdfile; { FORWARD }
begin
  wasopen:=isopen(bdfile);
  if not wasopen then openbdfile
end;

procedure closetempbdfile; { FORWARD }
begin
  if not wasopen then closebdfile
end;