PROGRAM MCMenu;
{ ver 0.000
          ^ bug fix
        ^^  minor rev
      ^     major rev
{ Turbo Pascal 5.5 }

{ Malaspina College Menu     }
{ ALL work done on MY time, as was original concept.  }
{ 0.100 work start Nov  18 1991  Tony Bigras  BIGRAS@MALA.BC.CA
                                              (604) 753-3245 x2588 }
{ 0.708 seems ok menu wise most bugs out ( the ones I know about )

  0.710 another bug in submenus with data going to end of file fixed
  adjusted calcfloatindex for N+ switch I had put it around func
  but it has to be global.  That picked up 10k of .exe

    0.711 fixed bug with empty lines in menu file causing
    invalid menu message

    0.712 turn off cursor so menu looks cleaner
          turned on again at end of prog with call to co80

    0.713 mouse support for microsoft mouse type
          left button = RETURN
          right button = ESC
          up and down = up down keys
          no mouse pointer just key translation

    0.714 Monitor to full screen width
          Prompt on main screen for F1 for help
          Check DOS version min 3.00
    0.715 figure out name of this program for
          appending to end of alt255.bat file.
          only partial work done
    0.716 no esc character on last line '!' was being added
          to last menu item.
    0.717 mono card colour selections and detection
          it was giving underlines for many items (blue background)
    0.718 padded time with 0's
          only display esc from main menu in help if avail

          initial implementation will be only for advertised RPC's
          no downloaded code only resident code
          just download and upload data
          so all resident RPC's use a single pointer to a structure
          in the interface of the RPCUnit
    0.719 adding in netbios hooks
          also boosted intcalc to get 1 on pc 4.77mhz
    0.720 tuned mouse response in SYSSUP
    0.721 little bug with lack of key buffering in SYSSUP
    0.722 little bug in not displaying exit errors
    0.723 adjust netbios detect to compare for unused vectors as well
    0.724 move blank interval to 3 minutes and blank move to 5 sec
    0.725 put move interval onto regular interval start ie 0 5 10 15etc
    0.726 switched from alt255.bat to X.bat to allow novell to flag
          file x.bat when deleting others in directory.

    should add total temp convert to upper case in menu match
    testing in getinfo.  currently wont match Hello and hello
    0.727 more mouse tuneing
    0.728 ""
    0.729 added mcmenu ver to blanker screen
    0.800 reduced program heap size to prevent command.com
          transient portion being forced out
          added extended last line controls not just no escape
          ! or !! is no escape
          !R is enable RPC
          !!R no escape + enable RPC

    0.801 turned off rpcstatus if not rpcok
    0.900 multi nested menus  4000 lines and 200 menus  20 items/menu
    0.901 recurseive menu structures
          widened menus to 76 characters with error trimming
    0.902 integrated menu and sub menu execution into single function
    0.910 added support for 21 items / menu and alpha keying of menu selection
          better error trapping on file r/w
          improved error messages
    0.911 bug in sub menus, they are displaying locator info: fixed
    0.930 RPC monitor removed, debug code removed
          no functional changes
    1.000 First release with source code.
          RPC interface describe in docs but not implemented here.
    1.001 alpha keying bug fixed
    1.002 dos 5.0 reading past end of X.bat fixed
    1.010 use dos param(0) to figure name and path of menu program
          to write to batch file.  Also search program directory
          first for menu data file. If not found turn over to DOS
          search mechanism.
    1.011 Internal Malaspina College mod with 'tuesday'
          spelling fix and change to noise with error
          in input file.

    1.1 - 1.4 reserved for public mods


    1.500 Addeed Launch Logger hard coded to S:\LOG\LOG>TXT
          with reference  to USRN env variable and with the ability
          to log program launches. Uses the !L control

    1.510 Ability to not include menu
          rerun line at end of batch file.
          IF !MC! is at begining of line then that plus
          one space are stripped and final line of bat
          file is not the menu name etc.  This is usefull
          for switching between multiple menus as it
          does not let leftover batch file parts interfere
          with the transfer.

    1.520 added a space to right side of menu items for better
          viewing. Change blank start time to 5 minutes.
          and added !M to allow menu to return to last item
          ' SEE DOCS '
}
{ Public Domain, Absolutly NO liability accepted!                 }
{ Processes Novell type menu  using 0k with Hard drive menu ability}
{ and hooks to Remote Procedure Calls }
{ Uses Novell menu script but ignores colours, menu locators }
{ need more features, you have the source.    }
{ NOTE uses Env Var MN to name menu to use or Command Line overide }

USES Crt,Dos,Win,SysSup,TextMenu;

{L Win }
{L SysSup}
{L TextMenu }
{ 0.800 }
{$M 32768,100000,100000}

CONST
  verstr  = '1.520';
  blanks  = '                                                                     ';
  { 0.900 }
  maxdata= 4000;
  maxmenu=200;
  { 0.726 }
  fnamechar='X';

TYPE
  menunumtype= 0..maxmenu;
  mcmenutype= RECORD
                num: 1..mxonmenu;
                strs: ARRAY[0..mxonmenu+1] OF 1..maxdata; { +1 to find end of item }
                issub: ARRAY[1..mxonmenu] OF BOOLEAN;
                menuidx: ARRAY[1..mxonmenu] OF menunumtype;
              END;

VAR
  escapeok,escaped: BOOLEAN;


  ch: CHAR;
  ttlscr: winrecptr;
  curhelp: STRING;
  reg: REGISTERS;
  oldhelpvec,oldhk2vec: POINTER;
  cnt,maxcnt: INTEGER;
  filestr: STRING;
  mdatastr: ARRAY[1..maxdata] OF ^STRING;
  numdata: 1..maxdata;
  menus: ARRAY[0..maxmenu] OF mcmenutype;
  cl: BOOLEAN;
  dosverstr: STRING[10];
  totmenu: menunumtype;

  { 0.800 }
  rpcok: BOOLEAN;
  { 1.500 }
  logon: BOOLEAN;
  { 1.520 }
  memoryon: BOOLEAN;  { put out info to return to same menu position }
  outputmemorystr: STRING;
  memorystr: STRING;
             { format for locating on menu is 2 chars per menu,
               with drops to lower menus indicated until end of
               string.  Hence 100503  would be 10 on first menu
               5 on second menu and 3 on third menu which is
               where it would stay..  IF memorystr<>'' THEN
               input is taken from the file 2 chars at a time }
               { Just a hack , IF memorystr contains invalid
                 values for a menu level it is cleared. }


  PROCEDURE stufkeyp(codekey: INTEGER); EXTERNAL;
 {$L STUFKEYP.OBJ}

  PROCEDURE titlemsg(title: STRING;VAR  wn: winrecptr);
  VAR
    attr: INTEGER;
  BEGIN  {titlemsg}
    openwindow(2,2,79,2,wn);
    IF lastmode=mono THEN
      attr:=darkgray+lightgray*16
    ELSE
      attr:= blue+cyan*16;

    fillwin(#32,attr);
    writestr(1,1,title,attr);
  END; { titlemsg }


  PROCEDURE error(str: STRING);
  VAR
    i: INTEGER;
  BEGIN  { error }
    window(1,1,80,25);
    textbackground(black);
    textcolor(lightgray);
    clrscr;
    SETINTVEC(250,oldhelpvec);
    SETINTVEC(251,oldhk2vec);
    textmode(lastmode);
    { 0.910 }
    WRITELN;
    WRITELN(CONCAT('MC Menu Ver ',verstr,'  E R R O R.'));
    WRITELN;
    WRITE('       ');
    WRITELN(str);
    WRITELN;
    WRITELN;

    { 0.910 }
    {
    FOR i:= 1 TO 8 DO
    BEGIN
      sound(100);
      delay(200);
      sound(500);
      delay(200);
    END;
    }
    { 1.011 }
    sound(500);
    delay(300);
    nosound;
    HALT(1);
  END; { error }

  PROCEDURE help;  INTERRUPT; { vector 250 }
  CONST
    helpattr= black+lightgray*16;

  VAR
    helpwin: winrecptr;
    oldwin: winstate;
    i: INTEGER;
    key: CHAR;
    helphack: INTEGER;
  BEGIN { help }
    inhelp:= TRUE;
    savewin(oldwin);
    openwindow(1,4,80,25,helpwin);
    tframewin('MC Menu Help',singleframe,helpattr,helpattr);
    fillwin(#32, helpattr);
    textattr:=helpattr;
    gotoxy(1,1);
    savewin(helpwin^.state);
    GOTOXY(1,2);

    IF (curhelp='General') THEN helphack:=1;

    CASE helphack OF

      1: BEGIN
        WRITELN;
        WRITELN('           Items with a  ¯  have a sub menu.');
        WRITELN;
        WRITELN('           Select an item or a submenu by pressing the ENTER key.');
        WRITELN;
        WRITELN('           Choose different items using arrow or alpha keys. ');
        WRITELN;
        IF hasmouse THEN
        BEGIN
          WRITELN('           Mouse Active... left button = RETURN, right = ESC.');
          WRITELN;
        END; { hasmouse }
        WRITELN('           Exit a submenu with the ESC key.');
        WRITELN;
        { 0.716 }
        IF escapeok THEN
          WRITELN('           Exit the Main Menu with the ESC key.');
        WriteStr(16,17,
          'Public Domain by Tony Bigras August 24 1992',
          helpattr);
      END { 1 };

    END; { CASE }
    WriteSTr(26,19,'Press <ESC> to leave Help.',helpattr);
    key:= allowkey([CHAR(esc)],-1);
    restorewin(helpwin^.state);
    unframewin;
    closewindow(helpwin);
    restorewin(oldwin);
    inhelp:= FALSE;
  END; { help }

  PROCEDURE titlescreen;
  VAR
    attr: INTEGER;
    attrf1: INTEGER;
  BEGIN { titlescreen }
    openwindow(1,1,80,3,ttlscr);
    IF lastmode=mono THEN
    BEGIN
      attr:= black+lightgray*16;
      attrf1:=darkgray+black*16;
    END
    ELSE
    BEGIN
      attr:= blue+cyan*16;
      attrf1:=white+blue*16;
    END;
    framewin(singleframe,attr);
    WriteStr(1,1,'M C Menu                                                             Ver '+verstr+'  '
     ,attr);
    window(1,4,80,25);
    fillwin(#177,attr);
    WriteStr(1,22,
     '<F1>-Help                                                                         '
     ,attrf1);
  END; { titlescreen }

  PROCEDURE domainmenu;

  CONST
   fname= fnamechar+'.bat';

  VAR
    f: TEXT;
    i,choice: INTEGER;
    menu: menutype;
    selected: BOOLEAN;


    { 1.500 }
    PROCEDURE Writelog(application: STRING);

    CONST
     trycount= 30;
     flogname='S:\LOG\LOG.TXT';
     maxtrydelay= 100;
     mintrydelay= 20;

    VAR
      f: TEXT;
      delvar: INTEGER;
      count: INTEGER;
      logstr: STRING;
      year,month,day,dayofweek: WORD;
      s: STRING;
      hour,minute,second,sec100: WORD;
      i: INTEGER;
      iores: INTEGER;

    BEGIN { Writelog }
      logstr:=application;
      IF LENGTH(logstr)<30 THEN
        logstr:=CONCAT(logstr,COPY(blanks,1,30-LENGTH(logstr)))
      ELSE
        logstr:=COPY(logstr,1,30);

      logstr:= CONCAT(logstr,'  ',getenv('USRN'));
      IF LENGTH(logstr)<40 THEN
        logstr:=CONCAT(logstr,COPY(blanks,1,40-LENGTH(logstr)))
      ELSE
        logstr:=COPY(logstr,1,40);

      logstr:=CONCAT(logstr,'  ');

      GetDate(year,month,day,dayofweek);
      CASE dayofweek OF
        0: logstr:=CONCAT(logstr,'Sun');
        1: logstr:=CONCAT(logstr,'Mon');
        2: logstr:=CONCAT(logstr,'Tue');
        3: logstr:=CONCAT(logstr,'Wed');
        4: logstr:=CONCAT(logstr,'Thu');
        5: logstr:=CONCAT(logstr,'Fri');
        6: logstr:=CONCAT(logstr,'Sat');
      END; { CASE }

      CASE month OF
        1: logstr:= CONCAT(logstr,' Jan');
        2: logstr:= CONCAT(logstr,' Feb');
        3: logstr:= CONCAT(logstr,' Mar');
        4: logstr:= CONCAT(logstr,' Apr');
        5: logstr:= CONCAT(logstr,' May');
        6: logstr:= CONCAT(logstr,' Jun');
        7: logstr:= CONCAT(logstr,' Jul');
        8: logstr:= CONCAT(logstr,' Aug');
        9: logstr:= CONCAT(logstr,' Sep');
       10: logstr:= CONCAT(logstr,' Oct');
       11: logstr:= CONCAT(logstr,' Nov');
       12: logstr:= CONCAT(logstr,' Dec');
      END; { CASE }

      STR(day:2,s);
      logstr:= CONCAT(logstr,' ',s);
      STR(year:4,s);
      logstr:= CONCAT(logstr,' ',s);
      GetTime(hour,minute,second,sec100);
      STR(hour:2,s);
      FOR i:= 1 TO LENGTH(s) DO
        IF s[i]= ' ' THEN
          s[i]:='0';
      logstr:= CONCAT(logstr,' ',s);
      STR(minute:2,s);
      FOR i:= 1 TO LENGTH(s) DO
        IF s[i]= ' ' THEN
          s[i]:='0';
      logstr:= CONCAT(logstr,':',s);
      STR(second:2,s);
      FOR i:= 1 TO LENGTH(s) DO
        IF s[i]= ' ' THEN
          s[i]:='0';
      logstr:= CONCAT(logstr,':',s);

      {$I-}
      count:= 0;
      REPEAT
        ASSIGN(f,flogname);
        delay(mintrydelay+Random(maxtrydelay-mintrydelay));
        count:= count+1;
        APPEND(f);
        iores:=ioresult;

        { debug
        writeln(iores,' ',flogname);
        }

      UNTIL (iores=0) OR (count>trycount);

      { debug
      IF count >trycount then
      begin
        writeln(trycount);
        readln;
      end;
      }


      WRITELN(f,logstr);
      CLOSE(f);
      {$I+}

    END; { Writelog }


    PROCEDURE checkforparms(cnt: INTEGER);
    CONST
      maxparm= 9;
    VAR
      i,k: INTEGER;
      tstr,tstr2: STRING[80];
      parm: ARRAY[1..maxparm] OF STRING[80];
      parmactive: ARRAY[1..maxparm] OF BOOLEAN;
      parpos: INTEGER;


      PROCEDURE winedit(wn: winrecptr; edbuf: pointer;
            size: WORD; keys: keysettype;noscroll: BOOLEAN; exitchr: CHAR);
      TYPE
        tbuftype= ARRAY[0..65000] OF CHAR;
      VAR
        key: CHAR;
        keysallowed: keysettype;
        minx,miny,maxx,maxy: INTEGER;
        curx,cury: INTEGER;
        tptr: ^tbuftype;
      BEGIN { edit }
      tptr:=edbuf;
      restorewin(wn^.state);
      minx:=1;
      miny:=1;
      maxx:=(Lo(WindMax)-Lo(WindMin))+1;
      maxy:=(Hi(WindMax)-Hi(WindMin))+1;
      curx:=minx;
      cury:=miny;
      gotoxy(minx,miny);
      keys:=keys+[CHR(up),CHR(down),CHR(left),CHR(right),
                   CHR(esc),CHR(bs),CHR(return)];
      REPEAT
        key:= allowkey(keys,-1);
        CASE key OF
          CHR(32)..CHR(126):
          BEGIN
            GOTOXY(curx,cury);
            IF (curx<>maxx) AND (cury<>maxy) THEN
              Write(key)
            ELSE
              WriteChar(curx,cury,1,key, textattr);
            tptr^[((cury-1)*(maxx+1))+curx-1]:=key;
            IF curx<>maxx THEN
              INC(curx)
            ELSE
              IF cury<>maxy THEN
              BEGIN
                INC(cury);
                curx:=minx;
              END; { IF }
            GOTOXY(curx,cury);
          END; { 32..126 }

          CHR(bs):
          BEGIN
            IF curx<>minx THEN
            BEGIN
              DEC(curx);
              GOTOXY(curx,cury);
              write(CHR(space));
              GOTOXY(curx,cury);
            END;
          END; { bs }

          CHR(return):
          BEGIN
            IF cury<>maxy THEN
            BEGIN
              INC(cury);
              curx:=minx;
              GOTOXY(curx,cury);
            END;
          END; { return }

          CHR(up):
          BEGIN
            IF cury<>miny THEN
            BEGIN
              DEC(cury);
              GOTOXY(curx,cury);
            END;
          END; { up }

          CHR(down):
          BEGIN
            IF cury<>maxy THEN
            BEGIN
              INC(cury);
              GOTOXY(curx,cury);
            END;
          END; { down }

          CHR(left):
          BEGIN
            IF curx<>minx THEN
            BEGIN
              DEC(curx);
              GOTOXY(curx,cury);
            END;
          END; { left }

          CHR(right):
          BEGIN
            IF curx<>maxx THEN
            BEGIN
              INC(curx);
              GOTOXY(curx,cury);
            END;
          END; { right }

        END; { CASE }
        until key=exitchr;
        savewin(wn^.state);
      END; { winedit }

      FUNCTION getparm(str: STRING): STRING;
        CONST
        cgetattr= white+cyan*16;
        mgetattr= white+black*16;
        depth=3;
        width=60;
      TYPE
        edbuftype= ARRAY[0..width-2] OF BYTE;
      VAR
        wn: winrecptr;
        oldwin: winstate;
        edbuf: ^edbuftype;
        size: WORD;
        i: INTEGER;
        tstr: STRING;
        attr: INTEGER;

      BEGIN { getparms }
        IF lastmode=mono THEN
          attr:=mgetattr
        ELSE
          attr:=cgetattr;
        tstr:='';
        curhelp:= 'Enter Parameter';
        savewin(oldwin);
        openwindow(10,10,10+width-1,10+depth-1,wn);
        tframewin(str,doubleframe,attr,attr);
        fillwin(#32,attr);
        IF lastmode=mono THEN
          textattr:=mgetattr
        ELSE
          textattr:=cgetattr;
        gotoxy(1,1);
        savewin(wn^.state);
        size:=width*(depth-2);
        getmem(edbuf,size);
        FillChar(edbuf^,size,CHR(32));
        winedit(wn,edbuf,size,[CHR(32)..CHR(126)],TRUE,CHR(return));
        Move(edbuf^,tstr[1],width-2);
        tstr[0]:=CHR(width-2);
        WHILE tstr[LENGTH(tstr)]=' ' DO  { strip trailing spaces }
          tstr[0]:= CHR(ORD(tstr[0])-1);
        getparm:= tstr;
        freemem(edbuf,size);
        restorewin(wn^.state);
        unframewin;
        closewindow(wn);
        restorewin(oldwin);
      END; { getparm }

    BEGIN { checkforparms }
      { parms take format      stuf  @1"Enter value" @2"enter drive" @2
      { would produce          stuf  value drive drive                     }

      FOR i:= 1 TO maxparm DO
        parmactive[i]:=FALSE;
       tstr:= mdatastr[cnt]^;
      { kill leading spaces }
      WHILE (tstr[1]=' ') DO
        tstr:= COPY(tstr,2,LENGTH(tstr)-1);
      tstr2:='';
      WHILE POS('@',tstr)<>0 DO
      BEGIN
        IF POS('@',tstr)>1 THEN
        BEGIN
          tstr2:=CONCAT(tstr2,COPY(tstr,1,POS('@',tstr)-1));
          tstr:=COPY(tstr,POS('@',tstr),LENGTH(tstr));
        END; { use up leading stuff }
        parpos:= POS('@',tstr);
        IF parpos<>0 THEN
        BEGIN
          IF tstr[parpos+1] IN ['1'..'9'] THEN { really a parameter }
          BEGIN
            IF parmactive[ORD(tstr[parpos+1])-48] THEN
            BEGIN { old parameter }
              tstr2:=CONCAT(tstr2,parm[ORD(tstr[parpos+1])-48]);
              tstr:=COPY(tstr,3,LENGTH(tstr)-2);
            END
            ELSE { new parameter }
            BEGIN
               parmactive[ORD(tstr[parpos+1])-48]:= TRUE;
               parm[ORD(tstr[parpos+1])-48]:=
               getparm(CONCAT(' ',COPY
                (tstr,parpos+3,POS('"',COPY(tstr,parpos+3,LENGTH(tstr)))-1),' '));
               tstr2:=CONCAT(tstr2,parm[ORD(tstr[parpos+1])-48]);
               tstr:= COPY(tstr,
                POS('"',COPY(tstr,parpos+3,LENGTH(tstr)))+4,LENGTH(tstr));
            END; { ELSE }
          END { really a parameter }
          ELSE
          BEGIN
            tstr2:=CONCAT(tstr2,'@');
            tstr:=COPY(tstr,2,LENGTH(tstr)-1);
          END; { not a parameter }
        END; { posible parameter }
      END; { WHILE }
      { now get tail of string }
      tstr2:=CONCAT(tstr2,tstr);
      FOR k:= 1 TO LENGTH(tstr2) DO
        tstr2[k]:=upcase(tstr2[k]); { convert to upper case }

      { its bigger now so re-get space }

      FREEMEM(mdatastr[cnt],LENGTH(mdatastr[cnt]^)+2);
      GETMEM(mdatastr[cnt],LENGTH(tstr2)+2);
      mdatastr[cnt]^:= tstr2;
    END; { checkforparms }

    PROCEDURE dosubmenu(smen: integer);
    VAR
     i: INTEGER;
     menu: menutype;
     restartmenu: BOOLEAN;
     { 1.520 }
     tstr: STRING;
     v1,v2: INTEGER;
     doingmemory: BOOLEAN;

    BEGIN { dosubmenu }
      menu.title:=   mdatastr[menus[smen].strs[0]]^;
      menu.titlehelp:='';
      { 1.520 }
      doingmemory:= memorystr<>'';
      IF doingmemory THEN
      BEGIN
        VAL(COPY(memorystr,1,2),v1,v2);
        memorystr:=COPY(memorystr,3,LENGTH(memorystr)-2);
        IF v2<>0 THEN
        BEGIN
          doingmemory:= FALSE;
          memorystr:= '';
        END { error in memorystr }
        ELSE
        BEGIN { maybe a valid conversion }
          IF (v1 < 1) OR (v1>menus[smen].num) THEN
          BEGIN
            doingmemory:= FALSE;
            memorystr:= '';
          END;
        END; { else maybe valid }
      END; { memorystr being processed }
      FOR i:= 1 TO menus[smen].num DO
      BEGIN
        menu.item[i]:= mdatastr[menus[smen].strs[i]]^;
        menu.itemhelp[i]:='';
      END;
      WITH menu DO
      BEGIN
        numitem:=menus[smen].num;

        { 1.520 }
        IF doingmemory THEN
          oldselect:= v1
        ELSE
          oldselect:=1;
        mode:=replace;
        ctrl.sort:= FALSE;
        ctrl.wrap:= TRUE;
        ctrl.escape:= TRUE;
        ctrl.alphakey:= TRUE;
      END; { WITH }
      txtmenuinit(menu,0,0);
      REPEAT
        curhelp:='General';

        { 1.520 }
        IF doingmemory AND (memorystr<>'') THEN
          choice:= v1
        ELSE
          choice:= txtmenu(menu);
        savewin(menu.wn^.state);
        IF (choice<>0) THEN
        BEGIN
          STR(choice:2,tstr);
          outputmemorystr:=CONCAT(outputmemorystr,tstr);


          IF menus[smen].issub[choice] THEN
           dosubmenu(menus[smen].menuidx[choice])
          ELSE
          BEGIN
            {$I-}
            FOR i:= menus[smen].strs[choice]+1 TO menus[smen].strs[choice+1]-1 DO
              checkforparms(i);
            ASSIGN(f,fname);
            IF ioresult<>0 THEN
              error(CONCAT('Unable to Write to:  > ',fname));
            REWRITE(f);
            IF ioresult<>0 THEN
              error(CONCAT('Unable to Write to:  > ',fname));

            restartmenu:= TRUE;
            FOR i:= menus[smen].strs[choice]+1 TO menus[smen].strs[choice+1]-1 DO
            BEGIN { 1.510 }
              IF POS('!MC!',mdatastr[i]^)=1 THEN
              BEGIN
                restartmenu:= FALSE;
                mdatastr[i]^:= COPY(mdatastr[i]^,5,LENGTH(mdatastr[i]^)-4);
              END;
              IF (NOT restartmenu) AND (i=menus[smen].strs[choice+1]-1) THEN
                WRITE(f,mdatastr[i]^)
              ELSE
                WRITELN(f,mdatastr[i]^);
            END; { 1.510 }

            { 1.010 use parmastr(0) to get program name and path }
            { 1.002 from WRITELN as dos 5.0 kept on reading in new X.bat }

            { 1.520 }
            IF memoryon THEN
            BEGIN
              FOR i:= 1 TO LENGTH(outputmemorystr) DO
                IF outputmemorystr[i]=' ' THEN
                  outputmemorystr[i]:='0';
              filestr:= CONCAT(filestr,' ',outputmemorystr);
            END;

            { 1.510 }
            IF restartmenu THEN
              WRITE(f,CONCAT('@',paramstr(0),' '),filestr);

            CLOSE(f);
            IF ioresult<>0 THEN
              error(CONCAT('Unable to Write to  > ',fname));


            { 1.500 }
            IF logon THEN
              Writelog(mdatastr[menus[smen].strs[choice]]^);



            {$I+}
            selected:= TRUE;
          END;
        END; { choice<>0 }
      restorewin(menu.wn^.state);
    UNTIL (choice=0)  OR selected;
    IF choice=0 THEN
    BEGIN
      choice:= smen;
      { 1.520 }
      outputmemorystr:= COPY(outputmemorystr,1,
                        LENGTH(outputmemorystr)-2);
      choice:=smen;
    END;
    txtmenukill(menu);
    END; { dosubmenu }

    PROCEDURE confirmexit;

    VAR
      exitmenu: menutype;
      pick: INTEGER;

    BEGIN { confirmexit }
       WITH exitmenu DO
       BEGIN
         title:='Exit';
         titlehelp:='';
         item[2]:='Yes';
         itemhelp[2]:='';
         item[1]:='No';
         itemhelp[1]:='';

         numitem:=2;
         oldselect:=2;
         mode:=replace;
         ctrl.sort:= FALSE;
         ctrl.wrap:= FALSE;
         ctrl.escape:= TRUE;
         ctrl.alphakey:= TRUE;
       END; { WITH }
       txtmenuinit(exitmenu,0,0);
       pick:=txtmenu(exitmenu);
       txtmenukill(exitmenu);
       IF (pick=0) OR (pick=1) THEN { cancel escape }
         choice:=1; { menu.oldselect; }
    END; { confirmexit }

  BEGIN { domainmenu }
    selected:=FALSE;
    REPEAT
      dosubmenu(0);
      IF ((choice=0) AND escapeok) THEN
        confirmexit;
    UNTIL ((choice=0) AND escapeok) OR selected;
    escaped:= (choice=0);
  END; { domainmenu }

  {$I- }
  PROCEDURE getinfo;
  VAR
    f: TEXT;
    i,cnt,j,k: INTEGER;
    w: INTEGER;
    tstr,tstr2:STRING;
    ctrlline: BOOLEAN;

    PROCEDURE getsubs(menunum: menunumtype);
    VAR
      i,j,k,cnt,tcnt: INTEGER;
      tstr,tstr2,tstr3: STRING;
      notfound: BOOLEAN;
    BEGIN  { getsubs }
      cnt:= menus[menunum].strs[0]+1;
      WHILE (cnt<=numdata) AND (mdatastr[cnt]^[1]<>'%') DO
      BEGIN  { find all menu items }
        IF (mdatastr[cnt]^[1]<>' ') THEN  { must be a menu item }
        BEGIN
          menus[menunum].strs[menus[menunum].num]:=cnt;
          WHILE (mdatastr[cnt+1]^[1]=' ') DO
            mdatastr[cnt+1]^:= COPY(mdatastr[cnt+1]^,2,LENGTH(mdatastr[cnt+1]^)-1);
          menus[menunum].issub[menus[menunum].num]:=(mdatastr[cnt+1]^[1]='%');
          IF menus[menunum].issub[menus[menunum].num] THEN
          BEGIN
            menus[menunum].menuidx[menus[menunum].num]:= totmenu+1;
            { find start of this submenu items menu }
            tcnt:=cnt+2;
            tstr:=mdatastr[menus[menunum].strs[menus[menunum].num]+1]^;
            FOR k:= 1 TO LENGTH(tstr) DO
              tstr[k]:=upcase(tstr[k]);      { convert to all upper case }
            notfound:=TRUE;
            WHILE ((tcnt<=numdata) AND notfound) DO
              IF mdatastr[tcnt]^[1]<>'%' THEN
                tcnt:=tcnt+1
              ELSE
              BEGIN
                tstr3:=mdatastr[tcnt]^;
                FOR k:= 1 TO LENGTH(tstr3) DO
                  tstr3[k]:=upcase(tstr3[k]);  { convert to all upper case }
              notfound:=(POS(tstr,tstr3)=0);
              IF notfound THEN
               tcnt:=tcnt+1;
            END; { WHILE }
            IF tcnt>numdata THEN error(CONCAT('Invalid menu structure:  > ',
              mdatastr[menus[menunum].strs[menus[menunum].num]+1]^));
            totmenu:=totmenu+1;
            menus[totmenu].strs[0]:=tcnt;
            menus[totmenu].num:=1;

            { strip location info from menu title}
            IF POS(',',mdatastr[menus[totmenu].strs[0]]^)<>0 THEN
            mdatastr[menus[totmenu].strs[0]]^:=
              COPY(mdatastr[menus[totmenu].strs[0]]^,
              1,POS(',',mdatastr[menus[totmenu].strs[0]]^)-1);
            getsubs(totmenu);
          END; { is sub menu }
          menus[menunum].num:=menus[menunum].num+1;
          menus[menunum].strs[menus[menunum].num]:=cnt;

          cnt:=cnt+1; { was menu item and next item was de spaced }
        END; { IF valid item for menu }
        cnt:=cnt+1;
      END; { While cnt }
      menus[menunum].strs[menus[menunum].num]:=cnt;
      IF cnt=numdata THEN
        inc(menus[menunum].strs[menus[menunum].num]);
      menus[menunum].num:=menus[menunum].num-1;
    END; { getsubs }

  BEGIN { getinfo }
    ASSIGN(f,filestr); { let DOS try to find it }
    RESET(f);
    IF (IORESULT<>0) THEN
    BEGIN
      { 1.010  DOS could not find it, now  check program directory }
      tstr:=paramstr(0); { get full path and program name }
      i:= LENGTH(tstr)+1;
      REPEAT
        i:= i-1;
      UNTIL (tstr[i]='\');
      tstr:= COPY(tstr,1,i); { now it is just the full path }
      tstr:= CONCAT(tstr,filestr);
      ASSIGN(f,tstr);
      RESET(f);
      IF (IORESULT<>0) THEN
        error(CONCAT('Unable to open menu file:  > ',filestr));
    END;
    { read em all into mdatastr array }
    numdata:=1;
    REPEAT
      READLN(f,tstr);
      FOR i:= 1 TO LENGTH(tstr) DO
        IF (tstr[i]=CHR(09))OR
           (tstr[i]=CHR(175)) THEN {  strip double arrow chr }
                                   { left over due to old menus }
                                   { that used it to indicate subs }
           tstr[i]:= CHR(32);  { convert tab to 1 space }
      numdata:=numdata+1;
      { .711 did not handle lines of blanks correctly }
      IF POS(tstr,blanks)<>0 THEN { it is just blanks }
        numdata:= numdata-1
      ELSE
      BEGIN
        { ptrupdate
          get some space  size of string  }

        GETMEM(mdatastr[numdata-1],LENGTH(tstr)+2);
        mdatastr[numdata-1]^:=tstr;

      END; { add item }

    UNTIL EOF(f);
    numdata:=numdata-1;
    CLOSE(F);
    { 0.716 }
    { 0.800 }
     ctrlline:=  (mdatastr[numdata]^[1]='!');
     escapeok:= TRUE;
     rpcok:= FALSE;
     logon:= FALSE;
     memoryon:= FALSE;
     IF ctrlline THEN
     BEGIN
       IF mdatastr[numdata]^='!' THEN
         escapeok:= FALSE
         { retain for old escape method '!' is no escape }
       ELSE
         escapeok:= (0=POS('!',mdatastr[numdata]^[2])); { !! is escape }
       rpcok:= (0<>POS('R',mdatastr[numdata]^));       { !R is do rpc }

       { 1.500 }
       logon:= (0<>POS('L',mdatastr[numdata]^));  { log program launches }

       { 1.520 }
       memoryon:= (0<>POS('M',mdatastr[numdata]^)); { menu remembers place }

       numdata:=numdata-1;
     END;
    menus[0].num:=1;
    menus[0].strs[0]:=1;
    IF (mdatastr[menus[0].strs[0]]^[1]<>'%') THEN
      error(CONCAT('First line must be menu:  > ',mdatastr[menus[0].strs[0]]^));

        { strip % and location info from menu title}
    mdatastr[menus[0].strs[0]]^:= COPY(mdatastr[menus[0].strs[0]]^,2,
      LENGTH(mdatastr[menus[0].strs[0]]^));
        IF POS(',',mdatastr[menus[0].strs[0]]^)<>0 THEN
          mdatastr[menus[0].strs[0]]^:=COPY(mdatastr[menus[0].strs[0]]^,
          1,POS(',',mdatastr[menus[0].strs[0]]^)-1);
    menus[0].strs[0]:=1;
    getsubs(0);

    FOR i:= 1 to numdata DO  { strip leading % from all strings }
      IF   mdatastr[i]^[1]='%' THEN
        mdatastr[i]^:= COPY(mdatastr[i]^,2,LENGTH(mdatastr[i]^)-1);
    FOR i:= 0 to totmenu DO
    BEGIN
      w:=1;
      { now put markers on end of items with submenus. }
      FOR k:= 0 TO menus[i].num DO
        w:=max(w,LENGTH(mdatastr[menus[i].strs[k]]^));
      FOR k:= 1 TO menus[i].num DO
      BEGIN
        IF menus[i].issub[k] THEN
        BEGIN
          tstr2:=mdatastr[menus[i].strs[k]]^;
          FREEMEM(mdatastr[menus[i].strs[k]],
             LENGTH(mdatastr[menus[i].strs[k]]^)+2);
          tstr2:=CONCAT(tstr2,COPY(blanks,1,w-LENGTH(tstr2)),' ¯');
          GETMEM(mdatastr[menus[i].strs[k]],LENGTH(tstr2)+2);
          mdatastr[menus[i].strs[k]]^:=tstr2;
        END;  { is sub }
      END; { K }
    END; { I }
  END; { getinfo }
  {$I+ }

  PROCEDURE initalize;
  VAR
    i: INTEGER;
    s1: STRING;

  BEGIN  { initalize }
    GETINTVEC(250,oldhelpvec);
    SETINTVEC(250,@help);
    helpon:= TRUE;
    delay(10);

    { .712 }
    reg.AH:= 01;
    reg.CH:= $20;
    reg.CL:= 08;
    INTR($10,reg);   { Turn cursor off }

    { 0.713 }
    reg.AX:= 00;
    INTR($33,reg);   { check for mouse and reset }
    hasmouse:= (reg.ax=$FFFF);

    { 0.714 }
    reg.AX:=$3000;
    INTR($21,reg); { get dos version }
    IF reg.AL<03 THEN
      error('Requires DOS version 3.00 or greater.');

    STR(reg.AL:1,dosverstr);
    STR(reg.AH:2,s1);
    FOR i:= 1 TO LENGTH(s1) DO
      IF s1[i]=' ' THEN
        s1[i]:='0';
    dosverstr:=CONCAT(dosverstr,'.',s1);
    { 0.715 } { find PSP and figure out this programs name. }
    reg.AH:=$62;
    INTR($21,reg);
    { reg.BX = segment of psp which is at offset 0 }
    { more needed to figure out the program name    }

    clrscr;
    checkbreak := FALSE;
    IF lastmode=mono THEN
      textattr:=lightgray+black*16
    ELSE
      textattr := lightgray+blue * 16;
    RANDOMIZE;
    { get filename from command line or if none on cl then from env var MN }
    cl:= FALSE;
    IF paramcount<1 THEN
      filestr:=getenv('MN')
    ELSE
    BEGIN
      cl:= TRUE;
      filestr:= paramstr(1);
    END;
    { 1.520 }
    memorystr:= '';
    IF paramcount>1 THEN
      memorystr:= paramstr(2);
    outputmemorystr:= '';

    { now extend file if it dosent have an extension , use .MNU }
    IF (POS('.',filestr)=0)AND (filestr<>'') THEN
      filestr:=CONCAT(filestr,'.MNU');
    IF (filestr='') THEN
      filestr:= 'No MN environment';

    totmenu:=0;
    getinfo;

     { 0.729 }
     blankerstr:=CONCAT(' M C Menu  Ver ',verstr,' ');



  END; { initalize }


BEGIN { MCMenu }

  initalize;
  titlescreen;
  window(1,1,80,25);
  curhelp:='General';
  escaped:= FALSE;

  domainmenu;

  window(1,1,80,25);
  textbackground(black);
  textcolor(lightgray);
  clrscr;
  SETINTVEC(250,oldhelpvec);

  IF NOT escaped THEN
  BEGIN
 { now clear keyboard buffer }
 WHILE keypressed DO
   ch:=READKEY;
 stufkeyp(ORD(fnamechar));
 stufkeyp(13);    { run batch (fnamechar).bat which runs mcmenu when done. }
 END; { NOT escaped }
  { .712 }
  textmode(lastmode); { turn cursor on  }
END . { MCMenu }