-- ================================================================ -- Standard_IO.adb -- -- This is an elementary IO package for getting and putting -- data on a screen. It has no facility for cursor positioning -- or other fancy features. It is useful as an IO package for -- beginning students of Ada since it does not require an -- instantiation of predefined types Integer and Float. -- -- This is intended only as a package to facilitate the student's -- learning of the elements of Ada. It is not a substitute for -- advanced IO features required for more robust implementations. -- -- ================================================================ with Text_IO; pragma Elaborate(Text_IO); package body Standard_IO is package IIO is new Text_IO.Integer_IO(Num => Integer); package LIIO is new Text_IO.Integer_IO(Num => Long_Integer); package FIO is new Text_IO.Float_IO (Num => Float); -- package LFIO is new Text_IO.Float_IO (Num => Long_Float); package AIO is new Text_IO.Enumeration_IO (ENum => Answer); SPACE : constant Character := ' '; ZERO : constant := 0; F_Zero : constant := 0.0; NUL : constant Character := Ascii.Nul; function Start(S : String) return Natural is Result : Natural := 0; begin for I in S'Range loop if S(I) /= SPACE then Result := I; exit; end if; end loop; return Result; end Start; procedure Flush_Input_Line is begin Text_IO.Skip_Line; end Flush_Input_Line; function Is_Valid(Data : in String) return Boolean is Result : Boolean := True; Point : Boolean := False; Sign : Boolean := False; begin case Data(Data'First) is when '-' | '+' => Sign := True; when '.' => Point := True; when '0'..'9' => Result := True; when others => Result := False; end case; case Data(Data'Last) is when '-' | '+' => if Sign then Result := False; else Sign := True; end if; when '.' => if Point then Result := False; else Point := True; end if; when '0'..'9' => null; when others => Result := False; end case; for I in Data'First + 1.. Data'Last - 1 loop case Data(I) is when '.' => if Point then Result := False; else Point := True; end if; when '0'..'9' => null; when others => Result := False; end case; end loop; return Result; end Is_Valid; procedure Format(Data : in String; Value : out String; Length : out Natural; Is_Valid : out Boolean) is Sign : Boolean := False; Point : Boolean := False; Valid : Boolean := True; First : Natural := Data'First; Last : Natural := Data'Last; Work : String(First..Last + 1) := (others => ' '); Index : Natural := 0; Sign_Field : Character := '+'; begin Check_Sign: begin If Data(First) = '-' or else Data(First) = '+' then Sign_Field := Data(First); First := Data'First + 1; elsif Data(Last) = '-' or else Data(Last) = '+' then Sign_Field := Data(Last); Last := Last - 1; else Sign_Field := '+'; end if; end Check_Sign; Scan_Field_and_Format: begin for I in First..Last loop Index := Index + 1; case Data(I) is when '0'..'9' => Work(Index) := Data(I); when '-' | '+' => Valid := False; when '.' => Check_Decimal: begin if Point then Valid := False; elsif I = First then Work(Index) := '0'; Index := Index + 1; Work(Index) := '.'; Point := True; elsif I = Last then Work(Index) := '.'; Index := Index + 1; Work(Index) := '0'; Point := True; else Work(Index) := Data(I); Point := True; end if; end Check_Decimal; when others => Valid := False; end case; end loop; end Scan_Field_And_Format; if Point = True then Length := Index + 1; Value(1..Index + 1) := Sign_Field & Work(1..Index); else Length := Index + 3; Value(1..Index + 3) := Sign_Field & Work(1..Index) & ".0"; end if; Is_Valid := Valid; end Format; procedure Get_Float(Text : String; Data : out Float) is Tries : Natural := 0; Result : Float := 0.0; Formatted_Text : String(1..20) := (others => ' '); Len : Natural := 0; OK : Boolean := True; Last : Positive; begin if Text(Text'First) = '0' then -- and Text(Positive'Succ(Text'First)) = ' ' then Formatted_Text(1..3) := "0.0"; Len := 3; Data := 0.0; else Format(Text(Text'Range), Formatted_Text, Len, OK); end if; if OK then FIO.Get(From => Formatted_Text(1..Len), Item => Result, Last => Last); Data := Result; else Data := 0.0; raise Invalid_Data; end if; exception when others => raise Invalid_Data; end Get_Float; procedure New_Line(Number : Positive := 1) is begin Text_IO.New_Line(Text_IO.Positive_Count(Number)); end New_Line; procedure Set_Col(Number : Positive) is begin Text_IO.Set_Col(Text_IO.Positive_Count(Number)); end Set_Col; procedure Put(Data : in Character) is begin Text_IO.Put(Data); end Put; procedure Put(Data : in Integer) is begin IIO.Put(Data); end Put; procedure Put(Data : in Long_Integer) is begin LIIO.Put(Data); end Put; procedure Put(Data : in Float; Fore, Aft : in Positive) is begin FIO.Put(Data , Fore, Aft, 0); end Put; procedure Put(Data : in String) is begin Text_IO.Put(Data); end Put; procedure Put_Line(Data : in String) is begin Text_IO.Put_Line(Data); end Put_Line; procedure Get(Data : out String; Last : out Natural) is Len : Natural := 0; STR : String (1..200) := (others => Ascii.Nul); begin Text_IO.Get_Line(STR, Len); Data(1..Len) := STR(1..Len); Last := Len; end Get; procedure Get(Prompt : in String; Data : out String; Last : out Natural) is Len : Natural := 0; STR : String (1..200) := (others => Ascii.Nul); begin Text_IO.Put(Prompt & " "); Text_IO.Get_Line(STR, Len); Data(1..Len) := STR(1..Len); Last := Len; end Get; procedure Get(Data : in out Answer) is Local_Data : Answer; begin AIO.Get(Local_Data); Data := Local_Data; exception when Text_IO.Data_Error => raise Invalid_Data; end Get; procedure Get(Prompt : in String; Data : in out Answer) is Local_Data : Answer; begin Text_IO.Put(Prompt); Get(Local_Data); Data := Local_Data; exception when Text_IO.Data_Error => raise Invalid_Data; end Get; function Get return Character is Data : Character; begin Text_IO.Get(Data); return Data; exception when Text_IO.Data_Error => raise Invalid_Data; end Get; function Get return Integer is Data : Integer; begin IIO.Get(Data); return Data; exception when Text_IO.Data_Error => raise Invalid_Data; end Get; function Get return Long_Integer is Data : Long_Integer; begin LIIO.Get(Data); return Data; exception when Text_IO.Data_Error => raise Invalid_Data; end Get; function Get(Sloppy : in Boolean := False) return Float is Data : Float; Text : String(1..20) := (others => Ascii.Nul); Len : Natural; begin if Sloppy then Get(Text, Len); If Is_Valid(Text(1..Len)) then Get_Float(Text(1..Len), Data); else raise Invalid_Data; end if; else FIO.Get(Data); end if; return Data; exception when Text_IO.Data_Error => raise Invalid_Data; end Get; function Get(Prompt : in String) return Character is Data : Character; begin Text_IO.Put(Prompt & " "); Data := Get; return Data; end Get; function Get(Prompt : in String) return Integer is Data : Integer; begin Text_IO.Put(Prompt & " "); Data := Get; return Data; exception when Text_IO.Data_Error => raise Invalid_Data; end Get; function Get(Prompt : in String; Sloppy : in Boolean := False) return Float is Data : Float; begin Text_IO.Put(Prompt & " "); Flush_Input_Line; Data := Get(Sloppy); return Data; exception when Text_IO.Data_Error => raise Invalid_Data; end Get; function Is_Yes(Value : Answer ) return Boolean is Result : Boolean := True; begin case Value is when Y | Yes => Result := True; when N | No => Result := False; end case; return Result; end Is_Yes; function Is_No (Value : Answer ) return Boolean is Result : Boolean := True; begin case Value is when Y | Yes => Result := False; when N | No => Result := True; end case; return Result; end Is_No; package body Catenators is function "&" (L : Integer; R : String) return String is Result : String(1..30) := (others => Ascii.Nul); begin IIO.Put(Result, L); return Result(Start(Result)..Result'Last) & R; end "&"; function "&" (L : String; R : Integer) return String is Result : String(1..30) := (others => Ascii.Nul); begin IIO.Put(Result, R); return L & Result(Start(Result)..Result'Last); end "&"; function "&" (L : Long_Integer; R : String) return String is Result : String(1..30) := (others => Ascii.Nul); begin LIIO.Put(Result, L); return Result(Start(Result)..Result'Last) & R; end "&"; function "&" (L : String; R : Long_Integer) return String is Result : String(1..30) := (others => Ascii.Nul); begin LIIO.Put(Result, R); return L & Result(Start(Result)..Result'Last); end "&"; function "&" (L : Float; R : String) return String is Result : String(1..30) := (others => Ascii.Nul); begin FIO.Put(Result, L, EXP => 0); return Result(Start(Result)..Result'Last) & R; end "&"; function "&" (L : String; R : Float) return String is Result : String(1..30) := (others => Ascii.Nul); begin FIO.Put(Result, R, EXP => 0); return L & Result(Start(Result)..Result'Last); end "&"; -- function "&" (L : Long_Float; R : String) return String is -- Result : String(1..30) := (others => Ascii.Nul); -- begin -- LFIO.Put(Result, L, EXP => 0); -- return Result(Start(Result)..Result'Last) & R; -- end "&"; -- function "&" (L : String; R : Long_Float) return String is -- Result : String(1..30) := (others => Ascii.Nul); -- begin -- LFIO.Put(Result, R, EXP => 0); -- return L & Result(Start(Result)..Result'Last); -- end "&"; end Catenators; end Standard_IO;