home *** CD-ROM | disk | FTP | other *** search
- -- ADA_TUTR.ADA Ver. 2.02 4-SEP-1992 Copyright 1988-1992 John J. Herro
- -- Software Innovations Technology
- -- 1083 Mandarin Drive NE, Palm Bay, FL 32905-4706 (407)951-0233
- --
- -- Before compiling this file, you must compile ONE of the following:
- --
- -- JANUS.ADA Recommended when using a PC with Janus/Ada.
- -- MERIDIAN.ADA Recommended when using a PC with a Meridian Ada compiler
- -- and the Meridian DOS Environment Library.
- -- UNIX.ADA Recommended for UNIX based systems, if you can also
- -- compile ONECHAR.C or ALTCHAR.C with a C compiler and
- -- link with Ada.
- -- VAX.ADA Recommended when using VAX Ada.
- -- VANILLA.ADA "Plain vanilla" version for all other systems. Should work
- -- with ANY standard Ada compiler. On some systems,
- -- VANILLA.ADA may require you to strike ENTER after each
- -- response. However, you don't have to strike ENTER with
- -- recent versions of TeleGen Ada by Telesoft.
- --
- -- See the PRINT.ME file for more information on installing ADA-TUTR on other
- -- computers.
- --
- --
- -- Before Running ADA-TUTR on a PC:
- --
- -- ADA-TUTR uses ANSI escape sequences for highlighting, cursor positioning,
- -- reverse video, etc. Before ADA-TUTR will work correctly on a PC, you must
- -- install the device driver ANSI.SYS, which came with your copy of DOS. To
- -- install ANSI.SYS, do the following:
- --
- -- 1. If there's a file CONFIG.SYS in the root directory of the disk from
- -- which you boot, type it and look for a line saying "DEVICE=ANSI.SYS"
- -- (without the quotes), in either upper or lower case. If that line isn't
- -- present, add it to CONFIG.SYS anywhere in the file, using an ordinary
- -- text editor or word processor in the non-document mode. If there's no
- -- CONFIG.SYS file, create one containing the single line "DEVICE=ANSI.SYS"
- -- (without the quotes).
- --
- -- 2. If there's no file ANSI.SYS in your root directory, copy ANSI.SYS from
- -- your DOS distribution diskette to the root directory of the disk from
- -- which you boot.
- --
- -- 3. Reboot the computer. ADA-TUTR should then work correctly.
- --
-
- -- Introduction:
- --
- -- ADA-TUTR provides interactive instruction in the Ada programming language,
- -- allowing you to learn at your own pace. On a PC, access to an Ada compiler
- -- is helpful, but not required. You can exit this program at any time by
- -- striking X, and later resume the session exactly where you left off. If you
- -- have a color monitor, you can set the foreground, background, and border
- -- colors at any time by typing S.
- --
- -- ADA-TUTR presents a screenful of information at a time. Screens are read
- -- in 64-byte blocks from the random access file ADA_TUTR.DAT, using DIRECT_IO.
- -- For most screens, ADA-TUTR waits for you to strike one character to
- -- determine which screen to show next. Screens are numbered starting with
- -- 101; each screen has a three-digit number. Screens 101 through 108 have
- -- special uses, as follows:
- --
- -- 101 - This screen is presented when you complete the Ada course. It
- -- contains a congratulatory message. After this screen is shown,
- -- control returns directly to the operating system; the program doesn't
- -- wait for you to strike a character.
- -- 102 - This screen is presented when you exit ADA-TUTR before completing the
- -- course. After this screen is shown, control returns directly to the
- -- operating system; the program doesn't wait for you to strike a
- -- character.
- -- 103 - This screen is shown whenever you strike X. It displays the number of
- -- the last screen shown and the approximate percentage through the
- -- course. It then asks if you want to exit the program. If you strike
- -- Y, screen 102 is shown and control returns to the operating system.
- -- If you type N, screen 108 is shown to provide a menu of further
- -- choices. From screen 103, you can also strike M to see the main menu
- -- (screen 106).
- -- 104 - This is the opening screen. It asks if you've used ADA-TUTR before.
- -- If you strike N, a welcome screen is presented and the course begins.
- -- If you strike Y, screen 107 is shown.
- -- 105 - This screen allows you to type the number of the next screen you want
- -- to see. For this screen, instead of striking one character, you type
- -- a three-digit number and presses ENTER. Any number from 104 through
- -- the largest screen number is accepted.
- -- 106 - This screen contains the main menu of topics covered in ADA-TUTR.
- -- When you select a main topic, an appropriate sub-menu is shown.
- -- 107 - This screen is shown when you say that you've used ADA-TUTR before.
- -- It says "Welcome back!" and provides a menu that lets you resume where
- -- you left off, go back to the last question or Outside Assignment, go
- -- to the main menu (screen 106), or go to any specified screen number
- -- (via screen 105).
- -- 108 - This screen is shown when you answer N to screen 103. It provides a
- -- menu similar to screen 107, except that the first choice takes you
- -- back to the screen shown before you saw 103. For example, if you
- -- strike X while viewing screen 300, you'll see screen 103. If you then
- -- answer N, you'll see screen 108. From 108 the first menu selection
- -- takes you back to 300.
- --
-
- -- Format of the Data File:
- --
- -- ADA-TUTR.DAT is a random access file of 64-byte blocks. The format of this
- -- file changed considerably with version 2.00 of ADA-TUTR. It's now much more
- -- compact, and, although it's still a data file, it now contains only the 95
- -- printable ASCII characters.
- --
- -- The first block of ADA_TUTR.DAT is referred to as block 1, and the first 31
- -- blocks together are called the index. Bytes 2 through 4 of block 1 contain,
- -- in ASCII, the number of the welcome screen that's shown when you say that
- -- you haven't used ADA-TUTR before. Bytes 6 through 8 of block 1 contain the
- -- number of the highest screen in the course. (Bytes 1 and 5 of block 1
- -- contain spaces.)
- --
- -- Bytes 9 of block 1 through the end of block 31 contain four bytes of
- -- information for each of the possible screens 101 through 594. For example,
- -- information for screen 101 is stored in bytes 9 through 12 of block 1, the
- -- next four bytes are for screen 102, etc. For screens that don't exist, all
- -- four bytes contain spaces.
- --
- -- The first of the four bytes is A if the corresponding screen introduces an
- -- Outside Assignment, Q if the screen asks a question, or a space otherwise.
- -- The next two bytes give the number of the block where data for the screen
- -- begins, in base 95! A space represents 0, ! represents 1, " represents 2,
- -- # represents 3, $ represents 4, etc., through all the printable characters
- -- of the ASCII set. A tilde (~) represents 94.
- --
- -- The last of the four bytes gives the position, 1 through 64, within the
- -- block where the data for this screen starts. Again, ! represents 1,
- -- " represents 2, # represents 3, etc.
- --
- -- Data for the screens are stored starting in position 1 of block 32. In the
- -- screen data, the following characters have special meaning:
- --
- -- % turns on high intensity.
- -- @ displays the number of spaces indicated by the next
- -- character (# represents 3, $ represents 4, etc.)
- -- \ turns on reverse video and leaves one space.
- -- ^ turns on high intensity and leaves one space.
- -- ` restores normal video.
- -- { causes CR-LF.
- -- } moves cursor to row 24, column 1, for a prompt.
- -- ~ restores normal video and leaves one space.
- --
- -- These characters have special meaning in screen 103 only:
- --
- -- # shows approximate percentage through the course.
- -- $ shows the number of the screen seen before 103.
- --
- -- Immediately after }, b represents "Please type a space to go on, or B to go
- -- back." and q represents "Please type a space to go on, or B or Q to go back
- -- to the question."
- --
-
- --
- -- The data for each screen is followed by the "control information" for that
- -- screen, in square brackets. The control information is a list of characters
- -- that you might strike after seeing this screen. Each character is followed
- -- by the three-digit number of the next screen to be shown when that character
- -- is struck. For example, Y107N120 is the control information for screen 104.
- -- This means that if you strike Y, screen 107 will be shown next, and if you
- -- strikes N, screen 120 will be shown. Striking any other character will
- -- simply cause a beep (except that X can always be typed to exit the program,
- -- S can always be typed to set colors, and CR will be ignored). If the
- -- control information is simply #, you are prompted to type the next screen
- -- number. This feature is used in screen 105.
- --
- -- A "screen number" of 098 following a character means "go back to the last
- -- Outside Assignment," and 099 means "go back to the last question." These
- -- special numbers are used in screens 107 and 108. Number 100 means "go back
- -- to the previous screen seen."
- --
- -- ADA-TUTR opens the Data File in IN_FILE mode for read-only access.
- --
- --
- --
- -- Format of the User File:
- --
- -- The User File ADA_TUTR.USR initially doesn't exist. It's created the first
- -- time ADA-TUTR is run.
- --
- -- ADA_TUTR.USR is a random access file containing one 64-byte block. Bytes 2
- -- through 4 contain, in ASCII, the number of the last screen read the last
- -- time you ran ADA-TUTR. Byte 6 contains a digit for the foreground color you
- -- select, byte 8 contains a digit for the background color, and byte 10
- -- contains a digit for the border color. All other bytes contain spaces. The
- -- ASCII characters '0' through '7' represent black, red, green, yellow, blue,
- -- magenta, cyan, and white, in that order. Note that not all color PCs have a
- -- separate border color. ADA_TUTR.USR is a random access file so that it can
- -- be easily updated by Ada. It contains 64 bytes so that it can be accessed
- -- with the same package, namely RANDOM_IO, that accesses the Data File.
- --
- -- If the User File exists, ADA-TUTR opens it in INOUT_FILE mode for read/write
- -- access. If it doesn't exist, ADA-TUTR creates it.
- --
-
- with CUSTOM_IO, DIRECT_IO; use CUSTOM_IO;
- procedure ADA_TUTR is
- subtype BLOCK_SUBTYPE is STRING(1 .. 64);
- package RANDOM_IO is new DIRECT_IO(BLOCK_SUBTYPE); use RANDOM_IO;
- DATA_FILE : FILE_TYPE; -- The file from which screens are read.
- USER_FILE : FILE_TYPE; -- Remembers last screen seen, and colors.
- BLOCK : BLOCK_SUBTYPE; -- Buffer for random-access I/O.
- VPOS : INTEGER; -- Number of the current block.
- HPOS : INTEGER; -- Current position within current block.
- SN, OLD_SN : INTEGER := 104; -- Screen num. and previous screen num.
- QUITTING_SN : INTEGER := 104; -- Screen number where you left off.
- HIGHEST_SN : INTEGER; -- Highest screen number in the course.
- WELCOME_SN : INTEGER; -- Number of the screen shown to new users.
- INDX : STRING(1 .. 1984); -- Index from the Data File.
- FILES_OK : BOOLEAN := FALSE; -- True when files open successfully.
- LEGAL_NOTE : constant STRING := " Copyright 1988-92 John J. Herro ";
- -- LEGAL_NOTE isn't used by the program, but it causes
- -- most compilers to place this string in the .EXE file.
- procedure OPEN_DATA_FILE is separate;
- procedure OPEN_USER_FILE is separate;
- procedure SHOW_CURRENT_SCREEN is separate;
- procedure GET_NEXT_SCREEN_NUMBER is separate;
- begin
- OPEN_DATA_FILE;
- OPEN_USER_FILE;
- if FILES_OK then
- SET_BORDER_COLOR(TO => BORDER_COLOR); -- Set default colors.
- PUT(NORMAL_COLORS);
- while SN > 0 loop -- "Screen number" of 0 means end the program.
- PUT(CLEAR_SCRN); -- Clear the screen.
- SHOW_CURRENT_SCREEN;
- GET_NEXT_SCREEN_NUMBER;
- end loop;
- BLOCK := (others => ' '); -- Write user-specific data to user file.
- BLOCK(1 .. 4) := INTEGER'IMAGE(QUITTING_SN);
- BLOCK(6) := FORE_COLOR_DIGIT;
- BLOCK(8) := BACK_COLOR_DIGIT;
- BLOCK(10) := CHARACTER'VAL(COLOR'POS(BORDER_COLOR) + 48);
- WRITE(USER_FILE, ITEM => BLOCK, TO => 1);
- CLOSE(DATA_FILE);
- CLOSE(USER_FILE);
- end if;
- end ADA_TUTR;
-
- separate (ADA_TUTR)
- procedure OPEN_DATA_FILE is
- DATA_FILE_NAME : constant STRING := "ADA_TUTR.DAT";
- begin
- OPEN(DATA_FILE, MODE => IN_FILE, NAME => DATA_FILE_NAME);
- for I in 1 .. 31 loop -- Read index from start of Data File.
- READ(DATA_FILE, ITEM => BLOCK, FROM => COUNT(I));
- INDX(64*I - 63 .. 64*I) := BLOCK;
- end loop;
- WELCOME_SN := INTEGER'VALUE(INDX(2 .. 4));
- HIGHEST_SN := INTEGER'VALUE(INDX(6 .. 8));
- FILES_OK := TRUE;
- exception
- when NAME_ERROR =>
- PUT("I'm sorry. The file " & DATA_FILE_NAME);
- PUT_LINE(" seems to be missing.");
- when others =>
- PUT("I'm sorry. The file " & DATA_FILE_NAME);
- PUT_LINE(" seems to have the wrong form.");
- end OPEN_DATA_FILE;
-
-
-
- separate (ADA_TUTR)
- procedure OPEN_USER_FILE is
- USER_FILE_NAME : constant STRING := "ADA_TUTR.USR";
- begin
- OPEN(USER_FILE, MODE => INOUT_FILE, NAME => USER_FILE_NAME);
- READ(USER_FILE, ITEM => BLOCK, FROM => 1);
- QUITTING_SN := INTEGER'VALUE(BLOCK(1 .. 4));
- OLD_SN := QUITTING_SN;
- FOREGRND_COLOR := COLOR'VAL(INTEGER'VALUE(BLOCK(5 .. 6)));
- BACKGRND_COLOR := COLOR'VAL(INTEGER'VALUE(BLOCK(7 .. 8)));
- BORDER_COLOR := COLOR'VAL(INTEGER'VALUE(BLOCK(9 .. 10)));
- FORE_COLOR_DIGIT := BLOCK(6);
- BACK_COLOR_DIGIT := BLOCK(8);
- NORMAL_COLORS(6) := FORE_COLOR_DIGIT;
- NORMAL_COLORS(9) := BACK_COLOR_DIGIT;
- exception
- when NAME_ERROR =>
- begin
- CREATE(USER_FILE, MODE => INOUT_FILE, NAME => USER_FILE_NAME);
- exception
- when others =>
- PUT("I'm sorry. I couldn't find or create ");
- PUT_LINE(USER_FILE_NAME);
- FILES_OK := FALSE;
- end;
- when others =>
- PUT_LINE("I'm sorry. The file " & USER_FILE_NAME & " seems to have");
- PUT_LINE("the wrong form or contain bad data.");
- PUT_LINE("You might want to delete the file and try again.");
- PUT_LINE("(Default values will be used.)");
- FILES_OK := FALSE;
- end OPEN_USER_FILE;
-
- separate (ADA_TUTR)
- procedure SHOW_CURRENT_SCREEN is
- HALF_DIFF : INTEGER := (HIGHEST_SN - WELCOME_SN) / 2;
- PERCENT : INTEGER := (50 * (OLD_SN - WELCOME_SN)) / HALF_DIFF;
- -- Percentage of the course completed. Using 50 and
- -- HALF_DIFF guarantees that the numerator < 2 ** 15.
- EXPANDING : BOOLEAN := FALSE; -- True when expanding multiple spaces.
- PROMPTING : BOOLEAN := FALSE; -- True for first character in a prompt.
- SPACE : constant STRING(1 .. 80) := (others => ' ');
- procedure PROCESS_CHAR is separate;
- begin
- VPOS := 95*(CHARACTER'POS(INDX(SN*4 - 394)) - 32) + -- Point to start
- CHARACTER'POS(INDX(SN*4 - 393)) - 32; -- of current
- HPOS := CHARACTER'POS(INDX(SN*4 - 392)) - 32; -- screen.
- READ(DATA_FILE, ITEM => BLOCK, FROM => COUNT(VPOS));
- if PERCENT < 0 then -- Make sure PERCENT is reasonable.
- PERCENT := 0;
- elsif PERCENT > 99 then
- PERCENT := 99;
- end if;
- while BLOCK(HPOS) /= '[' or EXPANDING loop -- [ starts the control info.
- if EXPANDING then
- PUT(SPACE(1 .. CHARACTER'POS(BLOCK(HPOS)) - 32));
- EXPANDING := FALSE;
- elsif PROMPTING then
- case BLOCK(HPOS) is
- when 'b' => PUT("Please type a space to go on, or B to go back.");
- when 'q' => PUT("Please type a space to go on, or B or Q to go ");
- PUT("back to the question.");
- when others => PROCESS_CHAR;
- end case;
- PROMPTING := FALSE;
- else
- PROCESS_CHAR;
- end if;
- HPOS := HPOS + 1;
- if HPOS > BLOCK'LENGTH then
- VPOS := VPOS + 1;
- HPOS := 1;
- READ(DATA_FILE, ITEM => BLOCK, FROM => COUNT(VPOS));
- end if;
- end loop;
- end SHOW_CURRENT_SCREEN;
-
- separate (ADA_TUTR.SHOW_CURRENT_SCREEN)
- procedure PROCESS_CHAR is
- begin
- case BLOCK(HPOS) is
- when '{' => NEW_LINE; -- { = CR-LF.
- when '@' => EXPANDING := TRUE; -- @ = several spaces.
- when '^' => PUT(ASCII.ESC & "[1m "); -- ^ = bright + space.
- when '~' => PUT(NORMAL_COLORS & ' '); -- ~ = normal + space.
- when '%' => PUT(ASCII.ESC & "[1m"); -- % = bright.
- when '`' => PUT(NORMAL_COLORS); -- ` = normal.
- when '}' => PUT(ASCII.ESC & "[24;1H"); -- } = go to line 24.
- PROMPTING := TRUE;
- when '\' => PUT(ASCII.ESC & "[7m "); -- \ = rev. vid. + sp.
- when '$' => if SN = 103 then -- $ = screen #.
- PUT(INTEGER'IMAGE(OLD_SN));
- else
- PUT('$');
- end if;
- when '#' => if SN = 103 then -- # = % completed.
- PUT(INTEGER'IMAGE(PERCENT));
- else
- PUT('#');
- end if;
- when others => PUT(BLOCK(HPOS));
- end case;
- end PROCESS_CHAR;
-
- separate (ADA_TUTR)
- procedure GET_NEXT_SCREEN_NUMBER is
- CTRL_INFO : BLOCK_SUBTYPE; -- Control info. for the current screen.
- PLACE : INTEGER := 1; -- Current position within CTRL_INFO.
- INPUT : STRING(1 .. 4); -- Screen number that you type.
- LEN : INTEGER; -- Length of typed response.
- VALID : BOOLEAN; -- True when typed response is valid.
- procedure SET_COLORS is separate;
- procedure INPUT_ONE_KEYSTROKE is separate;
- begin
- while BLOCK(HPOS) /= ']' loop -- Read control information from Data File.
- HPOS := HPOS + 1;
- if HPOS > BLOCK'LENGTH then
- VPOS := VPOS + 1;
- HPOS := 1;
- READ(DATA_FILE, ITEM => BLOCK, FROM => COUNT(VPOS));
- end if;
- CTRL_INFO(PLACE) := BLOCK(HPOS);
- PLACE := PLACE + 1;
- end loop;
- if SN = 103 then -- Screen 103 means you typed X to exit.
- QUITTING_SN := OLD_SN;
- elsif SN >= WELCOME_SN then -- Save SN so you can return to it.
- OLD_SN := SN;
- end if;
- if SN < 103 then -- Set SN to # of the next screen.
- SN := 0; -- Set signal to end the program after screens 101 and 102.
- elsif CTRL_INFO(1) = '#' then -- You type the next screen number.
- VALID := FALSE;
- while not VALID loop -- Keep trying until response is valid.
- PUT("# "); -- Prompt for screen number.
- INPUT := " "; GET_LINE(INPUT, LEN); -- Input screen number.
- if INPUT(1) = 'x' or INPUT(1) = 'X' or INPUT(1) = ASCII.ETX then
- SN := 103; -- Show screen 103 if you type X.
- VALID := TRUE; -- X is a valid response.
- elsif INPUT(1) = 's' or INPUT(1) = 'S' then
- SET_COLORS; -- Set colors if you type S.
- VALID := TRUE; -- S is a valid response.
- else
- begin -- Convert ASCII input to
- SN := INTEGER'VALUE(INPUT); -- integer. If in range,
- VALID := SN in 104 .. HIGHEST_SN; -- set VALID to TRUE. If
- exception -- it can't be converted
- when others => null; -- (e.g., illegal char.),
- end; -- or it's out of range,
- end if; -- leave VALID = FALSE so
- if not VALID and LEN > 0 then -- you can try again.
- PUT_LINE("Incorrect number. Please try again.");
- end if;
- end loop;
- else
- INPUT_ONE_KEYSTROKE;
- end if;
- end GET_NEXT_SCREEN_NUMBER;
-
- separate (ADA_TUTR.GET_NEXT_SCREEN_NUMBER)
- procedure SET_COLORS is
- BRIGHT : constant STRING := ASCII.ESC & "[1m"; -- Causes high intensity.
- KEYSTROKE : CHARACTER := 'f'; -- Single character that you type.
- SPACE : constant STRING(1 .. 23) := (others => ' ');
- begin
- while KEYSTROKE = 'f' or KEYSTROKE = 'b' or KEYSTROKE = 'r' or
- KEYSTROKE = 'F' or KEYSTROKE = 'B' or KEYSTROKE = 'R' loop
- PUT(CLEAR_SCRN); -- Clear the screen.
- NEW_LINE;
- PUT(SPACE & "The " & BRIGHT & "foreground" & NORMAL_COLORS);
- PUT_LINE(" color is now " & COLOR'IMAGE(FOREGRND_COLOR) & '.');
- PUT(SPACE & "The " & BRIGHT & "background" & NORMAL_COLORS);
- PUT_LINE(" color is now " & COLOR'IMAGE(BACKGRND_COLOR) & '.');
- PUT(SPACE & "The " & BRIGHT & " border " & NORMAL_COLORS);
- PUT_LINE(" color is now " & COLOR'IMAGE(BORDER_COLOR) & '.');
- NEW_LINE;
- PUT_LINE(SPACE & " Note: Some color PCs don't have");
- PUT_LINE(SPACE & " separate border colors.");
- NEW_LINE;
- PUT_LINE(SPACE & " Strike:");
- PUT_LINE(SPACE & "F to change the foreground color,");
- PUT_LINE(SPACE & "B to change the background color,");
- PUT_LINE(SPACE & "R to change the border color.");
- NEW_LINE;
- PUT_LINE(SPACE & "Strike any other key to continue.");
- GET(KEYSTROKE); -- Get one character from keyboard.
- if KEYSTROKE = 'f' or KEYSTROKE = 'F' then
- FOREGRND_COLOR := COLOR'VAL((COLOR'POS(FOREGRND_COLOR) + 1) mod 8);
- if FOREGRND_COLOR = BACKGRND_COLOR then
- FOREGRND_COLOR := COLOR'VAL((COLOR'POS(FOREGRND_COLOR) + 1) mod 8);
- end if;
- elsif KEYSTROKE = 'b' or KEYSTROKE = 'B' then
- BACKGRND_COLOR := COLOR'VAL((COLOR'POS(BACKGRND_COLOR) + 1) mod 8);
- if FOREGRND_COLOR = BACKGRND_COLOR then
- BACKGRND_COLOR := COLOR'VAL((COLOR'POS(BACKGRND_COLOR) + 1) mod 8);
- end if;
- elsif KEYSTROKE = 'r' or KEYSTROKE = 'R' then
- BORDER_COLOR := COLOR'VAL((COLOR'POS(BORDER_COLOR) + 1) mod 8);
- end if;
- FORE_COLOR_DIGIT := CHARACTER'VAL(48 + COLOR'POS(FOREGRND_COLOR));
- BACK_COLOR_DIGIT := CHARACTER'VAL(48 + COLOR'POS(BACKGRND_COLOR));
- NORMAL_COLORS(6) := FORE_COLOR_DIGIT;
- NORMAL_COLORS(9) := BACK_COLOR_DIGIT;
- PUT(NORMAL_COLORS);
- SET_BORDER_COLOR(TO => BORDER_COLOR);
- end loop;
- end SET_COLORS;
-
- separate (ADA_TUTR.GET_NEXT_SCREEN_NUMBER)
- procedure INPUT_ONE_KEYSTROKE is
- KEYSTROKE : CHARACTER; -- Single character that you type.
- VALID : BOOLEAN := FALSE; -- True when typed response is valid.
- WHERE : INTEGER; -- Location of control block in Data File.
- SEARCH : CHARACTER; -- 'A' = last Outside Assignment; 'Q' = last Ques.
- begin
- PUT(" >"); -- Prompt for one character.
- while not VALID loop -- Keep trying until response is valid.
- GET(KEYSTROKE); -- Get one character from keyboard.
- if KEYSTROKE in 'a' .. 'z' then -- Force upper case to simplify.
- KEYSTROKE := CHARACTER'VAL(CHARACTER'POS(KEYSTROKE) - 32);
- end if;
- if KEYSTROKE = 'X' or KEYSTROKE = ASCII.ETX then
- SN := 103; -- Show screen 103 if you type X.
- VALID := TRUE; -- X is a valid response.
- elsif KEYSTROKE = 'S' then
- SET_COLORS; -- Set colors if you type S.
- VALID := TRUE; -- S is a valid response.
- end if;
- PLACE := 1; -- Search list of valid characters for this screen.
- VALID := VALID; -- This statement works around a minor bug in
- -- ver. 1.0 of the Meridian IFORM optimizer.
- while not VALID and CTRL_INFO(PLACE) /= ']' loop -- ] ends the list.
- if KEYSTROKE = CTRL_INFO(PLACE) then
- -- Typed char. found in list; get screen # from control info.
- SN := INTEGER'VALUE(CTRL_INFO(PLACE + 1 .. PLACE + 3));
- VALID := TRUE; -- Characters in the list are all valid responses.
- end if;
- PLACE := PLACE + 4; -- A 3-digit number follows each char. in list.
- end loop;
- if not VALID and KEYSTROKE /= ASCII.CR then -- Beep if response is
- PUT(ASCII.BEL); -- not valid, but
- end if; -- ignore CRs quietly.
- end loop;
- if SN = 98 then -- Go back to last Outside Assignment.
- SEARCH := 'A';
- elsif SN = 99 then -- Go back to last question.
- SEARCH := 'Q';
- elsif SN = 100 then -- Go back to the last screen seen.
- SN := QUITTING_SN;
- end if;
- if SN = 98 or SN = 99 then
- SN := OLD_SN;
- while SN > WELCOME_SN and INDX(SN*4 - 395) /= SEARCH loop
- SN := SN - 1;
- end loop;
- end if;
- end INPUT_ONE_KEYSTROKE;
-