fork download
copy 
  1. -- BOOK401.ADA   Ver. 4.01   2001-SEP-10   Copyright 1988-2001 John J. Herro
  2. --
  3. -- SOFTWARE INNOVATIONS TECHNOLOGY          www.adatutor.com
  4. -- 1083 MANDARIN DR NE
  5. -- PALM BAY FL 32905-4706                   john@adatutor.com
  6. --
  7. -- (321) 951-0233
  8. --
  9. -- This program creates two printable "book" files from the tutorial text in
  10. -- ADATUTOR.DAT.  This is by no means required for the course, but is provided
  11. -- because several users have asked for it.  Be prepared to print about 500
  12. -- pages!  For the format of the input data file, please see the preliminary
  13. -- comments in ADATU401.ADA.
  14. --
  15. -- This code is written in Ada 83 and will compile on Ada 83 and Ada 95
  16. -- compilers.
  17. --
  18. 
  19. with Direct_IO, Text_IO; use Text_IO;
  20. procedure Book is
  21.   subtype Block_Subtype is String(1 .. 64);
  22.   package Random_IO is new Direct_IO(Block_Subtype);
  23.   Ix_Size    : constant := 35;                -- Number of blocks in the index.
  24.   Data_File  : Random_IO.File_Type;    -- The file from which screens are read.
  25.   P          : File_Type;                    -- The output file, to be printed.
  26.   Block      : Block_Subtype;                -- Block read from the input file.
  27.   Vpos       : Integer;                         -- Number of the current block.
  28.   Hpos       : Integer;               -- Current position within current block.
  29.   Highest_SN : Integer;                 -- Highest screen number in the course.
  30.   Middle_SN  : Integer;           -- Screen number when we change output files.
  31.   Indx       : String(1 .. 64*Ix_Size);            -- Index from the Data File.
  32.   Answer     : String(1 .. 80);                  -- User response to questions.
  33.   Len        : Integer;                                    -- Length of Answer.
  34.   File_OK    : Boolean := False;     -- True when data file opens successfully.
  35.   Legal_Note : constant String := " Copyright 1988-2001 John J. Herro ";
  36.                     -- Legal_Note isn't used by the program, but it causes most
  37.                     -- compilers to place this string in the executable file.
  38.   procedure Open_Input_File is separate;
  39.   procedure Open_Output_File(S: in String) is separate;
  40.   procedure Print_Instructions is separate;
  41.   procedure Print_Title_Page is separate;
  42.   procedure Print_Screen(SN : in Integer) is separate;
  43. begin
  44.   Open_Input_File;
  45.   if File_OK then
  46.     Print_Instructions;
  47.     Open_Output_File("FIRST");
  48.     Print_Title_Page;
  49.     Middle_SN := (101 + Highest_SN)/2;
  50.     for SN in 101 .. Highest_SN loop
  51.       if SN = Middle_SN then
  52.         Close(P);
  53.         Open_Output_File("SECOND");
  54.       end if;
  55.       Print_Screen(SN);
  56.     end loop;
  57.     Put_Line("Both book files are created and ready for printing.");
  58.     Random_IO.Close(Data_File);
  59.     Close(P);
  60.   end if;
  61. end Book;
  62. 
  63. separate (Book)
  64. procedure Open_Input_File is
  65.   Data_File_Name : constant String := "ADATUTOR.DAT";
  66. begin
  67.   Random_IO.Open(Data_File, Random_IO.In_File, Data_File_Name);
  68.   for I in 1 .. Ix_Size loop             -- Read index from start of Data File.
  69.     Random_IO.Read(Data_File, Item => Block, From => Random_IO.Count(I));
  70.     Indx(64*I - 63 .. 64*I) := Block;
  71.   end loop;
  72.   Highest_SN := Integer'Value(Indx(6 .. 8));
  73.   File_OK := True;
  74. exception
  75.   when Random_IO.Name_Error =>
  76.     Put("I'm sorry.  The file " & Data_File_Name & " seems to be missing.");
  77.   when others =>
  78.     Put("I'm sorry.  The file " & Data_File_Name);
  79.     Put_Line(" seems to have the wrong form.");
  80. end Open_Input_File;
  81.  
  82.  
  83.  
  84. separate (Book)
  85. procedure Open_Output_File(S: in String) is
  86.   OK : Boolean := False;                  -- True when file opens successfully.
  87. begin
  88.   Put_Line("Please type the name of the output file for the " & S & " half");
  89.   Put("of the tutorial:  ");
  90.   Get_Line(Answer, Len);
  91.   while not OK loop
  92.     begin
  93.       Create(File => P, Mode => Out_File, Name => Answer(1 .. Len));
  94.       OK := True;
  95.     exception
  96.       when others => null;
  97.     end;
  98.     if not OK then
  99.       Put_Line("Unable to create file.  Please retype name:  ");
  100.       Get_Line(Answer, Len);
  101.     end if;
  102.   end loop;
  103.   New_Line(2);
  104. end Open_Output_File;
  105. 
  106. separate (Book)
  107. procedure Print_Instructions is
  108. begin
  109.   Put_Line("This program creates two printable ""book"" files from the");
  110.   Put_Line("tutorial text in ADATUTOR.DAT.  This is by no means required");
  111.   Put_Line("for the course, but is provided because several users have");
  112.   Put_Line("asked for it.  Be prepared to print about 500 pages!");
  113.   New_Line(2);
  114. end Print_Instructions;
  115.  
  116.  
  117.  
  118. separate (Book)
  119. procedure Print_Title_Page is
  120.   S : constant String(1 .. 11) := (others => ' ');
  121. begin
  122.   New_Page(P);
  123.   New_Line(P);
  124.   Put_Line(P,S & "   AAA       d         TTTTT           t               ");
  125.   Put_Line(P,S & "  A   A      d   aaa     T    u   u  ttttt   ooo   r rrr");
  126.   Put_Line(P,S & "  AAAAA   dddd  a  a     T    u   u    t    o   o  rr  ");
  127.   Put_Line(P,S & "  A   A  d   d  a  a     T    u   u    t    o   o  r   ");
  128.   Put_Line(P,S & "  A   A   ddd    aaaa    T     uuu      t    ooo   r    ");
  129.   New_Line(P);
  130.   Put_Line(P,S & "This is a copy of the tutorial text from AdaTutor, The");
  131.   Put_Line(P,S & "Interactive Ada Tutor, ver. 4.01.  BEGIN WITH SCREEN 104.");
  132.   New_Line(P);
  133.   Put_Line(P,S & "            Copyright 1988-2001 John J. Herro");
  134.   New_Line(P);
  135.   Put_Line(P,S & "You may copy this book, in printed or machine-readable");
  136.   Put_Line(P,S & "form, if you observe the Shareware notice in Screen 104.");
  137.   Put_Line(P,S & "Please distribute complete copies of the AdaTutor program");
  138.   Put_Line(P,S & "along with this book.  If you don't have a copy of");
  139.   Put_Line(P,S & "AdaTutor, send $35 for a registered copy for full use by");
  140.   Put_Line(P,S & "one individual, or visit us on the World Wide Web,");
  141.   Put_Line(P,S & "download a trial copy, and register later for $25.");
  142.   New_Line(P);
  143.   Put_Line(P,S & "             SOFTWARE INNOVATIONS TECHNOLOGY");
  144.   Put_Line(P,S & "                   1083 MANDARIN DR NE");
  145.   Put_Line(P,S & "                  PALM BAY FL 32905-4706");
  146.   New_Line(P);
  147.   Put_Line(P,S & "                      (321) 951-0233");
  148.   New_Line(P);
  149.   Put_Line(P,S & "                     www.adatutor.com");
  150.   New_Page(P);
  151.   New_Line(P);
  152. end Print_Title_Page;
  153. 
  154. separate (Book)
  155. procedure Print_Screen(SN : in Integer) is
  156.   Expanding    : Boolean := False;      -- True when expanding multiple spaces.
  157.   Literal      : Boolean := False;       -- True to print next character as is.
  158.   Prompting    : Boolean := False;     -- True for first character in a prompt.
  159.   Bold         : Boolean := False;       -- True when text is being emphasized.
  160.   Outp1, Outp2 : String(1 ..120) := (others => ' ');   -- Lines of output text.
  161.   Place        : Integer := 1;      -- Current position within Outp1 and Outp2.
  162.   Limit        : Integer;         -- Position of last non-space char. in Outp2.
  163.   Line_Num     : Integer := 1;                 -- Current line being displayed.
  164.   Space        : constant String(1 .. 69) := (others => ' ');
  165.   procedure Show(C : in Character) is separate;
  166.   procedure Screen_Char is separate;
  167.   procedure End_Of_Screen is separate;
  168. begin
  169.   if SN = 103 then
  170.     Put(P, Space(1 .. 27) & "*** X TAKES YOU HERE. ***");
  171.     Put_Line(P, Space(1 .. 17) & "Screen 103");
  172.   else
  173.     Put_Line(P, Space & "Screen" & Integer'Image(SN));
  174.   end if;
  175.   New_Line(P, 2);
  176.   Vpos := 95*(Character'Pos(Indx(SN*4 - 394)) - 32) +         -- Point to start
  177.               Character'Pos(Indx(SN*4 - 393)) - 32;           -- of current
  178.   Hpos := Character'Pos(Indx(SN*4 - 392)) - 32;               -- screen.
  179.   Random_IO.Read(Data_File, Item => Block, From => Random_IO.Count(Vpos));
  180.   while Block(Hpos) /= '[' or Expanding or Literal loop  -- [ starts ctrl info.
  181.     Screen_Char;
  182.   end loop;
  183.   End_Of_Screen;
  184. end Print_Screen;
  185. 
  186. separate (Book.Print_Screen)
  187. procedure Show(C : in Character) is
  188. begin
  189.   Outp1(Place) := C;
  190.   if Bold then
  191.     Outp2(Place) := '-';
  192.   end if;
  193.   Place := Place + 1;
  194. end Show;
  195.  
  196.  
  197.  
  198. separate (Book.Print_Screen)
  199. procedure Screen_Char is
  200.   procedure Process_Char is separate;
  201. begin
  202.   if Expanding then
  203.     if Block(Hpos) = '!' then
  204.       Literal := True;
  205.     else
  206.       for I in Integer range 1 .. Character'Pos(Block(Hpos)) - 32 loop
  207.         Show(' ');
  208.       end loop;
  209.     end if;
  210.     Expanding := False;
  211.   elsif Literal then
  212.     Show(Block(Hpos));
  213.     Literal := False;
  214.   elsif Prompting then
  215.     Prompting := False;
  216.     if Block(Hpos) = 'b' then
  217.       Put(P, "Please type a space to go on, or B to go back.");
  218.     elsif Block(Hpos) = 'q' then
  219.       Put(P, "Please type a space to go on, or B to go back ");
  220.       Put(P, "to the question.");
  221.     else
  222.       Process_Char;
  223.     end if;
  224.   else
  225.     Process_Char;
  226.   end if;
  227.   Hpos := Hpos + 1;
  228.   if Hpos > Block'Length then
  229.     Vpos := Vpos + 1;
  230.     Hpos := 1;
  231.     Random_IO.Read(Data_File, Block, From => Random_IO.Count(Vpos));
  232.   end if;
  233. end Screen_Char;
  234. 
  235. separate (Book.Print_Screen.Screen_Char)
  236. procedure Process_Char is
  237. begin
  238.   case Block(Hpos) is
  239.     when '{'    => Put_Line(P, Outp1(1 .. Place - 1));
  240.                    Limit := Outp2'Last;
  241.                    while Limit > 0 and then Outp2(Limit) = ' ' loop
  242.                       Limit := Limit - 1;
  243.                    end loop;
  244.                    Put_Line(P, Outp2(1 .. Limit));
  245.                    Outp2 := (others => ' ');
  246.                    Line_Num := Line_Num + 1;
  247.                    Outp1 := (others => ' ');
  248.                    Place := 1;
  249.     when '`'    => Expanding := True;                   -- ` = several spaces.
  250.     when '^'    => Bold := not Bold;                    -- ^ = toggle bright.
  251.     when '}'    => for I in Line_Num .. 23 loop         -- } = go to line 24.
  252.                      New_Line(P, 2);
  253.                    end loop;
  254.                    Prompting := True;
  255.     when '~'    => null;                                -- ~ = toggle rev. vid.
  256.     when '$'    => if SN = 103 then                     -- $ = screen #.
  257.                      Show(' '); Show('_'); Show('_'); Show('_');
  258.                    else
  259.                      Show('$');
  260.                    end if;
  261.     when '#'    => if SN = 103 then                     -- # = % completed.
  262.                      Show(' '); Show('_'); Show('_');
  263.                    else
  264.                      Show('#');
  265.                    end if;
  266.     when others => Show(Block(Hpos));
  267.   end case;
  268. end Process_Char;
  269. 
  270. separate (Book.Print_Screen)
  271. procedure End_Of_Screen is
  272.   Ctrl_Info : Block_Subtype;           -- Control info. for the current screen.
  273.   I         : Integer;                      -- Used to index through Ctrl_Info.
  274. begin
  275.   Put_Line(P, Outp1(1 .. Place - 1));
  276.   Limit := Outp2'Last;
  277.   while Limit > 0 and then Outp2(Limit) = ' ' loop
  278.     Limit := Limit - 1;
  279.   end loop;
  280.   Put_Line(P, Outp2(1 .. Limit));
  281.   Place := 1;
  282.   while Block(Hpos) /= ']' loop     -- Read control information from Data File.
  283.     Hpos := Hpos + 1;
  284.     if Hpos > Block'Length then
  285.       Vpos := Vpos + 1;
  286.       Hpos := 1;
  287.       Random_IO.Read(Data_File, Block, From => Random_IO.Count(Vpos));
  288.     end if;
  289.     Ctrl_Info(Place) := Block(Hpos);
  290.     Place := Place + 1;
  291.   end loop;
  292.   if Ctrl_Info(1 .. Place - 1) = "]" then
  293.     Put_Line(P, "(Program ends after this screen.)");
  294.   elsif Ctrl_Info(1 .. Place - 1) = "#]" then
  295.     Put_Line(P, "(User types the next screen number.)");
  296.   else
  297.     I := 1;
  298.     while I + 4 < Place loop
  299.       Put(P, "  '" & Ctrl_Info(I) & "' " & Ctrl_Info(I+1..I+3));
  300.       I := I + 4;
  301.       if I = 33 then
  302.         New_Line(P);
  303.       end if;
  304.     end loop;
  305.     New_Line(P);
  306.   end if;
  307.   New_Page(P);
  308.   New_Line(P);
  309. end End_Of_Screen;
  310.  
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin
copy 
21
compilation info 
gnatgcc -c -pipe -O2 prog.adb
prog.adb:63:01: end of file expected, file can have only one compilation unit
gnatmake: "prog.adb" compilation error
stdout
copy 
Standard output is empty
https://ideone.com/SLJ5J
language:
Ada95 (gnat 8.3)
created:
14 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!