Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/EXECMENU.ZIP/EXECMENU.PAS

Pascal/Delphi Source File | 1988-04-08 | 47.6 KB | 1,076 lines

{$R-}
{$B+}
{$S+}
{$I+}
{$N-}
{$M 16384,0,65635}


PROGRAM executive_menu;

uses Crt,
     Dos,
     Graph;

     CONST                      {1234567890123456789012345678901234567890}
          filler           =    '                                        ';
          drive            =    'C:' ;  { drive for bat files }
          max_batch        =    10;    { max number of lines in the batch file }
          max_menus        =    8;     { max number of menus }
          max_options      =    8;     { max number of options per menu }
          max_text_len     =    40;    { max length of each text line in .DEF file }
          bat_filename     =    'temp.bat';   { temporary batch file name }
          menu_filename    =    'execmenu.def';   { the menu definition file }

     TYPE
          line             =    STRING [80] ; { gp line length }
          string6          =    STRING [6] ; { for good time and good date functions }
          string9          =    STRING [9] ; { for fulldate function }
          entry            =    STRING [max_text_len] ; { for strings from .DEF file }
          video_code       =    INTEGER;

     VAR
          menufile         :    TEXT ;  { the .DEF file }
          menus            :    ARRAY [1..max_menus,0..max_options] OF entry ;
          helps            :    ARRAY [1..max_menus,1..max_options] OF entry ;
          pw               :    ARRAY [1..max_menus,1..max_options] OF STRING [30] ;
          password         :    STRING [30] ; { user input }
          pw_ok            :    BOOLEAN ;
          num_menus        :    0..max_menus ;
          current_menu     :    0..max_menus ;
          menu_option      :    0..max_options ;
          num_options      :    ARRAY [0..max_menus] OF 0..max_options ;
          tempbatfile      :    TEXT ;  { performs bat cmds then calls autobat }
          bats             :    ARRAY [1..max_menus,1..max_options,1..max_batch] OF entry;
          oldtime          :    STRING [8] ;
          time             :    STRING [8] ;
          date             :    STRING [9] ;
          olddate          :    STRING [9] ;
          doit             :    BOOLEAN ;
          lpoint           :    STRING [2] ;
          cursor           :    CHAR;
          i                :    INTEGER;
          ch               :    CHAR ;
          dummy            :    char;
          GRAPHICSMODE     :    integer;
          LAST_OPTION_FILE :    text;


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}


     procedure check_for_graphics;

          var
            GRAPHMODE : integer;

        begin
            GRAPHICSMODE:=0;       {DETECT}
            DetectGraph (GRAPHICSMODE, GRAPHMODE);
          end;

{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

    procedure set_video (code:video_code);

          begin
            case GRAPHICSMODE of
                    1 : begin                    {CGA graphics adaptor}
                           case code of
                            0 :  begin        {off}
                                    Textcolor (blue);
                                    Textbackground (blue);
                                end;
                                  1 :  begin        {normal}
                                            Textcolor (white);
                                            Textbackground (blue);
                                       end;
                                  2 :  begin        {highlighted}
                                            Textcolor (white);
                                            Textbackground (cyan);
                                       end;
                                  3 :  begin        {important one}
                                            Textcolor (lightred);
                                            Textbackground (white);
                                       end;
                                  4 :  begin        {real important one}
                                            Textcolor (white);
                                            Textbackground (red);
                                       end;
                                 end;
                      end;
             2,3,4,9,10 : begin                    {MCGA, EGA, EGA64, VGA, and PC3270 graphics adaptors}
                               case code of
                            0 :  begin        {off}
                                    Textcolor (blue);
                                    Textbackground (blue);
                                end;
                                  1 :  begin        {normal}
                                            Textcolor (white);
                                            Textbackground (blue);
                                       end;
                                  2 :  begin        {highlighted}
                                            Textcolor (red);
                                            Textbackground (white);
                                       end;
                                  3 :  begin        {important one}
                                            Textcolor (lightred);
                                            Textbackground (blue);
                                       end;
                                  4 :  begin        {real important one}
                                            Textcolor (yellow);
                                            Textbackground (red);
                                       end;
                                 end;
                      end;
                                             else   begin                    {NO graphics adaptor or not supported}
                           case code of
                            0 :  begin        {off}
                                    Textcolor (black);
                                    Textbackground (black);
                                end;
                                  1 :  begin        {normal}
                                            Textcolor (white);
                                            Textbackground (black);
                                       end;
                                  2 :  begin        {reverse}
                                            Textcolor (black);
                                            Textbackground (white);
                                       end;
                                  3 :  begin        {normal blink}
                                            Textcolor (white+blink);
                                            Textbackground (black);
                                       end;
                                  4 :  begin        {reverse blink}
                                            Textcolor (black+blink);
                                            Textbackground (white);
                                       end;
                                 end;
                       end;
               end;
          end;


{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}

    procedure set_change_video (code:video_code);

          begin
            case GRAPHICSMODE of
                    1 : begin                    {CGA graphics adaptor}
                           case code of
                                  10 :  begin
                                            Textcolor (black);
                                            Textbackground (blue);
                                       end;
                                  11 :  begin
                                            Textcolor (red);
                                            Textbackground (blue);
                                       end;
                                  12 :  begin
                                            Textcolor (green);
                                            Textbackground (white);
                                       end;
                                  13 :  begin
                                            Textcolor (white);
                                            Textbackground (blue);
                                       end;
                                 end;
                      end;
             2,3,4,9,10 : begin                    {MCGA, EGA, EGA64, VGA, and PC3270 graphics adaptors}
                               case code of
                            0 :  begin        {off}
                                    Textcolor (blue);
                                    Textbackground (blue);
                                end;
                                  1 :  begin
                                            Textcolor (black);
                                            Textbackground (blue);
                                       end;
                                  2 :  begin
                                            Textcolor (lightgreen);
                                            Textbackground (blue);
                                       end;
                                  3 :  begin
                                            Textcolor (red);
                                            Textbackground (blue);
                                       end;
                                  4 :  begin
                                            Textcolor (yellow);
                                            Textbackground (blue);
                                       end;
                                  5 :  begin
                                            Textcolor (cyan);
                                            Textbackground (blue);
                                       end;
                                  6 :  begin
                                            Textcolor (lightred);
                                            Textbackground (blue);
                                       end;
                                  7 :  begin
                                            Textcolor (lightgray);
                                            Textbackground (blue);
                                       end;
                                  8 :  begin
                                            Textcolor (lightmagenta);
                                            Textbackground (blue);
                                       end;
                                  9 :  begin
                                            Textcolor (brown);
                                            Textbackground (blue);
                                       end;
                                 10 :  begin
                                            Textcolor (lightblue);
                                            Textbackground (blue);
                                       end;
                                 11 :  begin
                                            Textcolor (magenta);
                                            Textbackground (blue);
                                       end;
                                 12 :  begin
                                            Textcolor (lightcyan);
                                            Textbackground (blue);
                                       end;
                                 13 :  begin
                                            Textcolor (green);
                                            Textbackground (blue);
                                       end;
                                 14 :  begin
                                            Textcolor (darkgray);
                                            Textbackground (blue);
                                       end;
                                 15 :  begin
                                            Textcolor (white);
                                            Textbackground (blue);
                                       end;
                                 21 :  begin
                                            Textcolor (black);
                                            Textbackground (white);
                                       end;
                                 22 :  begin
                                            Textcolor (lightgreen);
                                            Textbackground (white);
                                       end;
                                 23 :  begin
                                            Textcolor (red);
                                            Textbackground (white);
                                       end;
                                 24 :  begin
                                            Textcolor (yellow);
                                            Textbackground (white);
                                       end;
                                 25 :  begin
                                            Textcolor (cyan);
                                            Textbackground (white);
                                       end;
                                 26 :  begin
                                            Textcolor (lightred);
                                            Textbackground (white);
                                       end;
                                 27 :  begin
                                            Textcolor (blue);
                                            Textbackground (white);
                                       end;
                                 28 :  begin
                                            Textcolor (lightmagenta);
                                            Textbackground (white);
                                       end;
                                 29 :  begin
                                            Textcolor (brown);
                                            Textbackground (white);
                                       end;
                                 30 :  begin
                                            Textcolor (lightblue);
                                            Textbackground (white);
                                       end;
                                 31 :  begin
                                            Textcolor (magenta);
                                            Textbackground (white);
                                       end;
                                 32 :  begin
                                            Textcolor (lightcyan);
                                            Textbackground (white);
                                       end;
                                 33 :  begin
                                            Textcolor (green);
                                            Textbackground (white);
                                       end;
                                 34 :  begin
                                            Textcolor (darkgray);
                                            Textbackground (white);
                                       end;
                                 35 :  begin
                                            Textcolor (white);
                                            Textbackground (white);
                                       end;
                                 end;
                      end;

               end;
          end;

{-----------------------------------------------------------------------}

          function gooddate: string6;

               { Returns a 6 character STRING WITH the date in the format: YYMMDD      }

               TYPE
                     Registers   =   RECORD
                                         ax,bx,cx,dx,bp,si,di,ds,es,flags: word;
                                   END;

               VAR
                    recpack            : Registers;
                    aday, amonth, ayear: STRING[2];
                    day,month          : BYTE;
                    year               : INTEGER;

               BEGIN
                    recpack.ax := $2a shl 8;
                    MsDos(Dos.Registers(recpack));
                    year:=recpack.cx;
                    day:=recpack.dx mod 256;
                    month:=recpack.dx shr 8;
                    year:=year-1900;
                    STR(day:2,aday); STR(month:2,amonth); STR(year:2,ayear);
                    IF day <10 THEN aday :='0'+aday[2];
                    IF month<10 THEN amonth:='0'+amonth[2];
                    IF year<10 THEN ayear:='0'+ayear[2];
                    gooddate:= ayear + amonth + aday;
               END;

{----------------------------------------------------------------------}

          function goodtime: string6;

               {returns the an 6 character string with the time in the format:
                HHMMSS, with leading zeros when needed.}

               TYPE
                    Registers = record
                                    ax,bx,cx,dx,bp,si,di,ds,es,flags: word;
                              end;

               VAR
                    recpack      : Registers;                {record for MsDos call}
                    yst          : string[4];
                    mst,dst      : string[2];
                    ahr,amin,asec: string[2];
                    hr,min,sec   : BYTE;

               BEGIN
                    with recpack do
                        begin
                             ax := $2c shl 8;
                        end;
                    MsDos(Dos.Registers(recpack));                        { call function }
                    with recpack do
                        begin
                             sec:=dx shr 8;
                             min:=cx mod 256;
                             hr:=cx shr 8;
                        end;
                   str(hr:2,  ahr);
                   str(min:2, amin);
                   str(sec:2, asec);
                   if hr <10 then ahr :='0'+copy(ahr, 2,1);
                   if min<10 then amin:='0'+copy(amin,2,1);
                   if sec<10 then asec:='0'+copy(asec,2,1);
                   goodtime:=ahr + amin + asec;
               END;

{-------------------------------------------------------------------------}

     FUNCTION fulldate : string9;

          CONST
               months  :    Array [1..12] Of String[3] =  ('JAN','FEB','MAR','APR','MAY','JUN',
                                                           'JUL','AUG','SEP','OCT','NOV','DEC');

          VAR
               tmp     :    String[9];
               i,j     :    Integer;

          BEGIN
               tmp := gooddate;
               Val (Copy (tmp,3,2),i,j);
               fulldate := tmp[5] + tmp[6] + ' ' + months[i] + ' ' + tmp[1] + tmp[2];
          END;

{*--------------------------------------------------------------------------*}

PROCEDURE read_definition_file;

     CONST                      {12345678901234567890123456789012345678901234567890}
          spaces           =    '                                        ' ;

     VAR
          i,j,k,l          :    INTEGER;
          num_menu_counter :    integer;
          num_options_counter:  integer;
          num_batch_counter:    integer;
          code,ch          :    CHAR;
          temp             :    line ;
          num_bat_lines    :    INTEGER ;

     BEGIN
          ASSIGN (menufile,drive+menu_filename) ;
          RESET (menufile);
          num_bat_lines := 0 ;
          num_menus := 0;
          FOR num_menu_counter := 1 TO max_menus DO
            BEGIN
                 num_options[num_menu_counter] := 0;
                 FOR num_options_counter := 0 TO max_options DO
                    menus [num_menu_counter,num_options_counter] :=  '';
                 FOR num_options_counter := 1 TO max_options DO
                    BEGIN
                         pw [num_menu_counter,num_options_counter] := '' ;
                         helps [num_menu_counter,num_options_counter] := '' ;
                         FOR num_batch_counter := 1 TO max_batch DO
                            bats [num_menu_counter,num_options_counter,num_batch_counter] := '' ;
                    END;
            END;
          num_bat_lines:=0;
          num_menus:=0;
          num_options[1]:=0;
          WHILE NOT EOF(menufile) DO
            BEGIN
                 READ (menufile,code);
                 while (code = '.') do
                    begin
                         READLN (menufile);
                         Read (menufile,code);
                    end;
                 temp := '';
                 WHILE NOT EOLN(menufile) DO
                      BEGIN
                           READ (menufile,ch) ;
                           temp := temp + ch ;
                      END ;
                 READLN (menufile) ;
                 case code of
                   '+': BEGIN
                             num_bat_lines := num_bat_lines + 1 ;
                             bats [num_menus,num_options[num_menus],num_bat_lines] := temp ;
                        END;
                   '%': BEGIN
                             num_menus := num_menus + 1 ;
                             menus [num_menus,0] := temp ;
                        END;
                   '*': BEGIN
                             num_bat_lines := 0 ;
                             num_options[num_menus] := num_options[num_menus] + 1 ;
                             menus [num_menus,num_options[num_menus]] := temp ;
                        END;
                   '?': helps [num_menus,num_options[num_menus]] := temp;
                   '^': pw [num_menus,num_options[num_menus]] := temp ;
                   end; {of case statement}
            END;  { while not eof menufile }
            CLOSE (menufile);
       FOR i := 1 TO num_menus DO  {center title and help lines }
          BEGIN
               l := (max_text_len - LENGTH (menus[i,0])) DIV 2 ;
               menus[i,0] := COPY (spaces,1,l) + menus[i,0] + spaces ;
               FOR j := 1 TO num_options[i] DO
                  BEGIN
                       l := (max_text_len - LENGTH (helps[i,j])) DIV 2 ;
                       helps[i,j] := COPY (spaces,1,l) + helps[i,j] + spaces ;
                  END ;
          END ;
     END;

{-----------------------------------------------------------------------}

     PROCEDURE display_borders;

          VAR
               i       :    INTEGER ;
               x,q     :    INTEGER;
               g       :    INTEGER;
               l,lf,rt :    INTEGER;

          BEGIN
               set_video(1);
               CLRSCR ;
               GotoXY(5,1);
               WRITE('╔') ;
               FOR q := 6 TO 74 DO
                   WRITE('═');
               WRITE('╗');
               GOTOXY (5,2);
               WRITE('║  ');
               set_video(2);
               GOTOXY (24,2);
               WRITE (' POINT AND SHOOT MENU SYSTEM ');
               set_video(1);
               GOTOXY (75,2);
               WRITE('║');
               GOTOXY (5,3);
               WRITE('╠');
               FOR q := 6 TO 74 DO
               WRITE('═');
               WRITE('╣');
               FOR q := 4 TO 21 DO
                  BEGIN
                       GotoXY(5,q);
                       WRITE('║');
                       GotoXY(75,q);
                       WRITE('║');
                  END;
               GOTOXY (5,22);
               WRITE('╠');
               FOR q := 6 TO 18 DO
                  WRITE('═');
               WRITE('╡');
               GOTOXY (60,22);
               WRITE ('╞');
               FOR q := 61 TO 74 DO
                  WRITE('═');
               WRITE ('╣');
               GotoXY(5,23);
               WRITE('║');
               GotoXY(75,23);
               WRITE('║');
               GotoXY(5,24);
               WRITE('╚');
               FOR q := 6 TO 74 DO
                  WRITE('═');
               WRITE('╝');
               WINDOW (6,4,74,23);
          END;

{---------------------------------------------------------------------------------------------------------------------------}

          procedure display_borders_through_color (in_color:integer);

               VAR
                    q       :    integer;

               begin
                    window (1,1,80,25);
                set_change_video(in_color);
                    GotoXY(5,1);
                    write('╔');
                    for q := 6 TO 74 do
                        write('═') ;
                    write('╗');
                    GotoXY (5,2);
                    write('║  ');
                    GotoXY (24,2);
                set_change_video(in_color+20);
                    WRITE (' POINT AND SHOOT MENU SYSTEM ');
                set_change_video(in_color);
                    GotoXY (75,2);
                    write('║');
                    GotoXY (5,3);
                    write('╠');
                    for q := 6 TO 74 do
                        write('═');
                    write('╣') ;
                    for q := 4 TO 21 do
                       begin
                            GotoXY (5,q);
                            write ('║');
                            GotoXY (75,q);
                            write ('║');
                       end;
                    GotoXY (5,22);
                    write ('╠');
                    for q := 6 TO 18 do
                       write('═');
                    write ('╡');
                    GotoXY (60,22);
                    write ('╞');
                    for q := 61 TO 74 do
                       write ('═');
                    write ('╣');
                    GotoXY (5,23);
                    write ('║');
                    GotoXY (75,23);
                    write ('║');
                    GotoXY (5,24);
                    write ('╚');
                    for q := 6 TO 74 do
                       write ('═');
                    write ('╝');
                    window (6,4,74,23) ;
                    GOTOXY (29,20) ;
                    WRITE ('MENU ',current_menu:1,' OF ',num_menus:1) ;
               end;

{-----------------------------------------------------------------------}

     PROCEDURE print_help ;             { print the help line }

          BEGIN
               GOTOXY (15,19);
               set_video(2);
               WRITE (helps [current_menu,menu_option]);
               set_video(1);
          END ;

{-----------------------------------------------------------------------}

     PROCEDURE display_menu;

          VAR
             i   :    INTEGER ;

          BEGIN
               WINDOW  (6,4,74,21);
               set_video(1);
               CLRSCR ;
               TEXTCOLOR (yellow) ;
               GOTOXY (14,1);
               WRITE (menus[current_menu,0]);
               set_video(1);
               FOR i :=  1 TO (num_options[current_menu])  DO
                  BEGIN
                       if menus[current_menu,i]<>menus[current_menu,0]
                         then begin
                                   GOTOXY (22,i*2+1);
                                   WRITE (i:2,' - ',menus[current_menu,i]) ;
                              end;
                  END;
               WINDOW (6,4,74,23);
               GOTOXY (29,20) ;
               WRITE ('MENU ',current_menu:1,' OF ',num_menus:1) ;
               print_help ;
          END;

{-----------------------------------------------------------------------}

     PROCEDURE point ;

          BEGIN
               GotoXY(20,(menu_option)*2+1);  {12}
               set_video(3);
               WRITE ('  ',menu_option:2,' - ',menus[current_menu,menu_option]+'   ') ;
          END ;

{-----------------------------------------------------------------------}

     PROCEDURE clear_point ;

          BEGIN
               GotoXY (20,(menu_option)*2+1);
               set_video(1);
               write ('  ',menu_option:2,' - ',menus[current_menu,menu_option]+'   ');
          END ;

{-----------------------------------------------------------------------}

          procedure see_what;

               var
                    OPTION_HOLDER    : integer;
                    FIRST_CHARACTER  : char;
                    SECOND_CHARACTER : char;

               begin
                set_video(1);
                    FIRST_CHARACTER:=' ';
                    SECOND_CHARACTER:=' ';
                FIRST_CHARACTER:=ReadKey;
                    FIRST_CHARACTER:=chr(ord(FIRST_CHARACTER));
                    i := ORD (FIRST_CHARACTER) - ORD ('0') ;
                    IF i IN [1..num_options[current_menu]]
                       THEN BEGIN
                                 doit := TRUE ;
                                 clear_point ;
                                 menu_option := i ;
                                 point ;
                            END
                    else case FIRST_CHARACTER of
                           #13 : begin
                                      if (SECOND_CHARACTER=#0)
                                         then begin
                                                   FIRST_CHARACTER:=SECOND_CHARACTER;
                                                   SECOND_CHARACTER:=ReadKey;
                                              end;
                                 end;
                           #0  : begin
                                      SECOND_CHARACTER:=ReadKey;
                                      OPTION_HOLDER:=0;
                                      case SECOND_CHARACTER of
                                       #80 : begin                        {down arrow}
                                                  clear_point;
                                                  OPTION_HOLDER:=menu_option+1;
                                                  if OPTION_HOLDER > num_options[current_menu]
                                                     then menu_option:=1
                                                     else menu_option:=OPTION_HOLDER;
                                                  point;
                                             end;
                                       #72 : begin                        {up arrow}
                                                  clear_point;
                                                  menu_option:= menu_option-1;
                                                  if menu_option < 1
                                                     then menu_option := num_options[current_menu];
                                                  point;
                                             end;
                               #77,#68,#73 : begin                       {right arrow,F10,pgup}
                                                  current_menu := (current_menu MOD num_menus) + 1;
                                                  display_menu;
                                                  menu_option := 1;
                                                  point;
                                              END ;
                                #75,#67,#81 : begin                      {left arrow,f9,pgdn}
                                                   current_menu := current_menu - 1;
                                                   IF current_menu < 1
                                                   THEN current_menu := num_menus;
                                                   display_menu;
                                                   menu_option := 1;
                                                   point;
                                              END;
                                       #71 : begin                        {home}
                                                  clear_point;
                                                  current_menu:=1;
                                                  display_menu;
                                                  menu_option:=1;
                                                  point;
                                             END;
                                       #79 : begin                        {end}
                                                  clear_point;
                                                  current_menu:=num_menus;
                                                  display_menu;
                                                  menu_option:=1;
                                                  point;
                                             END;
                                       #71 : begin                        {home}
                                                  clear_point;
                                                  menu_option:=1;
                                                  point;
                                             end;
                                       #79 : begin                        {end}
                                                  clear_point;
                                                  menu_option:=num_options[current_menu];
                                                  point;
                                             end;
                                       #59 : begin                        {F1}
                                                  IF 1 IN [1..num_options[current_menu]]
                                                     THEN BEGIN
                                                               doit := TRUE;
                                                               clear_point;
                                                               menu_option := 1;
                                                               point;
                                                          END;
                                             end;
                                       #60 : begin                        {F2}
                                                  IF 2 IN [1..num_options[current_menu]]
                                                     THEN BEGIN
                                                               doit := TRUE;
                                                               clear_point;
                                                               menu_option := 2;
                                                               point;
                                                          END;
                                             end;
                                       #61 : begin                        {F3}
                                                  IF 3 IN [1..num_options[current_menu]]
                                                     THEN BEGIN
                                                               doit := TRUE;
                                                               clear_point;
                                                               menu_option := 3;
                                                               point;
                                                          END;
                                             end;
                                       #62 : begin                        {F4}
                                                  IF 4 IN [1..num_options[current_menu]]
                                                     THEN BEGIN
                                                               doit := TRUE;
                                                               clear_point;
                                                               menu_option := 4;
                                                               point;
                                                          END;
                                             end;
                                       #63 : begin                        {F5}
                                                  IF 5 IN [1..num_options[current_menu]]
                                                     THEN BEGIN
                                                               doit := TRUE;
                                                               clear_point;
                                                               menu_option := 5;
                                                               point;
                                                          END;
                                             end;
                                       #64 : begin                        {F6}
                                                  IF 6 IN [1..num_options[current_menu]]
                                                     THEN BEGIN
                                                               doit := TRUE;
                                                               clear_point;
                                                               menu_option := 6;
                                                               point;
                                                          END;
                                             end;
                                       #65 : begin                        {F7}
                                                  IF 7 IN [1..num_options[current_menu]]
                                                     THEN BEGIN
                                                               doit := TRUE;
                                                               clear_point;
                                                               menu_option := 7;
                                                               point;
                                                          END;
                                             end;
                                       #66 : begin
                                                  IF 8 IN [1..num_options[current_menu]]
                                                     THEN BEGIN
                                                               doit := TRUE;
                                                               clear_point;
                                                               menu_option := 8;
                                                               point;
                                                          END;
                                             end;
                                        end; {of 2nd case statement}
                                 end; {of #0 statement}
                         end;  {of 1st case statement}
                    if FIRST_CHARACTER = #13
                       then doit := TRUE
                       else begin
                                 doit := FALSE;
                                 print_help;
                                 GotoXY (2,10);
                           set_video(0);
                                 write (' ');
                                 GotoXY (2,10);
                            end;
               end;

{---------------------------------------------------------------------------------------------------------------------------}

     PROCEDURE write_batch_file ;

          VAR
               i    :    INTEGER ;

          BEGIN
               ASSIGN (tempbatfile,drive+bat_filename) ;
               REWRITE (tempbatfile) ;
               FOR i := 1 TO max_batch DO
                   IF bats [current_menu,menu_option,i] <> '' THEN
                   WRITELN (tempbatfile,bats [current_menu,menu_option,i]);
               CLOSE (tempbatfile) ;
          END;

{-----------------------------------------------------------------------}

     PROCEDURE startup_the_clock;

          BEGIN
               time := goodtime;
               INSERT (':',time,3);
               INSERT (':',time,6);
               GOTOXY (59,20);
               set_video(1);
               WRITE (time);
               DATE:=FULLDATE;
               OLDDATE:=DATE;
               GOTOXY (3,20);
               WRITE (date);
               oldtime := goodtime ;
          END;

{-----------------------------------------------------------------------}

     PROCEDURE update_clock;

          BEGIN
               time := goodtime;
               DATE := FULLDATE;
               IF time <> oldtime
                  THEN BEGIN
                            INSERT (':',time,3);
                            INSERT (':',time,6);
                            GOTOXY (59,20);
                            set_video(1);
                            WRITE (time);
                            IF DATE <> OLDDATE
                               THEN BEGIN
                                         GOTOXY (3,20);
                                         WRITE (DATE);
                                         OLDDATE:=DATE;
                                    END;
                            oldtime := goodtime;
                            GOTOXY (2,10);
                            set_video(0);
                            WRITE (' ');
                            GOTOXY (2,10);
                       END;
          END;

{-----------------------------------------------------------------------}

     PROCEDURE do_password ;

          BEGIN
               TEXTCOLOR (WHITE);
               password := '';
               WRITE (CHR(7),CHR(7));
               GOTOXY (2,20);
               WRITE ('  ENTER PASSWORD  ');
               GOTOXY (22,20);
               TEXTBACKGROUND (LIGHTMAGENTA);
               TEXTCOLOR (BLACK);
               WRITE ('>');
               TEXTCOLOR (YELLOW);
               WRITE ('.............................. ') ;
               GOTOXY (23,20);
               TEXTCOLOR (CYAN);
               ch:=ReadKey;
               WHILE ch <> CHR (13) DO
                    BEGIN
                         WRITE ('*') ;
                         password := password + UPCASE (ch) ;
                         ch:=ReadKey;
                    END ;
              pw_ok := (password = pw [current_menu,menu_option]);
              IF NOT pw_ok
                 THEN BEGIN
                           doit := FALSE;
                           TEXTBACKGROUND (LIGHTMAGENTA);
                           GOTOXY (23,20);
                           TEXTCOLOR (CYAN+BLINK);
                           WRITE ('      INCORRECT PASSWORD      ');
                           WRITE (CHR(7),CHR(7));
                           DELAY (500);
                           WRITE (CHR(7),CHR(7));
                           DELAY (3000);
                      END
                 ELSE
                      BEGIN
                           GOTOXY (23,20);
                           WRITE ('      PASSWORD ACCEPTED       ');
                           DELAY (2000);
                      END;
               set_video(1);
               GOTOXY (2,20);
               WRITE (' ':56);
               gotoxy (2,20);
               oldtime := '';
               update_clock;
               if NOT pw_ok
                 then begin
                           display_menu;
                           point;
                      end;
          END;

{-----------------------------------------------------------------------}

     PROCEDURE hide_the_cursor;

          begin
               set_video(0);
               GotoXY (2,2);
               write (' ');
               GotoXY (2,2);
          end;

{----------------------------------------------------------------------}

     PROCEDURE monitor_menu;

          var
               COUNTER : integer;

          BEGIN
               COUNTER:=1;
               REPEAT
                     IF KEYPRESSED
                        THEN BEGIN
                                  see_what;
                                  IF doit
                                     THEN BEGIN
                                               pw_ok := TRUE;
                                               IF pw [current_menu,menu_option] <> ''
                                                  THEN do_password;
                                               IF pw_ok
                                                  THEN BEGIN
                                                            write_batch_file;
                                                            GotoXY (1,25);
                                                            write ('Batchfile being written');
                                                            EXIT ;  { exit to complete the last command in auto.bat }
                                                       END;
                                          END;
                             END
                        ELSE begin
                                       update_clock;
                                       case GRAPHICSMODE of
                                        1,2,3,4,9,10 : begin
                                                            if ((COUNTER = 2000) or
                                                                (COUNTER = 4000) or (COUNTER = 6000) or
                                                                (COUNTER = 8000) or (COUNTER = 10000) or
                                                                (COUNTER = 12000) or (COUNTER = 14000) or
                                                                (COUNTER = 16000) or (COUNTER = 18000) or
                                                                (COUNTER = 20000) or (COUNTER = 22000) or
                                                                (COUNTER = 24000) or (COUNTER = 26000) or
                                                                (COUNTER = 28000) or (COUNTER = 30000))
                                                                then begin
                                                                          display_borders_through_color (COUNTER div 2000);
                                                                          hide_the_cursor;
                                                                     end;
                                                            if COUNTER=32000
                                                               then COUNTER:=2000
                                                               else inc(COUNTER);
                                                       end;
                                       end;
                            END;
               UNTIL FALSE ;  { do forever ... }
          END ;

{-----------------------------------------------------------------------}

     PROCEDURE all_done;

          BEGIN
               rewrite (LAST_OPTION_FILE);
               writeln (LAST_OPTION_FILE,current_menu);
               writeln (LAST_OPTION_FILE,menu_option);
               set_video(1);
               Window (1,1,80,25);
               CLRSCR;
          END ;

{-----------------------------------------------------------------------}

     PROCEDURE setup;

          BEGIN
               oldtime := '';     { used to see if its time to update the clock }
               current_menu := 1;
               menu_option := 1;
               lpoint := '═' + CHR (16);  { the pointer }
               doit := FALSE;
          END;

{-----------------------------------------------------------------------}
{                       M A I N   P R O G R A M                         }
{-----------------------------------------------------------------------}

BEGIN
     Assign (LAST_OPTION_FILE,'LASTEXEC.DAT');
     {$I-}
     Reset (LAST_OPTION_FILE);
     {$I+}
     if IOresult=0
        then begin
                  Readln (LAST_OPTION_FILE,current_menu);
                  Readln (LAST_OPTION_FILE,menu_option);
             end
        else begin
                  current_menu:=1;
                  menu_option:=1;
             end;
     check_for_graphics;
     read_definition_file;
     display_borders;
     startup_the_clock;
     display_menu;
     point ;
     hide_the_cursor;
     monitor_menu ;
     all_done ;
     close (LAST_OPTION_FILE);
END.

{-----------------------------------------------------------------------}