|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 8162 (0x1fe2)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Object, String_Utilities, Bounded_String, Scanner,
Msg_Report, Integer_Class, Boolean_Class;
package body String_Class is
function Bs_Image (A_String : Scanner.B_String) return String
renames Bounded_String.Image;
procedure Bs_Init (A_String : in out Scanner.B_String)
renames Bounded_String.Free;
procedure Bs_Copy (A_String : in out Scanner.B_String; A_Value : String)
renames Bounded_String.Copy;
procedure Bs_Cat (Target : in out Scanner.B_String;
Source : Scanner.B_String) renames Bounded_String.Append;
function Bs_Length (A_String : Scanner.B_String) return Natural
renames Bounded_String.Length;
function Su_Lower (A_String : String) return String
renames String_Utilities.Lower_Case;
function Su_Upper (A_String : String) return String
renames String_Utilities.Upper_Case;
function Su_Capitalize (A_String : String) return String
renames String_Utilities.Capitalize;
Max : constant := 100;
Instance_Table : array (1 .. Max) of Struct_Table;
function Create (Value : String) return Object.Reference is
Pos : Natural;
A_String : Scanner.B_String;
The_Class : Object.Class := Object.C_String;
begin
Bs_Init (A_String);
Bs_Copy (A_String, Value);
Pos := First_Free;
Instance_Table (Pos).Indic := Used;
Instance_Table (Pos).Value := A_String;
return Object.Create (The_Class, Pos);
end Create;
function First_Free return Natural is
Pos : Natural;
begin
for I in Instance_Table'Range loop
if Instance_Table (I).Indic = Unused then
Pos := I;
exit;
end if;
end loop;
return Pos;
exception
when others =>
raise Instance_Table_Full;
end First_Free;
function Send (To_Object : Object.Reference;
The_Message : Message.Selector;
With_Arguments : Arguments.List) return Object.Reference is
type Unary_Msg is (Capitalise, Tataille, Enmajuscule, Enminuscule);
type Binary_Msg is (Plus, Equal);
Result, Object1, Object2 : Object.Reference;
Args : Arguments.List;
Msg : Message.Selector := Message.Void_Selector;
An_Unary_Msg : Unary_Msg;
A_Binary_Msg : Binary_Msg;
begin
Object1 := To_Object;
Args := With_Arguments;
case Arguments.How_Many (Args) is
when 0 =>
An_Unary_Msg := Unary_Msg'Value (Message.Image (The_Message));
case An_Unary_Msg is
when Capitalise =>
Msg_Report.Information ("message is Capitalise ");
Result := Capitalize (Object1);
when Tataille =>
Msg_Report.Information ("message is tataille ");
Result := Integer_Class.Create
(Integer (Size (Object1)));
when Enmajuscule =>
Msg_Report.Information ("message is enmajuscule ");
Result := Upper_Case (Object1);
when Enminuscule =>
Msg_Report.Information ("message is enminuscule ");
Result := Lower_Case (Object1);
when others =>
Msg_Report.Interpret_Error
("Incorrect unary method " &
Message.Image (The_Message) &
" for object " & In_Text (Object1));
raise Incorrect_Method;
end case;
when 1 =>
Arguments.First (Args);
Arguments.Read (Args, Object2);
if Message.Image (The_Message) = "+" then
Msg_Report.Information ("Message is +");
A_Binary_Msg := Plus;
elsif Message.Image (The_Message) = "=" then
Msg_Report.Information ("Message is =");
A_Binary_Msg := Equal;
end if;
case A_Binary_Msg is
when Plus =>
Result := Object1 + Object2;
when Equal =>
Result := Is_Equal (Object1, Object2);
when others =>
Msg_Report.Interpret_Error
("Incorrect binary method " &
Message.Image (The_Message) &
" for object " & In_Text (Object1));
raise Incorrect_Method;
end case;
when others =>
Msg_Report.Interpret_Error
("Incorrect nb of arguments for method " &
Message.Image (The_Message) &
" to object " & In_Text (Object1));
raise Incorrect_Nb_Args;
end case;
return Result;
end Send;
function Delete (The_String : Object.Reference) return Object.Reference is
begin
Instance_Table (Object.Identificator (The_String)).Indic := Unused;
return Object.Void_Reference;
end Delete;
function Size (The_String : Object.Reference) return Natural is
begin
return Bs_Length
(Instance_Table (Object.Identificator (The_String)).Value);
end Size;
function In_Text (The_String : Object.Reference) return String is
begin
return Bs_Image
(Instance_Table (Object.Identificator (The_String)).Value);
end In_Text;
function Lower_Case (The_String : Object.Reference)
return Object.Reference is
Result : Object.Reference;
begin
Result := Delete (The_String);
Result :=
Create (Su_Lower
(Bs_Image
(Instance_Table (Object.Identificator (The_String)).
Value)));
return Result;
end Lower_Case;
function Upper_Case (The_String : Object.Reference)
return Object.Reference is
Result : Object.Reference;
begin
Result := Delete (The_String);
Result :=
Create (Su_Upper
(Bs_Image
(Instance_Table (Object.Identificator (The_String)).
Value)));
return Result;
end Upper_Case;
function Capitalize (The_String : Object.Reference)
return Object.Reference is
Result : Object.Reference;
begin
Result := Delete (The_String);
Result :=
Create (Su_Capitalize
(Bs_Image
(Instance_Table (Object.Identificator (The_String)).
Value)));
return Result;
end Capitalize;
function "+" (First_String : Object.Reference;
Second_String : Object.Reference) return Object.Reference is
Source, Target : Scanner.B_String;
Result : Object.Reference;
begin
Source := Instance_Table (Object.Identificator (Second_String)).Value;
Target := Instance_Table (Object.Identificator (First_String)).Value;
Bs_Cat (Target, Source);
Result := Delete (First_String);
Result := Create (Bs_Image (Target));
return Result;
end "+";
function Is_Equal (First_String : Object.Reference;
Second_String : Object.Reference)
return Object.Reference is
begin
return Boolean_Class.Create
(Bs_Image
(Instance_Table (Object.Identificator (First_String)).
Value) =
Bs_Image
(Instance_Table (Object.Identificator (Second_String)).
Value));
end Is_Equal;
end String_Class;