home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / ADA_TUTR.ZIP / BOOK.ADA < prev    next >
Encoding:
Text File  |  1992-09-04  |  13.3 KB  |  333 lines
  1. -- BOOK.ADA   Ver. 2.02   4-SEP-1992   Copyright 1988-1992 John J. Herro
  2. -- Software Innovations Technology
  3. -- 1083 Mandarin Drive NE, Palm Bay, FL  32905-4706   (407)951-0233
  4. --
  5. -- This program creates a printable "book" file from the tutorial text in
  6. -- ADA_TUTR.DAT.  This is by no means required for the course, but is provided
  7. -- because several users have asked for it.  Be prepared to print almost 500
  8. -- pages!  For the format of the input data file, please see the preliminary
  9. -- comments in ADA_TUTR.ADA.
  10. --
  11. with DIRECT_IO, TEXT_IO; use TEXT_IO;
  12. procedure BOOK is
  13.    subtype BLOCK_SUBTYPE is STRING(1 .. 64);
  14.    package RANDOM_IO is new DIRECT_IO(BLOCK_SUBTYPE);
  15.    DATA_FILE  : RANDOM_IO.FILE_TYPE;   -- The file from which screens are read.
  16.    PRNT       : FILE_TYPE;                   -- The output file, to be printed.
  17.    BLOCK      : BLOCK_SUBTYPE;               -- Block read from the input file.
  18.    VPOS       : INTEGER;                        -- Number of the current block.
  19.    HPOS       : INTEGER;              -- Current position within current block.
  20.    HIGHEST_SN : INTEGER;                -- Highest screen number in the course.
  21.    MIDDLE_SN  : INTEGER;          -- Screen number when we change output files.
  22.    INDX       : STRING(1 .. 1984);                 -- Index from the Data File.
  23.    ANSWER     : STRING(1 .. 80);                 -- User response to questions.
  24.    LEN        : INTEGER;                                   -- Length of ANSWER.
  25.    FILE_OK    : BOOLEAN := FALSE;    -- True when data file opens successfully.
  26.    PC_WRITE   : BOOLEAN;      -- True if book file will be printed by PC-Write.
  27.    LEGAL_NOTE : constant STRING := " Copyright 1988-92 John J. Herro ";
  28.                        -- LEGAL_NOTE isn't used by the program, but it causes
  29.                        -- most compilers to place this string in the .EXE file.
  30.    procedure OPEN_INPUT_FILE is separate;
  31.    procedure OPEN_OUTPUT_FILE(S: in STRING) is separate;
  32.    procedure PRINT_INSTRUCTIONS is separate;
  33.    procedure PRINT_TITLE_PAGE is separate;
  34.    procedure PRINT_SCREEN(SN : in INTEGER) is separate;
  35. begin
  36.    OPEN_INPUT_FILE;
  37.    if FILE_OK then
  38.       PRINT_INSTRUCTIONS;
  39.       OPEN_OUTPUT_FILE("FIRST");
  40.       PRINT_TITLE_PAGE;
  41.       MIDDLE_SN := (101 + HIGHEST_SN)/2;
  42.       for SN in 101 .. HIGHEST_SN loop
  43.          if SN = MIDDLE_SN then
  44.             CLOSE(PRNT);
  45.             OPEN_OUTPUT_FILE("SECOND");
  46.          end if;
  47.          PRINT_SCREEN(SN);
  48.       end loop;
  49.       PUT_LINE("Both book files are created and ready for printing.");
  50.       RANDOM_IO.CLOSE(DATA_FILE);
  51.       CLOSE(PRNT);
  52.    end if;
  53. end BOOK;
  54.  
  55. separate (BOOK)
  56. procedure OPEN_INPUT_FILE is
  57.    DATA_FILE_NAME : constant STRING := "ADA_TUTR.DAT";
  58. begin
  59.    RANDOM_IO.OPEN(DATA_FILE, RANDOM_IO.IN_FILE, DATA_FILE_NAME);
  60.    for I in 1 .. 31 loop                 -- Read index from start of Data File.
  61.       RANDOM_IO.READ(DATA_FILE, ITEM => BLOCK, FROM => RANDOM_IO.COUNT(I));
  62.       INDX(64*I - 63 .. 64*I) := BLOCK;
  63.    end loop;
  64.    HIGHEST_SN := INTEGER'VALUE(INDX(6 .. 8));
  65.    FILE_OK := TRUE;
  66. exception
  67.    when RANDOM_IO.NAME_ERROR =>
  68.       PUT("I'm sorry.  The file " & DATA_FILE_NAME & " seems to be missing.");
  69.    when others =>
  70.       PUT("I'm sorry.  The file " & DATA_FILE_NAME);
  71.       PUT_LINE(" seems to have the wrong form.");
  72. end OPEN_INPUT_FILE;
  73.  
  74.  
  75.  
  76. separate (BOOK)
  77. procedure OPEN_OUTPUT_FILE(S: in STRING) is
  78.    OK : BOOLEAN := FALSE;                 -- True when file opens successfully.
  79. begin
  80.    PUT_LINE("Please type the name of the output file for the " & S & " half");
  81.    PUT("of the tutorial:  ");
  82.    GET_LINE(ANSWER, LEN);
  83.    while not OK loop
  84.       begin
  85.          CREATE(FILE => PRNT, MODE => OUT_FILE, NAME => ANSWER(1 .. LEN));
  86.          OK := TRUE;
  87.       exception
  88.          when others => null;
  89.       end;
  90.       if not OK then
  91.          PUT_LINE("Unable to create file.  Please retype name:  ");
  92.          GET_LINE(ANSWER, LEN);
  93.       end if;
  94.    end loop;
  95.    NEW_LINE(2);
  96. end OPEN_OUTPUT_FILE;
  97.  
  98. separate (BOOK)
  99. procedure PRINT_INSTRUCTIONS is
  100. begin
  101.    PUT_LINE("This program creates two printable ""book"" files from the");
  102.    PUT_LINE("tutorial text in ADA_TUTR.DAT.  This is by no means required");
  103.    PUT_LINE("for the course, but is provided because several users have");
  104.    PUT_LINE("asked for it.  Be prepared to print almost 500 pages!");
  105.    NEW_LINE(2);
  106.    PUT_LINE("If you'll be using PC-Write to print the files, I'll use");
  107.    NEW_LINE;
  108.    PUT_LINE("""boldface"" commands in the output files.  Otherwise, I'll");
  109.    NEW_LINE;
  110.    PUT_LINE("double space the output files like this and emphasize");
  111.    PUT_LINE("                              ---------     ---------");
  112.    PUT_LINE("text by placing hyphens below the lines like this.");
  113.    PUT_LINE("                -------                 ---------");
  114.    NEW_LINE;
  115.    PUT_LINE("Will you be using PC-Write to print the files?");
  116.    PUT     ("Please type Y or N and press Enter:  ");
  117.    GET_LINE(ANSWER, LEN);
  118.    NEW_LINE(2);
  119.    while LEN > 1 and ANSWER(1) = ' ' loop         -- Ignore any leading spaces.
  120.       ANSWER(1 .. ANSWER'LAST - 1) := ANSWER(2 .. ANSWER'LAST);
  121.    end loop;
  122.    PC_WRITE := ANSWER(1) = 'Y' or ANSWER(1) = 'y';
  123. end PRINT_INSTRUCTIONS;
  124.  
  125. separate (BOOK)
  126. procedure PRINT_TITLE_PAGE is
  127. begin
  128.    NEW_PAGE(PRNT);
  129.    NEW_LINE(PRNT);
  130.    PUT_LINE(PRNT, "   AAA   DDDD    AAA          TTTTT  U   U  TTTTT  RRRR");
  131.    PUT_LINE(PRNT, "  A   A  D   D  A   A           T    U   U    T    R   R");
  132.    PUT_LINE(PRNT, "  AAAAA  D   D  AAAAA   ===     T    U   U    T    RRRR");
  133.    PUT_LINE(PRNT, "  A   A  D   D  A   A           T    U   U    T    R  R");
  134.    PUT_LINE(PRNT, "  A   A  DDDD   A   A           T     UUU     T    R   R");
  135.    NEW_LINE(PRNT);
  136.    PUT_LINE(PRNT, "This is a copy of the tutorial text from ADA-TUTR, The");
  137.    PUT_LINE(PRNT, "Interactive Ada Tutor, ver. 2.01.  BEGIN WITH SCREEN 104.");
  138.    NEW_LINE(PRNT);
  139.    PUT_LINE(PRNT, "            Copyright 1988-1992 John J. Herro");
  140.    NEW_LINE(PRNT);
  141.    PUT_LINE(PRNT, "You may copy this book, in printed or machine-readable");
  142.    PUT_LINE(PRNT, "form, if you observe the Shareware notice in Screen 104.");
  143.    PUT_LINE(PRNT, "Please distribute complete copies of the ADA-TUTR program");
  144.    PUT_LINE(PRNT, "along with this book.  If you don't have a copy of");
  145.    PUT_LINE(PRNT, "ADA-TUTR, send $10 for a trial copy or $30 for a");
  146.    PUT_LINE(PRNT, "registered copy for full use by one individual.  Send $5");
  147.    PUT_LINE(PRNT, "more if you prefer a 3.5"" diskette.");
  148.    NEW_LINE(PRNT);
  149.    PUT_LINE(PRNT, "             Software Innovations Technology");
  150.    PUT_LINE(PRNT, "                  1083 Mandarin Drive NE");
  151.    PUT_LINE(PRNT, "                 Palm Bay, FL  32905-4706");
  152.    NEW_LINE(PRNT);
  153.    PUT_LINE(PRNT, "                      (407) 951-0233");
  154.    NEW_PAGE(PRNT);
  155.    NEW_LINE(PRNT);
  156. end PRINT_TITLE_PAGE;
  157.  
  158. separate (BOOK)
  159. procedure PRINT_SCREEN(SN : in INTEGER) is
  160.    EXPANDING  : BOOLEAN := FALSE;       -- True when expanding multiple spaces.
  161.    PROMPTING  : BOOLEAN := FALSE;      -- True for first character in a prompt.
  162.    BOLD       : BOOLEAN := FALSE;        -- True when text is being emphasized.
  163.    OUT1, OUT2 : STRING(1 ..120) := (others => ' ');    -- Lines of output text.
  164.    PLACE      : INTEGER := 1;         -- Current position within OUT1 and OUT2.
  165.    LIMIT      : INTEGER;           -- Position of last non-space char. in OUT2.
  166.    LINE_NUM   : INTEGER := 1;                  -- Current line being displayed.
  167.    SPACE      : constant STRING(1 .. 69) := (others => ' ');
  168.    procedure SHOW(C : in CHARACTER) is separate;
  169.    procedure SCREEN_CHAR is separate;
  170.    procedure END_OF_SCREEN is separate;
  171. begin
  172.    if SN = 103 then
  173.       PUT(PRNT, SPACE(1 .. 27) & "*** X TAKES YOU HERE. ***");
  174.       PUT_LINE(PRNT, SPACE(1 .. 17) & "Screen 103");
  175.    else
  176.       PUT_LINE(PRNT, SPACE & "Screen" & INTEGER'IMAGE(SN));
  177.    end if;
  178.    NEW_LINE(PRNT, 2);
  179.    VPOS := 95*(CHARACTER'POS(INDX(SN*4 - 394)) - 32) +        -- Point to start
  180.                CHARACTER'POS(INDX(SN*4 - 393)) - 32;          -- of current
  181.    HPOS := CHARACTER'POS(INDX(SN*4 - 392)) - 32;              -- screen.
  182.    RANDOM_IO.READ(DATA_FILE, ITEM => BLOCK, FROM => RANDOM_IO.COUNT(VPOS));
  183.    while BLOCK(HPOS) /= '[' or EXPANDING loop     -- [ starts the control info.
  184.       SCREEN_CHAR;
  185.    end loop;
  186.    END_OF_SCREEN;
  187. end PRINT_SCREEN;
  188.  
  189. separate (BOOK.PRINT_SCREEN)
  190. procedure SHOW(C : in CHARACTER) is
  191. begin
  192.    OUT1(PLACE) := C;
  193.    if BOLD and not PC_WRITE then
  194.       OUT2(PLACE) := '-';
  195.    end if;
  196.    PLACE := PLACE + 1;
  197. end SHOW;
  198.  
  199.  
  200.  
  201. separate (BOOK.PRINT_SCREEN)
  202. procedure SCREEN_CHAR is
  203.    procedure PROCESS_CHAR is separate;
  204. begin
  205.    if EXPANDING then
  206.       for I in INTEGER range 1 .. CHARACTER'POS(BLOCK(HPOS)) - 32 loop
  207.          SHOW(' ');
  208.       end loop;
  209.       EXPANDING := FALSE;
  210.    elsif PROMPTING then
  211.       PROMPTING := FALSE;
  212.       if BLOCK(HPOS) = 'b' then
  213.          PUT(PRNT, "Please type a space to go on, or B to go back.");
  214.       elsif BLOCK(HPOS) = 'q' then
  215.          PUT(PRNT, "Please type a space to go on, or B or Q to go ");
  216.          PUT(PRNT, "back to the question.");
  217.       else
  218.          PROCESS_CHAR;
  219.       end if;
  220.    else
  221.       PROCESS_CHAR;
  222.    end if;
  223.    HPOS := HPOS + 1;
  224.    if HPOS > BLOCK'LENGTH then
  225.       VPOS := VPOS + 1;
  226.       HPOS := 1;
  227.       RANDOM_IO.READ(DATA_FILE, BLOCK, FROM => RANDOM_IO.COUNT(VPOS));
  228.    end if;
  229. end SCREEN_CHAR;
  230.  
  231. separate (BOOK.PRINT_SCREEN.SCREEN_CHAR)
  232. procedure PROCESS_CHAR is
  233.    BOLDFACE : constant CHARACTER := CHARACTER'VAL(2);          -- For PC-Write.
  234. begin
  235.    case BLOCK(HPOS) is
  236.       when '{'    => PUT_LINE(PRNT, OUT1(1 .. PLACE - 1));
  237.                      if not PC_WRITE then                -- { = CR-LF.
  238.                         LIMIT := OUT2'LAST;
  239.                         while LIMIT > 0 and then OUT2(LIMIT) = ' ' loop
  240.                            LIMIT := LIMIT - 1;
  241.                         end loop;
  242.                         PUT_LINE(PRNT, OUT2(1 .. LIMIT));
  243.                         OUT2 := (others => ' ');
  244.                      end if;
  245.                      LINE_NUM := LINE_NUM + 1;
  246.                      OUT1 := (others => ' ');
  247.                      PLACE := 1;
  248.       when '@'    => EXPANDING := TRUE;                  -- @ = several spaces.
  249.       when '^'    => SHOW(' ');                          -- ^ = bright + space.
  250.                      if not BOLD and PC_WRITE then
  251.                         SHOW(BOLDFACE);
  252.                      end if;
  253.                      BOLD := TRUE;
  254.       when '~'    => if BOLD and PC_WRITE then           -- ~ = normal + space.
  255.                         SHOW(BOLDFACE);
  256.                      end if;
  257.                      BOLD := FALSE;
  258.                      SHOW(' ');
  259.       when '%'    => if not BOLD and PC_WRITE then       -- % = bright.
  260.                         SHOW(BOLDFACE);
  261.                      end if;
  262.                      BOLD := TRUE;
  263.       when '`'    => if BOLD and PC_WRITE then           -- ` = normal.
  264.                         SHOW(BOLDFACE);
  265.                      end if;
  266.                      BOLD := FALSE;
  267.       when '}'    => for I in LINE_NUM .. 23 loop        -- } = go to line 24.
  268.                         NEW_LINE(PRNT);
  269.                         if not PC_WRITE then
  270.                            NEW_LINE(PRNT);
  271.                         end if;
  272.                      end loop;
  273.                      PROMPTING := TRUE;
  274.       when '\'    => SHOW(' ');                          -- \ = rev. vid. + sp.
  275.       when '$'    => if SN = 103 then                    -- $ = screen #.
  276.                         SHOW(' '); SHOW('_'); SHOW('_'); SHOW('_');
  277.                      else
  278.                         SHOW('$');
  279.                      end if;
  280.       when '#'    => if SN = 103 then                    -- # = % completed.
  281.                         SHOW(' '); SHOW('_'); SHOW('_');
  282.                      else
  283.                         SHOW('#');
  284.                      end if;
  285.       when others => SHOW(BLOCK(HPOS));
  286.    end case;
  287. end PROCESS_CHAR;
  288.  
  289. separate (BOOK.PRINT_SCREEN)
  290. procedure END_OF_SCREEN is
  291.    CTRL_INFO : BLOCK_SUBTYPE;          -- Control info. for the current screen.
  292.    I         : INTEGER;                     -- Used to index through CTRL_INFO.
  293. begin
  294.    PUT_LINE(PRNT, OUT1(1 .. PLACE - 1));
  295.    if PC_WRITE then
  296.       NEW_LINE(PRNT);
  297.    else
  298.       LIMIT := OUT2'LAST;
  299.       while LIMIT > 0 and then OUT2(LIMIT) = ' ' loop
  300.          LIMIT := LIMIT - 1;
  301.       end loop;
  302.       PUT_LINE(PRNT, OUT2(1 .. LIMIT));
  303.    end if;
  304.    PLACE := 1;
  305.    while BLOCK(HPOS) /= ']' loop    -- Read control information from Data File.
  306.       HPOS := HPOS + 1;
  307.       if HPOS > BLOCK'LENGTH then
  308.          VPOS := VPOS + 1;
  309.          HPOS := 1;
  310.          RANDOM_IO.READ(DATA_FILE, BLOCK, FROM => RANDOM_IO.COUNT(VPOS));
  311.       end if;
  312.       CTRL_INFO(PLACE) := BLOCK(HPOS);
  313.       PLACE := PLACE + 1;
  314.    end loop;
  315.    if CTRL_INFO(1 .. PLACE - 1) = "]" then
  316.       PUT_LINE(PRNT, "(Program ends after this screen.)");
  317.    elsif CTRL_INFO(1 .. PLACE - 1) = "#]" then
  318.       PUT_LINE(PRNT, "(User types the next screen number.)");
  319.    else
  320.       I := 1;
  321.       while I + 4 < PLACE loop
  322.          PUT(PRNT, "  '" & CTRL_INFO(I) & "' " & CTRL_INFO(I+1..I+3));
  323.          I := I + 4;
  324.          if I = 33 then
  325.             NEW_LINE(PRNT);
  326.          end if;
  327.       end loop;
  328.       NEW_LINE(PRNT);
  329.    end if;
  330.    NEW_PAGE(PRNT);
  331.    NEW_LINE(PRNT);
  332. end END_OF_SCREEN;
  333.