From:	CSBVAX::MRGATE!RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP 11-OCT-1988 07:05
To:	ARISIA::EVERHART
Subj:	MENU 1 OF 4


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Mon, 10 OCT 88 22:09:29 PDT
Received: from CUNYVM.CUNY.EDU by KL.SRI.COM with TCP; Mon, 10 Oct 88 21:50:47 PDT
Received: from LOYVAX.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.1) with BSMTP id 7356; Mon, 10 Oct 88 23:41:53 EDT
Date:     Mon, 10 Oct 88 23:41 EDT
From:     MARKUS%LOYVAX.BITNET@CUNYVM.CUNY.EDU
Subject:  MENU 1 OF 4
To:       INFO-VAX@KL.SRI.COM
X-Original-To:  INFO-VAX@KL.SRI.COM, MARKUS

$!...................... Cut on the dotted line and save ......................
$! VAX/VMS archive file created by VMS_SHAR V-5.04 04-Feb-1988
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by MARKUS
$! on Monday 10-OCT-1988 23:37:31.14
$!
$! ATTENTION: To keep each article below 15872 bytes, this program
$! has been transmitted in 4 parts.
$! You should concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 6 files:
$! DATABANK.PAS MNU.DOC MNU_DEF.H MNU_DIVIDE.C MNU_MULTI.C MNU_SINGLE.C
$!=============================================================================
$Set Symbol/Scope=(NoLocal,NoGlobal)
$Version=F$GetSYI("VERSION")
$If Version.ges."V4.4" then goto Version_OK
$Write SYS$Output "Sorry, you are running VMS ",Version, -
", but this procedure requires V4.4 or higher."
$Exit 44
$Version_OK:CR[0,8]=13
$Pass_or_Failed="failed!,passed."
$Goto Start
$Convert_File:
$Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1:Define/User_Mode SYS$Output NL:
$Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;
Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1);
ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop
x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
If Current_Character='`' then Move_Horizontal(1);else
Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
$Delete VMS_SHAR_DUMMY.DUMMY;*
$Checksum 'File_is
$Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2:Return
$Start:
$File_is="DATABANK.PAS"
$Check_Sum_is=2001042748
$Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
Xprogram data_menu(input, output, f);
X
Xconst
X   LINE_LEN = 80;
X   NUMBER_OF_LINES = 24;
X   MAX_NUM = 100;
X   NUM_SELECT = 2;
X   JPI$_USERNAME = 514;
X   RMS$_NMF = 99018;
X   RMS$_FNF = 98962;
X   RMS$_NORMAL = 65537;
X   ROOT_DIRECTORY = 'PUBLIC:[DATABASES]';
X   USAGE_FILENAME = ROOT_DIRECTORY + 'USAGE.DAT';
X
Xtype
X   word_type = [word] 0..65535;
X   direction_type = (up, down, left, right, none);
X   str_type = varying[LINE_LEN] of char;
X   menu_type = array[1..MAX_NUM] of str_type;
X   date_time_str_type = packed array[1..11] of char;
X
Xvar
X   directory_match, match, command_line, file_name, file_name_ret : str_type;
X   select : str_type := '?' + ''(26);
X   menu_title, directory_list, program_list, com_list, exe_list: menu_type;
V   i, directory_choice, program_choice, number_directory, number_programs, num
Xber_coms, number_exes, context : integer;
X   help_flag : boolean;
X   f : text;
X   c : char;
X   directory_menu_page_context, directory_menu_column_context,
X   directory_menu_item_context, program_menu_page_context,
X   program_menu_column_context, program_menu_item_context : integer;
X
Xfunction lib$getjpi(%ref item_code : integer;
X                    %ref pid : integer := %immed 0;
X                    %descr pnm : str_type := %immed 0;
X                    %ref out_val : integer := %immed 0;
X                    %descr out_str : str_type := %immed 0;
X                    %ref str_len : word_type := %immed 0) : integer; external;
X
Xfunction lib$find_file(%descr file_name : str_type;
X                       %descr file_found : str_type;
X                       %ref context : integer) : integer; external;
X
Xfunction lib$find_file_end(%ref context : integer) : integer; external;
X
Xfunction lib$spawn(%descr command_line : str_type) : integer; external;
X
Xfunction _mnu_single(%descr title_dsc : menu_type;
X                     %ref   num_title_lines : integer;
X                     %descr menu_dsc : menu_type;
X                     %ref   num_menu_lines, choice : integer;
X                     %descr select_dsc : str_type;
V                     %ref   num_select, current_page, current_column, current_
Xitem : integer) : char; external;
X
Xprocedure get_file_list(    match_string : str_type;
X                        var file_list : menu_type;
X                        var number_files : integer);
Xvar
X   context, status : integer;
Xbegin
X   number_files := 0;
X   context := 0;
X   status := RMS$_NORMAL;
X   while (number_files < MAX_NUM) and (status = RMS$_NORMAL) do begin
V      status := lib$find_file(match_string, file_list[number_files + 1], conte
Xxt);
X      if (status = RMS$_NORMAL) then begin
X         number_files := number_files + 1;
X      end
X   end;
X   lib$find_file_end(context);
Xend;
X
Xprocedure trim_file_list(var file_list : menu_type;
X                         var number_files : integer);
Xvar
X   pos, i : integer;
Xbegin
X   for i := 1 to number_files do begin
X      pos := index(file_list[i], ']');
V      file_list[i] := substr(file_list[i], pos + 1, length(file_list[i]) - pos
X);
X      pos := index(file_list[i], '.');
X      file_list[i] := substr(file_list[i], 1, pos - 1);
X   end
Xend;
X
Xprocedure update_usage(database_name,
X                       program_name : str_type);
Xvar
X   username : str_type;
X   d, t : date_time_str_type;
X   db_name, prg_name : packed array[1..20] of char;
Xbegin
X   if length(database_name) > 20 then begin
X      db_name := substr(database_name, 1, 20);
X   end
X   else begin
X      db_name := database_name;
X   end;
X   if length(program_name) > 20 then begin
X      prg_name := substr(program_name, 1, 20);
X   end
X   else begin
X      prg_name := program_name;
X   end;
X   lib$getjpi(JPI$_USERNAME, , , , username, );
X   date(d); time(t);
X   open(f, USAGE_FILENAME, old, sharing := READWRITE);
X   extend(f);
X   writeln(f, db_name, ' ', prg_name, ' ', username, ' ', d, ' ', t);
X   close(f);
Xend;
X
Xprocedure write_file(var f : text;
X                         file_name : str_type;
X                         num_lines : integer);
Xvar
X   i : integer;
X   line : str_type;
Xbegin
X   i := 0;
X   open(f, file_name, old, sharing := READONLY);
X   reset(f);
X   while not eof(f) do begin
X      readln(f, line);
X      i := i + 1;
X      if (not eof(f)) and (i MOD num_lines = 0) then begin
X         writeln('Press return to continue');
X         readln;
X      end;
X      writeln(line);
X   end;
X   close(f);
Xend;
X
Xbegin
X   directory_match := ROOT_DIRECTORY;
X   match := directory_match + '*.dir';
X   get_file_list(match, directory_list, number_directory);
X   trim_file_list(directory_list, number_directory);
X   directory_menu_page_context := 0;
X   directory_menu_column_context := 0;
X   directory_menu_item_context := 0;
X   repeat
X      menu_title[1] :=
X'                     Loyola College DataBank Access Menu';
X      menu_title[2] :=
X'                                 Main Menu';
X      menu_title[3] :=
X'        <RETURN> to select       ? for help        <CTRL-Z> to exit';
X      menu_title[4] :=
V' These databases are for the use of the Loyola Community and cannot be sold.'
X;
V      c := _mnu_single(menu_title, 4, directory_list, number_directory, direct
Xory_choice,
X                       select, NUM_SELECT, directory_menu_page_context,
X                       directory_menu_column_context,
X                       directory_menu_item_context);
X      if (c = '?') then begin
V         file_name := ROOT_DIRECTORY + directory_list[directory_choice + 1] +
X'.TXT';
X         context := 0;
V         if lib$find_file(file_name, file_name_ret, context) = RMS$_NORMAL the
Xn begin
X            lib$find_file_end(context);
X            write_file(f, file_name, NUMBER_OF_LINES-1);
X            writeln('Press return to continue.');
X            readln;
X         end
X         else begin
X            lib$find_file_end(context);
X            writeln('Sorry.  No help available at this time.');
X            writeln('Press return to continue.');
X            readln;
X         end
X      end
X      else if (c <> ''(26)) then begin
V         directory_match := substr(ROOT_DIRECTORY, 1, length(ROOT_DIRECTORY) -
X 1) + '.' + directory_list[directory_choice + 1] + ']';
X         match := directory_match + '*.exe';
X         get_file_list(match, exe_list, number_exes);
X         trim_file_list(exe_list, number_exes);
X         match := directory_match + '*.com';
X         get_file_list(match, com_list, number_coms);
X         trim_file_list(com_list, number_coms);
X         for i := 1 to number_exes do begin
X            program_list[i] := exe_list[i];
X         end;
X         for i := number_exes + 1 to number_exes + number_coms do begin
X            program_list[i] := com_list[i - number_exes];
X         end;
X         number_programs := number_exes + number_coms;
X         program_menu_page_context := 0;
X         program_menu_column_context := 0;
X         program_menu_item_context := 0;
X         menu_title[2] :=
V'                                ' + directory_list[directory_choice + 1] + '
XMenu';
X         repeat
X            c := _mnu_single(menu_title, 4, program_list, number_programs,
V                             program_choice, select, NUM_SELECT, program_menu_
Xpage_context,
X                                                program_menu_column_context,
X                                                program_menu_item_context);
X            if (c = '?') then begin
V               file_name := directory_match + program_list[program_choice + 1]
X + '.TXT';
X               context := 0;
V               if lib$find_file(file_name, file_name_ret, context) = RMS$_NORM
XAL then begin
X                  lib$find_file_end(context);
X                  write_file(f, file_name, NUMBER_OF_LINES-1);
X                  writeln('Press return to continue.');
X                  readln;
X               end
X               else begin
X                  lib$find_file_end(context);
X                  writeln('Sorry.  No help available at this time.');
X                  writeln('Press return to continue.');
X                  readln;
X               end
X            end
V            else if (c <> ''(26)) and (program_choice < number_exes) then begi
Xn
V               update_usage(directory_list[directory_choice + 1], program_list
X[program_choice + 1]);
V               command_line := '$ run ' + directory_match + program_list[progr
Xam_choice + 1] + '.EXE';
X               lib$spawn(command_line);
X               writeln('Press return to continue.');
X               readln;
X            end
V            else if (c <> ''(26)) and (program_choice >= number_exes) and (pro
Xgram_choice < number_exes + number_coms) then begin
V               update_usage(directory_match, program_list[program_choice + 1])
X;
V               command_line := '@' + directory_match + program_list[program_ch
Xoice + 1] + '.COM';
X               lib$spawn(command_line);
X               writeln('Press return to continue.');
X               readln;
X            end
X         until (c = ''(26));
X         c := ''(0);
X      end
X   until (c = ''(26));
Xend.
$GoSub Convert_File
$Goto Part2

