|
|
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 - metrics - downloadIndex: B T
Length: 3661 (0xe4d)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─⟦d65440be7⟧ »DATA«
└─⟦this⟧
with Mac_Types;
with System;
with Unchecked_Conversion;
package body Mac_Text is
function Length (T : Text) return Index is
begin
return T.Length;
end Length;
procedure Set_Length (T : in out Text; L : Index) is
begin
T.Length := L;
end Set_Length;
function Maximum_Length (T : Text) return Index is
begin
return T.Maximum_Length;
end Maximum_Length;
function Value (T : Text) return String is
begin
if T.Length > 0 then
declare
S : String (0 .. T.Length - 1);
begin
S (S'Range) := T.Value (1 .. T.Length);
return S;
end;
else
return "";
end if;
end Value;
function Value (T : Text) return Mac_Types.Str255 is
S : Mac_Types.Str255;
begin
for Index in 1 .. T.Length loop
S (Index) := T.Value (Index);
end loop;
S (0) := Mac_Types.Char'Val (T.Length);
return S;
end Value;
function Value (Where : Index; T : Text) return Mac_Types.Char is
begin
if Where <= T.Length then
return T.Value (Where);
else
raise Constraint_Error;
end if;
end Value;
function Empty (T : Text) return Boolean is
begin
return T.Length = 0;
end Empty;
procedure Set_Empty (T : in out Text) is
begin
T.Length := 0;
end Set_Empty;
function To_Text (S : String; Max : Index) return Text is
T : Text (Max);
begin
T.Value (1 .. S'Length) := S (S'Range);
T.Length := S'Length;
return T;
end To_Text;
function To_Text (C : Mac_Types.Char; Max : Index) return Text is
T : Text (Max);
begin
T.Value (1) := C;
T.Length := 1;
return T;
end To_Text;
function To_Text (S : String) return Text is
begin
return To_Text (S, S'Length);
end To_Text;
function To_Text (C : Mac_Types.Char) return Text is
begin
return To_Text (C, 1);
end To_Text;
procedure Set (T : in out Text; Value : Text) is
begin
if Value.Length > 0 then
T.Value (Value.Value'Range) := Value.Value;
end if;
T.Length := Value.Length;
end Set;
procedure Set (T : in out Text; Value : String) is
begin
if Value'Length > 0 then
T.Value (1 .. Value'Length) := Value;
end if;
T.Length := Value'Length;
end Set;
procedure Set (T : in out Text; Value : Mac_Types.Char) is
begin
T.Value (1) := Value;
T.Length := 1;
end Set;
procedure Append (Tail : Text; To : in out Text) is
begin
if Tail.Length > 0 then
To.Value (To.Length + 1 .. To.Length + Tail.Length) := Tail.Value;
To.Length := To.Length + Tail.Length;
end if;
end Append;
procedure Append (Tail : String; To : in out Text) is
begin
if Tail'Length > 0 then
To.Value (To.Length + 1 .. To.Length + Tail'Length) := Tail;
To.Length := To.Length + Tail'Length;
end if;
end Append;
procedure Append (Tail : Mac_Types.Char; To : in out Text) is
begin
To.Value (To.Length + 1) := Tail;
To.Length := To.Length + 1;
end Append;
function As_Ptr (T : Text) return Mac_Types.Ptr is
function As_Ptr is new Unchecked_Conversion (Source => System.Address,
Target => Mac_Types.Ptr);
begin
return As_Ptr (T.Value (T.Value'First)'Address);
end As_Ptr;
end Mac_Text;