PROGRAM MCTree;
 { works with MCmenu 1.010 to generate a tree structure of the
   .mnu file fed to it.
  the tree file is written to same name as MN.tre in current dir
 }

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


{ 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  = '0.000';
  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];
  { 0.800 }
  rpcok: BOOLEAN;

  totmenu: menunumtype;

  f: TEXT;


  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;
    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 February 29 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
    blankstr= '                                                         ';
    underlinestr=   '_________________________________________________________';

  VAR
    i,choice: INTEGER;
    menu: menutype;
    selected: BOOLEAN;
    fname : STRING;
    intab: INTEGER;

    PROCEDURE dosubmenu(smen: integer);
    VAR
     i: INTEGER;
     menu: menutype;
    BEGIN { dosubmenu }
      intab:= intab+2;
      IF smen=0 THEN
      BEGIN
        WRITELN(F,COPY(blankstr,1,intab),
                    {menu.title} mdatastr[menus[smen].strs[0]]^);
        WRITELN(F,COPY(blankstr,1,intab),
                 COPY(underlinestr,1,LENGTH(mdatastr[menus[smen].strs[0]]^)));
      END; { first level menu }
      FOR i:= 1 TO menus[smen].num DO
      BEGIN
        WRITELN(F,COPY(blankstr,1,intab),
                 {menu.item[i]} mdatastr[menus[smen].strs[i]]^);
        IF menus[smen].issub[i] THEN
          dosubmenu(menus[smen].menuidx[i]);
      END;
      intab:= intab-2;
    END; { dosubmenu }


  BEGIN { domainmenu }
    intab:= 0;
    fname:= CONCAT(COPY(filestr,1,LENGTH(filestr)-3),'TRE');
    {$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));

      dosubmenu(0);

      CLOSE(f);
      IF ioresult<>0 THEN
         error(CONCAT('Unable to Write to  > ',fname));
    {$I+}

  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;
     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 }
       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;
    { 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 { MCTree }

  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);

  textmode(lastmode); { turn cursor on  }
END . { MCTree }