io_view.adb010064400072050000144000000144330724274012600133040ustar00dalestaff00002620000002-- This program displays the workings of the Ada.Text_io model -- It supports the primary input routines, except for integer/ -- float input, look_ahead & get_immediate -- -- Visible_IO loads a file into an Unbounded_String, all Input -- is then performed on this string via (major) modifications -- to the Gnat Ada.Text_IO package -- -- Author: Dale Stanbrough, -- Dept. of Computer Science -- RMIT, Melbourne Australia -- 13/July/97 -- -- To install... -- -- Package Screen simply uses ascii escape routines to -- move the cursor around. -- -- The package Visible_IO was based on the Gnat implementation -- of Ada.Text_IO, and so carries with it any corresponding copyright -- which -- with Ada.Command_Line; use Ada.Command_Line; with Ada.Integer_Text_IO; with Ada.Text_IO; with Ada.Exceptions; use Ada.Exceptions; with Screen; with Visible_IO; use Visible_Io; procedure IO_View is package ATIO renames Ada.Text_IO; package AITIO renames Ada.Integer_Text_IO; procedure Menu is Use Ada.Text_IO; begin Screen.Move (Row => 5, Col => 1); Put_Line (" C Get Character"); Put_Line (" I Get Integer"); Put_Line (" S Get String (1..20)"); Put_Line (" L Get_Line String (1..20)"); Put_Line (" K Skip_Line"); Put_Line (" O Get String (1..?)"); Put_Line (" G Get_Line String (1..?)"); Put_Line (" R Reset"); Put_Line (" U Undo"); Put_Line (" Q Quit"); end Menu; procedure Put (Item : Boolean) is begin if Item then ATIO.Put ("true "); else ATIO.Put ("false"); end if; end Put; Screen_Width : constant := 80; --Coord---------------------------------------------- type Coord is record Row : Natural; Col : Natural; end record; procedure Move (Pos : Coord); procedure Clear_To_Eol (Pos : Coord); ------------------------------------------------------- procedure Move (Pos : Coord) is begin Screen.Move (Row => Pos.Row, Col => Pos.Col); end Move; procedure Clear_To_Eol (Pos : Coord) is begin for Col in Pos.Col .. Screen_Width loop ATIO.Put (' '); end loop; end; --End_Coord-------------------------------------------- Eol_Prompt : constant Coord := (15, 1); Eol_Coord : constant Coord := (15, 15); Eof_Prompt : constant Coord := (15, 25); Eof_Coord : constant Coord := (15, 40); Data_Read_Coord : constant Coord := (18, 1); Error_Coord : constant Coord := (19, 1); Command_Coord : constant Coord := (21, 1); File : File_Type; Line : String (1..20); Last : Natural; Ch : Character; Int : Integer; Command : Character; Size : Natural; begin if Argument_Count /= 1 then ATIO.Put ("You must specify one file name when " & "you run the program."); ATIO.New_Line; return; end if; Screen.Clear_Screen; Move (Eol_Prompt); ATIO.Put ("End of Line :"); Move (Eof_Prompt); ATIO.Put ("End of File :"); Menu; -- Open the requested filename Open (file, In_file, Argument (1)); loop Display (File); Move (Eol_Coord); Put (End_Of_Line (File)); Move (Eof_Coord); Put (End_Of_File (File)); Move (Command_Coord); ATIO.Get_Immediate (Command); -- User wants to do something different, so clear out messages -- about... -- ... the last item read Move (Data_Read_Coord); Clear_To_Eol (Data_Read_Coord); -- ... the last error Move (Error_Coord); Clear_To_Eol (Error_Coord); Move (Data_Read_Coord); begin case Command is when 'q' | 'Q' => exit; when 'c' | 'C' => Get (File, Ch); ATIO.Put ('''); ATIO.Put (Ch); ATIO.Put ('''); when 's' | 'S' => Get (File, Line); ATIO.Put ('"'); ATIO.Put (Line); ATIO.Put ('"'); when 'l' | 'L' => Get_Line (File, Line, Last); ATIO.Put ('"'); ATIO.Put (Line (1..Last)); ATIO.Put ('"'); when 'g' | 'G' => -- 'g' for get_line ATIO.Put ("What size string? "); Ada.Integer_Text_IO.Get (Size); ATIO.Skip_Line; declare Line : String (1..Size); Last : Natural; begin Get_Line (File, Line, Last); ATIO.Put ('"'); if Last > Screen_Width - 20 then ATIO.Put (Line (1..Screen_Width - 20)); ATIO.Put ("..."); else ATIO.Put (Line (1..Last)); end if; ATIO.Put ('"'); ATIO.Put (", No Chars Read"); AITIO.Put (Last); end; when 'o' | 'O' => -- 'o' for 'other' (i was stuck for a name...) ATIO.Put ("What size string? "); Ada.Integer_Text_IO.Get (Size); ATIO.Skip_Line; declare Line : String (1..Size); begin Get (File, Line); ATIO.Put ('"'); if Line'Length > Screen_Width - 10 then ATIO.Put (Line (1..Screen_Width - 10)); ATIO.Put ("..."); else ATIO.Put (Line); end if; ATIO.Put ('"'); end; when 'i' | 'I' => Get (File, Int); AITIO.Put (Int, Width => 0); when 'k' | 'K' => Skip_Line (File); when 'r' | 'R' => Reset (File); when 'u' | 'U' => Undo (File); when others => null; end case; exception when E : others => Move (Error_Coord); ATIO.Put ("Exception """); ATIO.Put (Exception_Name (E)); ATIO.Put (""" raised"); end; end loop; Close (File); end IO_View; screen.adb010064400072050000144000000022370724274012600131210ustar00dalestaff00002620000002WITH Text_IO; With Ada.Integer_Text_IO; PACKAGE BODY Screen IS -- Procedures for drawing pictures on ANSI Terminal Screen -- These procedures will work correctly only if the actual -- terminal is ANSI compatible. ANSI.SYS on a DOS machine -- will suffice. package IIO renames Ada.Integer_Text_IO; PROCEDURE Beep IS BEGIN Text_IO.Put (Item => ASCII.BEL); END Beep; PROCEDURE ClearScreen IS BEGIN Text_IO.Put (Item => ASCII.ESC); Text_IO.Put (Item => "[2J"); END ClearScreen; PROCEDURE MoveCursor (To: IN Position) IS BEGIN Text_IO.New_Line; Text_IO.Put (Item => ASCII.ESC); Text_IO.Put ("["); IIO.Put (Item => To.Row, Width => 1); Text_IO.Put (Item => ';'); IIO.Put (Item => To.Column, Width => 1); Text_IO.Put (Item => 'f'); END MoveCursor; PROCEDURE MoveCursor (Row : Height; Col : in Width) is begin Text_IO.New_Line; Text_IO.Put (Item => ASCII.ESC); Text_IO.Put ("["); IIO.Put (Item => Row, Width => 1); Text_IO.Put (Item => ';'); IIO.Put (Item => Col, Width => 1); Text_IO.Put (Item => 'f'); END MoveCursor; END Screen; screen.ads010064400072050000144000000016130724274012600131370ustar00dalestaff00002620000002PACKAGE Screen IS -- Procedures for drawing pictures on ANSI Terminal Screen -- ammended to include support for 2 parameter move procedure ScreenHeight : CONSTANT Integer := 24; ScreenWidth : CONSTANT Integer := 80; SUBTYPE Height IS Integer RANGE 1..ScreenHeight; SUBTYPE Width IS Integer RANGE 1..ScreenWidth; TYPE Position IS RECORD Row : Height := 1; Column: Width := 1; END RECORD; PROCEDURE Beep; -- Pre: none -- Post: the terminal beeps once PROCEDURE ClearScreen; -- Pre: none -- Post: the terminal screen is cleared procedure Clear_Screen renames ClearScreen; PROCEDURE MoveCursor (To: IN Position); -- Pre: To is defined -- Post: the terminal cursor is moved to the given position PROCEDURE MoveCursor (Row : in Height; Col : Width); -- As above PROCEDURE Move (Row : in Height; Col : Width) renames MoveCursor; END Screen; = 1; END RECORD; PROCEDURE Beep; -- Pre: none -- Post: the terminal beeps once PROCEDURE ClearScreen;stacks.adb010064400072050000144000000015760724274012600131370ustar00dalestaff00002620000002 package body Stacks is procedure Push (Item : in out Stack; Value : in Element) is begin if Item.Enabled then if Item.Top = Index_Range'last then raise Overflow; end if; Item.Top := Item.Top + 1; Item.Values (Item.Top) := Value; end if; end Push; procedure Pop (Item : in out Stack; Value : out Element) is begin if Item.Enabled then if Item.Top = 1 then raise Underflow; end if; Value := Item.Values (Item.Top); Item.Top := Item.Top - 1; end if; end Pop; procedure Clear (Item : in out Stack) is begin Item.Top := 0; end Clear; procedure Enable (Item : in out Stack) is begin Item.Enabled := true; end; procedure Disable (Item : in out Stack) is begin Item.Enabled := false; end Disable; end; stacks.ads010064400072050000144000000014040724274012700131470ustar00dalestaff00002620000002-- Typical standard stack package generic type Element is private; Size : Positive; package Stacks is type Stack is private; procedure Push (Item : in out Stack; Value : in Element); procedure Pop (Item : in out Stack; Value : out Element); procedure Clear (Item : in out Stack); Underflow : exception; Overflow : exception; procedure Disable (Item : in out Stack); procedure Enable (Item : in out Stack); private subtype Count is Integer range 0 .. Size; subtype Index_Range is Integer range 1..Count'Last; type Value_Array is array (Index_Range) of Element; type Stack is record Enabled : Boolean := true; Values : Value_Array; Top : Count := 0; end record; end; visible_io.adb010064400072050000144000000265210724274012700137710ustar00dalestaff00002620000002------------------------------------------------------------------------------ -- Software developed from ACT's Gnat Ada.text_IO package -- Copyright (C) 1992-1997 Free Software Foundation, Inc. -- -- -- -- This software package was derived from Gnat's implementation of the -- Ada Text_IO package. As such it carries with it the copyright of the FSF. -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ -- with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Text_IO; with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; with Screen; package body Visible_IO is Screen_Width : constant := 80; ------------- -- Display -- ------------- procedure Display (File : File_Type) is use Ada.Text_IO; Start : Positive; Finish : Positive; Ch : Character; Window : Natural; -- the file is notionally divided into windows, each the -- width of the screen. As we fall off one window, we move to the -- next, and draw the file pointer into that window Offset : Natural range 0..Screen_Width; -- the offset into the window -- should be 1....? begin Screen.Move (1,1); Window := (File.Upto / Screen_Width) + 1; Offset := File.Upto mod Screen_Width + 1; Start := (Window - 1) * Screen_Width + 1; Finish := Integer'Min (Length (File.Data), (Window ) * Screen_Width ); -- Display the current window into the file for i in Start .. Finish loop Ch := Element (File.Data, i); if Ch = EOL then put ('#'); elsif Ch = EOF then put ('@'); else put (Ch); end if; end loop; -- Rub out any characters from the last window for i in Finish + 1 .. Window * Screen_Width loop Put (' '); end loop; New_Line; Screen.Move (2,1); -- Display the file pointer into the file for i in Start .. File.Upto - 1 loop Put (' '); end loop; Put ('^'); -- Rub out any old file pointers for i in File.Upto + 1 .. Window * Screen_Width loop Put (' '); end loop; New_Line; end Display; ----------- -- Undo -- ----------- procedure Undo (File : in out File_Type) is begin Pop (File.History, File.Upto); Display (File); exception when Underflow => null; end Undo; ----------- -- Close -- ----------- procedure Close (File : in out File_Type) is begin File.Data := Null_Unbounded_String; Clear (File.History); end Close; ----------------- -- End_Of_File -- ----------------- function End_Of_File (File : in File_Type) return Boolean is begin return Element (File.Data, File.Upto) = EOF; end End_Of_File; ----------------- -- End_Of_Line -- ----------------- function End_Of_Line (File : in File_Type) return Boolean is begin return Element (File.Data, File.Upto) = EOL; end End_Of_Line; --------- -- Get -- --------- procedure Get (File : in out File_Type; Item : out Character) is begin Push (File.History, File.Upto); loop Item := Element (File.Data, File.Upto); if Item = EOF then raise End_Error; end if; File.Upto := File.Upto + 1; exit when Item /= EOL; end loop; end Get; ----------- -- Get -- ----------- procedure Get (File : in out File_Type; Item : out String) is begin Push (File.History, File.Upto); -- We don't want the individual Get's clogging up the history -- stack... Disable (File.History); for J in Item'Range loop Get (File, Item (J)); end loop; Enable (File.History); exception when others => Enable (File.History); raise; end Get; -------------- -- Get_Line -- -------------- procedure Get_Line (File : in out File_Type; Item : out String; Last : out Natural) is Ch : Character; begin Push (File.History, File.Upto); Last := Item'First - 1; -- Immediate exit for null string, this is a case in which we do not -- need to test for end of file and we do not skip a line mark under -- any circumstances. if Last >= Item'Last then return; end if; -- Here we have at least one character, if we are immediately before -- a line mark, then we will just skip past it storing no characters. for J in Item'Range loop -- If we are at the end of file now, it means we are trying to -- skip a file terminator and we raise End_Error (RM A.10.7(20)) Ch := Element (File.Data, File.Upto); File.Upto := File.Upto + 1; if Ch = EOL then return; end if; -- I don't quite understand what's happening here, so i'll -- just say you get an empty string if you attempt to read -- from a null file if ch = EOF and then Last < Item'First then raise End_Error; end if; -- Loop through characters. Don't bother if we hit a page mark, -- since in normal files, page marks can only follow line marks -- in any case and we only promise to treat the page nonsense -- correctly in the absense of such rogue page marks. exit when ch = EOL or ch = EOF; Last := Last + 1; Item (Last) := Ch; end loop; end Get_Line; ---------------- -- Look_Ahead -- ---------------- procedure Look_Ahead (File : in out File_Type; Item : out Character; End_Of_Line : out Boolean) is begin End_Of_Line := Element (File.Data, File.Upto) = EOL; if End_Of_Line then Item := Ascii.NUL; else Item := Element (File.Data, File.Upto); end if; end Look_Ahead; ------------------- -- Skip_Spaces -- ------------------- procedure Skip_Spaces (File : in out File_Type) is Ch : Character; begin loop Ch := Element (File.Data, File.Upto); if Ch = EOF then raise End_Error; end if; if Ch = Eol then null; else exit when Ch /= ' '; end if; File.Upto := File.Upto + 1; end loop; end Skip_Spaces; procedure Get (File : in out File_Type; Item : out Integer) is Line_End_Pos : Natural; Length : Positive; begin Push (File.History, File.Upto); Skip_Spaces (File); -- Search for the end of the existing line Line_End_Pos := File.Upto; -- if the loop fails to find an EOL, it will eventually stop -- with a string index error loop exit when Element (File.Data, Line_End_Pos) = EOL; Line_End_Pos := Line_End_Pos + 1; end loop; -- Take a slice of the from the file pointer to the end of line -- and try and extract an integer from it Ada.Integer_Text_IO.Get ( From => Slice (File.Data, File.Upto, Line_End_Pos), Item => Item, Last => Length); -- If there was a bad format, we got an exception, and won't be -- here. File.Upto := File.Upto + Length; end Get; ---------- -- Open -- ---------- -- Stuff the file into the unbounded_string, noting where -- EOL, EOF occurs. Completely ignore pages etc. -- requires the mode be of type in_file procedure Open (File : in out File_Type; Mode : in File_Mode; Name : in String; Form : in String := "") is package ATIO renames Ada.Text_IO; Text_File : ATIO.File_Type; Line : String (1..1000); Last : Natural; -- Remove any characters that are the same as EOL, EOF, so -- the user doesn't get confused -- Also removes any funny characters... procedure Strip_Chars is begin for i in 1..Last loop if Line (i) = EOL then Line (i) := '_'; elsif Line (i) = EOF then Line (i) := '_'; elsif not Is_Graphic (Line (i)) then Line (i) := '?'; end if; end loop; end Strip_Chars; begin File.Data := Null_Unbounded_String; ATIO.Open (Text_File, ATIO.In_File, Name); while not ATIO.End_Of_File (Text_File) loop AtIO.Get_Line (Text_File, Line, Last); Strip_Chars; Append (File.Data, Line (1..Last)); Append (File.Data, EOL); end loop; Append (File.Data, EOF); AtIO.Close (Text_File); -- Finally set the file pointer File.Upto := 1; Push (File.History, 1); end Open; ----------- -- Reset -- ----------- procedure Reset (File : in out File_Type) is begin Push (File.History, File.Upto); File.Upto := 1; end Reset; ---------------- -- Skip_Line -- ---------------- procedure Skip_Line (File : in out File_Type; Spacing : in Positive_Count := 1) is ch : Character; begin if End_Of_File (File) then raise End_Error; end if; Push (File.History, File.Upto); for L in 1 .. Spacing loop loop Ch := Element (File.Data, File.Upto); if Ch /= Eof then File.Upto := File.Upto + 1; end if; exit when ch = EOL or ch = EOF; end loop; end loop; end Skip_Line; end Visible_IO; Push (File.History, File.Upto); -- We don't want the individual Get's clogging up the history -- stack... Disable (File.History); for J visible_io.ads010064400072050000144000000103070724274042200140030ustar00dalestaff00002620000002------------------------------------------------------------------------------ -- -- A D A . T E X T _ I O -- -- -- -- S p e c -- -- -- -- $Revision: 1.41 $ -- -- -- -- This specification is adapted from the Ada Reference Manual for use with -- -- GNAT. In accordance with the copyright of that document, you can freely -- -- copy and modify this specification, provided that if you redistribute a -- -- modified version, any changes that you have made are clearly indicated. -- -- -- ------------------------------------------------------------------------------ -- Heavily modifed version of Ada.Text_io, in which the normal file -- type is replaced by an Unbounded_String, to demonstrate how Ada's -- standard Input facility works with IO_Exceptions; with System.Parameters; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Stacks; package Visible_IO is type File_Type is limited private; type File_Mode is (In_File); -- The following representation clause allows the use of unchecked -- conversion for rapid translation between the File_Mode type -- used in this package and System.File_IO. type Count is range 0 .. Integer'Last; subtype Positive_Count is Count range 1 .. Count'Last; subtype Field is Integer range 0 .. 20; subtype Number_Base is Integer range 2 .. 16; type Type_Set is (Lower_Case, Upper_Case); ----------------------- -- Debugging support -- ----------------------- procedure Display (File : File_Type); -- Display the current input on the screen (assumes a screen -- width of 80 chars). Also displays the file pointer underneath procedure Undo (File : in out File_Type); -- Restores the last file pointer position. It does not redraw -- the last display. procedure Skip_Spaces (File : in out File_Type); procedure Get (File : in out File_Type; Item : out Integer); --------------------- -- File Management -- --------------------- procedure Open (File : in out File_Type; Mode : in File_Mode; Name : in String; Form : in String := ""); procedure Close (File : in out File_Type); procedure Reset (File : in out File_Type); procedure Skip_Line (File : in out File_Type; Spacing : in Positive_Count := 1); function End_Of_Line (File : in File_Type) return Boolean; function End_Of_File (File : in File_Type) return Boolean; ----------------------------- -- Characters Input-Output -- ----------------------------- procedure Get (File : in out File_Type; Item : out Character); procedure Look_Ahead (File : in out File_Type; Item : out Character; End_Of_Line : out Boolean); -------------------------- -- Strings Input-Output -- -------------------------- procedure Get (File : in out File_Type; Item : out String); procedure Get_Line (File : in out File_Type; Item : out String; Last : out Natural); -- Exceptions Status_Error : exception renames IO_Exceptions.Status_Error; Mode_Error : exception renames IO_Exceptions.Mode_Error; Name_Error : exception renames IO_Exceptions.Name_Error; Use_Error : exception renames IO_Exceptions.Use_Error; Device_Error : exception renames IO_Exceptions.Device_Error; End_Error : exception renames IO_Exceptions.End_Error; Data_Error : exception renames IO_Exceptions.Data_Error; Layout_Error : exception renames IO_Exceptions.Layout_Error; private package Int_Stacks is new Stacks (Integer, Size => 1_000); use Int_Stacks; EOL : constant Character := Ascii.LF; EOF : constant Character := Ascii.Nul; type File_Type is record Data : Unbounded_String; Upto : Natural := 0; History : Stack; end record; end Visible_IO; -- -- S p e c -- -- -- -- $Revision: 1.41 $ -- --