Hall of Fame

home *** CD-ROM | disk | FTP | other *** search

/ Hall of Fame / HallofFameCDROM.cdr / prog1 / ada-tutr.lzh / ADA-TUTR.ADA < prev next >

Wrap

Text File | 1988-12-21 | 24.3 KB | 466 lines

-- ADA-TUTR.ADA Ver. 1.20 21-DEC-1988 -- Copyright 1988 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: -- -- MERIDIAN.ADA Recommended when using a PC with the Meridian AdaStarter or -- AdaVantage compiler and the DOS Environment Library. -- UNIX.ADA Recommended for UNIX based systems, if you can also -- compile GET.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. -- -- 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. 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 -- from your system 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, it requires a hard disk. -- 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 first block is -- referred to as block 1. 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 contain the number of the highest screen -- in the course. (Bytes 1 and 5 contain blanks.) -- -- Data for the screens are stored starting in block 32. Bytes 9 of block 1 -- through the end of block 31 contain, in ASCII, the numbers of the starting -- blocks for each of the 494 possible screens (101 through 594). Four bytes -- are allocated for each starting block number. So that each number will have -- exactly four digits, 1000 is added to each block number. For example, data -- for screen 101 starts at block 32, so "1032" is stored (in bytes 9 through -- 12 of block 1). The next four bytes refer to screen 102, etc. Not all 494 -- possible screens exist. For each unused screen, four blanks are stored. -- -- The first 64-byte block of each screen is a "control block." Thus, block 32 -- of ADA-TUTR.DAT is the control block for screen 101. This block is followed -- by enough 64-byte blocks to contain the text for that screen. In the text, -- '{' represents a digit for the foreground color (ASCII character '0' = -- black, '7' = white), and '}' represents a digit for the background color. -- -- The first two bytes of the control block contain, in ASCII, the number of -- text blocks that follow. A constant 10 is added to this number so that it -- will always have exactly two digits. The next two bytes contain, in ASCII, -- the number of significant text characters in the last 64-byte block, plus -- ten. This number can range from 11 to 74. For example, if a screen has 138 -- characters, three text blocks will be needed, and the last block will have -- ten significant characters. Thus, the first four bytes of the control block -- will contain "1320" in ASCII. -- -- Bytes 5 through 61 of the control block contain 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. The list is terminated by $. There is room for as many as 14 -- characters and screen numbers, and the terminating $. For example, in the -- control block for screen 104, bytes 5 through 13 might contain "Y107N120$". -- This means that, if you strike Y, screen 107 will be shown, 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 list -- of characters begins with '#', 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." -- -- Bytes 62 and 63 of the control block each contain '$'. Byte 64 contains 'Q' -- if this screen contains a question, 'A' if this screen introduces an Outside -- Assignment, and '$' otherwise. -- -- 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 blanks. 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; -- Data written to the User File. CONTROL_BLOCK : BLOCK_SUBTYPE; -- Control info. for the current screen. SN, OLD_SN : INTEGER := 104; -- Screen num. and previous screen num. QUITTING_SN : INTEGER := 104; -- Screen number where you left off. HIGHEST_SCREEN : INTEGER; -- Highest screen number in the course. WELCOME_SCREEN : INTEGER; -- Screen shown to new users. INDX : STRING(1 .. 1984); -- Starting block numbers, + 1000. FILES_OK : BOOLEAN := FALSE; -- True when files open successfully. LEGAL_NOTE : constant STRING := " Copyright 1988 John J. Herro "; -- LEGAL_NOTE isn't used by the program, but it causes -- the compiler 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"; BLOCK : BLOCK_SUBTYPE; -- A 64-byte block of input from Data File. begin OPEN(DATA_FILE, MODE => IN_FILE, NAME => DATA_FILE_NAME); for I in 1 .. 31 loop -- Read list of starting block numbers. READ(DATA_FILE, ITEM => BLOCK, FROM => COUNT(I)); INDX(64*I - 63 .. 64*I) := BLOCK; end loop; WELCOME_SCREEN := INTEGER'VALUE(INDX(2 .. 4)); HIGHEST_SCREEN := 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"; BLOCK : BLOCK_SUBTYPE; -- A 64-byte block of input from User File. 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 NUM_OF_BLOCKS : INTEGER; -- Num. of blocks of text for this screen. LAST_BLOCK_LEN : INTEGER; -- Num. of significant chars. in last block. HALF_DIFF : INTEGER := (HIGHEST_SCREEN - WELCOME_SCREEN) / 2; PERCENT : INTEGER := (50 * (OLD_SN - WELCOME_SCREEN)) / HALF_DIFF; -- Percentage of the course completed. Using 50 and -- HALF_DIFF guarantees that the numerator < 2 ** 15. BLOCK : BLOCK_SUBTYPE; -- A 64-byte block of input from Data File. WHERE : INTEGER; -- Location of control block in Data File. begin WHERE := INTEGER'VALUE(INDX(SN*4 - 395 .. SN*4 - 392)) - 1000; -- Get location of control block in Data File. READ(DATA_FILE, ITEM => CONTROL_BLOCK, FROM => COUNT(WHERE)); NUM_OF_BLOCKS := INTEGER'VALUE(CONTROL_BLOCK(1 .. 2)) - 10; LAST_BLOCK_LEN := INTEGER'VALUE(CONTROL_BLOCK(3 .. 4)) - 10; for I in 1 .. NUM_OF_BLOCKS loop READ(DATA_FILE, ITEM => BLOCK, FROM => COUNT(WHERE + I)); --------------------------------------------------------------- -- NOTE: If screen 103 is redesigned, the slices in the -- -- following IF block will have to be changed accordingly. -- --------------------------------------------------------------- if SN = 103 and I = 1 then -- Screen 103 needs previous screen number. BLOCK(58 .. 61) := INTEGER'IMAGE(OLD_SN); elsif SN = 103 and I = 2 then -- Screen 103 also needs % completed. case PERCENT is when INTEGER'FIRST..0 => BLOCK(34 .. 35) := " 0"; when 1 .. 9 => BLOCK(34 .. 35) := INTEGER'IMAGE(PERCENT); when 10 .. 99 => BLOCK(33 .. 35) := INTEGER'IMAGE(PERCENT); when others => BLOCK(34 .. 35) := "99"; end case; end if; for J in BLOCK'RANGE loop if BLOCK(J) = '{' then BLOCK(J) := FORE_COLOR_DIGIT; elsif BLOCK(J) = '}' then BLOCK(J) := BACK_COLOR_DIGIT; end if; end loop; if I = NUM_OF_BLOCKS then PUT(BLOCK(1 .. LAST_BLOCK_LEN)); else PUT(BLOCK); end if; end loop; end SHOW_CURRENT_SCREEN; separate (ADA_TUTR) procedure GET_NEXT_SCREEN_NUMBER is 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 if SN = 103 then -- Screen 103 means you typed X to exit. QUITTING_SN := OLD_SN; elsif SN >= WELCOME_SCREEN 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 CONTROL_BLOCK(5) = '#' 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_SCREEN; -- 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 -- so 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 BLINK : constant STRING := ASCII.ESC & "[5m"; KEYSTROKE : CHARACTER; -- Single character that you type. PLACE : INTEGER; -- Index to search list of characters. 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 := 5; -- Search list of valid characters for this screen. while not VALID and CONTROL_BLOCK(PLACE) /= '$' loop -- $ ends the list. if KEYSTROKE = CONTROL_BLOCK(PLACE) then -- Typed char. found in list; get screen # from control block. SN := INTEGER'VALUE(CONTROL_BLOCK(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. PUT(BLINK & " Working..." & NORMAL_COLORS); 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; CONTROL_BLOCK(64) := ' '; while SN > WELCOME_SCREEN and CONTROL_BLOCK(64) /= SEARCH loop SN := SN - 1; WHERE := INTEGER'VALUE(INDX(SN*4 - 395 .. SN*4 - 392)) - 1000; -- Get location of control block in Data File. READ(DATA_FILE, ITEM => CONTROL_BLOCK, FROM => COUNT(WHERE)); end loop; end if; end INPUT_ONE_KEYSTROKE;