Power-Programmierung

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

/ Power-Programmierung / CD1.mdf / ada / tutorial / ada_tutr.ada < prev next >

Wrap

Text File | 1991-03-25 | 26KB | 518 lines

-- ADA_TUTR.ADA Ver. 2.00 25-MAR-1991 Copyright 1988-1991 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 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 copu 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-91 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 -- 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 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;