|
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: 8061 (0x1f7d)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Boolean_Class;
with Bounded_String;
with Integer_Class;
with Msg_Report;
with Object;
with Scanner;
with String_Utilities;
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 Is_Equal_String
(Str1 : String; Str2 : String; Ignore_Case : Boolean := True)
return Boolean renames String_Utilities.Equal;
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 First_Free return Natural is
Pos : Natural := 0;
begin
for I in Instance_Table'Range loop
if Instance_Table (I).Indic = Unused then
Pos := I;
exit;
end if;
end loop;
if Pos /= 0 then
return Pos;
else
Msg_Report.Interpret_Error ("sorry, string instance table is full");
raise Instance_Table_Full;
end if;
end First_Free;
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 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;
function Send (To_Object : Object.Reference;
The_Message : Message.Selector;
With_Arguments : Arguments.List := Arguments.Void_Arguments)
return Object.Reference is
Result, Object1, Object2 : Object.Reference;
Args : Arguments.List;
begin
Object1 := To_Object;
Args := With_Arguments;
case Arguments.How_Many (Args) is
when 0 =>
if Is_Equal_String
(Message.Image (The_Message), "Capitalise") then
Msg_Report.Information ("message is Capitalise ");
Result := Capitalize (Object1);
elsif Is_Equal_String
(Message.Image (The_Message), "TaTaille") then
Msg_Report.Information ("message is TaTaille ");
Result := Integer_Class.Create (Integer (Size (Object1)));
elsif Is_Equal_String
(Message.Image (The_Message), "EnMajuscule") then
Msg_Report.Information ("message is enmajuscule ");
Result := Upper_Case (Object1);
elsif Is_Equal_String
(Message.Image (The_Message), "EnMinuscule") then
Msg_Report.Information ("message is enminuscule ");
Result := Lower_Case (Object1);
else
Msg_Report.Interpret_Error
("Incorrect unary method " &
Message.Image (The_Message) &
" for object " & In_Text (Object1));
raise Incorrect_Method;
end if;
when 1 =>
Arguments.First (Args);
Arguments.Read (Args, Object2);
if Message.Image (The_Message) = "+" then
Msg_Report.Information ("Message is +");
Result := Object1 + Object2;
elsif Message.Image (The_Message) = "=" then
Msg_Report.Information ("Message is =");
Result := Is_Equal (Object1, Object2);
else
Msg_Report.Interpret_Error
("Incorrect binary method " &
Message.Image (The_Message) &
" for object " & In_Text (Object1));
raise Incorrect_Method;
end if;
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;
end String_Class;