home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MMSRC.ZIP / BLD_MENU.PAS next >
Encoding:
Pascal/Delphi Source File  |  1988-12-06  |  7.0 KB  |  178 lines
  1.   PROCEDURE Bld_Menu_List;
  2.   VAR Menu_File : TEXT;
  3.       Line : STRING;
  4.       Temp_Menu_Ptr,Last_Menu_Ptr : Menu_Ptr;
  5.       Temp_Opt : Opt_Rec;
  6.       Opened : BOOLEAN;
  7.       Opt_Nbr : BYTE;
  8.  
  9.     FUNCTION Good_Opt_Line (Line : STRING; VAR Temp_Opt : Opt_Rec) : BOOLEAN;
  10.     VAR Nbr_Flds,Next_Delim : BYTE;
  11.         s : STRING;
  12.     BEGIN
  13.       Line := CONCAT(Line,Opt_Delim);
  14.       Nbr_Flds := 0;
  15.       WHILE LENGTH(Line) > 0 DO
  16.         BEGIN
  17.           Next_Delim := Scan(Line,Forwards,EQ,Opt_Delim);
  18.           s := COPY(Line,1,Next_Delim);
  19.           Nbr_Flds := Nbr_Flds + 1;
  20.           IF Next_Delim < LENGTH(Line) THEN
  21.             Next_Delim := Next_Delim + 1;
  22.           DELETE (Line,1,Next_Delim);
  23.           WITH Temp_Opt DO
  24.             CASE Nbr_Flds OF
  25.                1 : IF Upper_Case(s) = 'DELIM' THEN Opt_Type := Delim ELSE
  26.                    IF Upper_Case(s) = 'MENU'  THEN Opt_Type := Menu  ELSE Opt_Type := Batch;
  27.                2 : IF LENGTH(s) =  0 THEN Select_Key := CHR(0)     ELSE Select_Key := s[1];
  28.                3 : IF LENGTH(s) > Max_Opt_Len THEN Opt_Name := COPY(s,1,Max_Opt_Len) ELSE Opt_Name := s;
  29.                4 : IF LENGTH(s) > 55 THEN Prg_Dir := COPY(s,1,55)  ELSE Prg_Dir := s;
  30.                5 : IF LENGTH(s) > 12 THEN Prg_Name := COPY(s,1,12) ELSE Prg_Name := s;
  31.                6 : IF LENGTH(s) > 55 THEN Parms := COPY(s,1,55)    ELSE Parms := s;
  32.                7 : IF LENGTH(s) >  8 THEN Bat_Name := COPY(s,1,8)  ELSE Bat_Name := s;
  33.                8 : IF LENGTH(s) >  8 THEN Password := COPY(s,1,8)  ELSE Password := s;
  34.                9 : IF LENGTH(s) =  0 THEN Pause := FALSE           ELSE Pause := TRUE;
  35.               10 : IF LENGTH(s) =  0 THEN Prompts := FALSE         ELSE Prompts := TRUE;
  36.               ELSE
  37.                 Line := ''; { error of some sort }
  38.             END;
  39.           IF (Nbr_Flds = 10) AND (LENGTH(Line) > 0) THEN
  40.             Line := ''; { force a finish }
  41.         END;
  42.       IF (Nbr_Flds = 10) AND (LENGTH(Line) = 0) THEN
  43.         Good_Opt_Line := TRUE
  44.       ELSE
  45.         Good_Opt_Line := FALSE;
  46.     END;
  47.  
  48.     FUNCTION Good_Menu_Line (Line : STRING; VAR Temp_Menu_Ptr : Menu_Ptr) : BOOLEAN;
  49.     VAR Nbr_Flds,Next_Delim : BYTE;
  50.         s : STRING;
  51.     BEGIN
  52.       Line := CONCAT(Line,Menu_Delim);
  53.       Nbr_Flds := 0;
  54.       WHILE LENGTH(Line) > 0 DO
  55.         BEGIN
  56.           Next_Delim := Scan(Line,Forwards,EQ,Menu_Delim);
  57.           s := COPY(Line,1,Next_Delim);
  58.           Nbr_Flds := Nbr_Flds + 1;
  59.           IF Next_Delim < LENGTH(Line) THEN
  60.             Next_Delim := Next_Delim + 1;
  61.           DELETE (Line,1,Next_Delim);
  62.           WITH Temp_Menu_Ptr^ DO
  63.             CASE Nbr_Flds OF
  64.               1 : IF LENGTH(s) > Max_Opt_Len THEN Menu_Name := COPY(s,1,Max_Opt_Len) ELSE Menu_Name := s;
  65.               2 : BEGIN VAL(s,Row,IO_Error); IF IO_Error > 0 THEN Row := 2; END;
  66.               3 : BEGIN VAL(s,Col,IO_Error); IF IO_Error > 0 THEN Col := 2; END;
  67.               ELSE
  68.                 Line := ''; { error of some sort }
  69.             END;
  70.           IF (Nbr_Flds = 3) AND (LENGTH(Line) > 0) THEN
  71.             Line := ''; { force a finish }
  72.         END;
  73.       IF (Nbr_Flds = 3) AND (LENGTH(Line) = 0) THEN
  74.         Good_Menu_Line := TRUE
  75.       ELSE
  76.         Good_Menu_Line := FALSE;
  77.     END;
  78.  
  79.   BEGIN { Bld_Menu_List }
  80.     ASSIGN (Menu_File,'MENUFILE.DAT');
  81.     Opened := FALSE;
  82.     REPEAT
  83.       {$I-}
  84.       RESET (Menu_File);
  85.       {$I+}
  86.       IO_Error := IORESULT;
  87.       IF IO_Error = 0 THEN
  88.         Opened := TRUE
  89.       ELSE
  90.         IF IO_Error = 2 THEN { file doesn't exist - create it }
  91.           BEGIN
  92.             {$I-}
  93.             REWRITE (Menu_File);
  94.             {$I+}
  95.             IO_Error := IORESULT;
  96.             IF IO_Error > 0 THEN { have a real problem here... }
  97.               BEGIN
  98.                 Sound_Bell;
  99.                 WRITELN;
  100.                 WRITELN ('+=====================================+');
  101.                 WRITELN ('|<<<<<<<<<<<<<<<<ERROR>>>>>>>>>>>>>>>>|');
  102.                 WRITELN ('|                                     |');
  103.                 WRITELN ('| "Menu Manager" detected the follow- |');
  104.                 WRITELN ('| ing UNRECOVERABLE error on the RE-  |');
  105.                 WRITELN ('| WRITE of the file "MENUFILE.DAT":   |');
  106.                 WRITELN ('|                                     |');
  107.                 WRITELN ('| IORESULT = ',IO_Error:5,'                        |');
  108.                 WRITELN ('|                                     |');
  109.                 WRITELN ('+======================================+');
  110.                 HALT;
  111.               END;
  112.             {$I-}
  113.             CLOSE (Menu_File);
  114.             {$I+}
  115.           END
  116.         ELSE { have a real probelm here... }
  117.           BEGIN
  118.             Sound_Bell;
  119.             WRITELN;
  120.             WRITELN ('+=====================================+');
  121.             WRITELN ('|<<<<<<<<<<<<<<<<ERROR>>>>>>>>>>>>>>>>|');
  122.             WRITELN ('|                                     |');
  123.             WRITELN ('| "Menu Manager" detected the follow- |');
  124.             WRITELN ('| ing UNRECOVERABLE error on the RE-  |');
  125.             WRITELN ('| SET of the file "MENUFILE.DAT":     |');
  126.             WRITELN ('|                                     |');
  127.             WRITELN ('| IORESULT = ',IO_Error:5,'                        |');
  128.             WRITELN ('|                                     |');
  129.             WRITELN ('+======================================+');
  130.             HALT;
  131.           END;
  132.     UNTIL Opened;
  133.  
  134.     Head_Menu_Ptr := NIL;
  135.     Temp_Menu_Ptr := NIL;
  136.     REPEAT
  137.       {$I-}
  138.       READLN (Menu_File,Line); { read in a line }
  139.       {$I+}
  140.       IF Scan(Line,Forwards,EQ,Menu_Delim) < LENGTH(Line) THEN { we've got a new menu }
  141.         BEGIN
  142.           NEW (Temp_Menu_Ptr);
  143.           IF Good_Menu_Line(Line,Temp_Menu_Ptr) THEN
  144.             WITH Temp_Menu_Ptr^ DO
  145.               BEGIN
  146.                 FILLCHAR (Opts,SIZEOF(Opts),CHR(0));
  147.                 Menu_Status := Unused;
  148.                 Exit_Menu_Name := ''; { will modify dynamically }
  149.                 Cur_Opt_Row := 0; { will modify dynamically }
  150.                 Next_Menu_Ptr := NIL;
  151.                 Menu_Scr_Ptr := NIL;
  152.                 IF Head_Menu_Ptr = NIL THEN
  153.                   BEGIN
  154.                     Head_Menu_Ptr := Temp_Menu_Ptr;
  155.                     Head_Menu_Ptr^.Exit_Menu_Name := 'DUMMY'; { never used on head menu }
  156.                   END
  157.                 ELSE
  158.                   Last_Menu_Ptr^.Next_Menu_Ptr := Temp_Menu_Ptr;
  159.                 Last_Menu_Ptr := Temp_Menu_Ptr;
  160.                 Opt_Nbr := 0;
  161.               END;
  162.         END
  163.       ELSE { we've got an option item }
  164.         IF Temp_Menu_Ptr <> NIL THEN
  165.           IF Good_Opt_Line(Line,Temp_Opt) THEN
  166.             BEGIN
  167.               Opt_Nbr := Opt_Nbr + 1;
  168.               IF Opt_Nbr > Max_Nbr_Opts THEN
  169.                 Opt_Nbr := Max_Nbr_Opts;
  170.               Last_Menu_Ptr^.Opts[Opt_Nbr] := Temp_Opt;
  171.             END;
  172.     UNTIL EOF(Menu_File);
  173.     {$I-}
  174.     CLOSE (Menu_File);
  175.     {$I+}
  176.   END;
  177.  
  178.