Category : Miscellaneous Language Source Code
Archive   : ADAMENU2.ZIP
Filename : STRINGS.PKG

 
Output of file : STRINGS.PKG contained in archive : ADAMENU2.ZIP
-- .asis
with Text_IO;
use Text_IO;

package body Strings is

package Int_IO is new Integer_IO (INTEGER);

procedure ReadString (Lstr : out Lstring) is
I : INTEGER := 0;
begin
Lstr.Len := 0;
while End_Of_Line loop Skip_Line; end loop;
while not End_Of_Line loop
exit when (I+1 > Lstr.Data'Last);
Text_IO.Get (Lstr.Data (I+1));
I := I+1;
Lstr.Len := I;
end loop;
end ReadString;

procedure WriteString (Lstr : in Lstring) is
begin
for I in 1..Lstr.Len loop
Text_IO.Put (Lstr.Data (I));
end loop;
end WriteString;

function Length (S : in Lstring) return INTEGER is
-- return the current length of s
begin
return S.Len;
end Length;

procedure Delete (St : in out Lstring;
Pos, Cnt : in INTEGER) is
-- delete Cnt characters from St starting at Pos
J : INTEGER;
Temp : Lstring;
begin
if (Pos+Cnt-1 > Length (St)) then
return;
end if;
J := Pos;
Temp := St;
for I in Pos+Cnt..Length (St) loop
Temp.Data (J) := St.Data (I);
J := J+1;
end loop;
Temp.Len := Length (St) - Cnt;
St := Temp;
exception
when STORAGE_ERROR => Raise;
end Delete;

function Concat (Str : in Lstring;
Ch : in CHARACTER) return Lstring is
-- append Ch to the end of Str
Temp : Lstring;
begin
Temp := str;
Temp.Len := Temp.Len + 1;
Temp.Data (Length(Temp)) := Ch;
return Temp;
exception
when STORAGE_ERROR => Raise;
end Concat;

function Concat (Str1, Str2 : in Lstring) return Lstring is
-- append ch to the end of str
Temp : Lstring;
begin
Temp := Str1;
Temp.Len := Temp.Len + Str2.Len;
Temp.Data (Str1.Len+1..Str1.Len+Str2.Len) :=
Str2.Data (1..Str2.Len);
return Temp;
exception
when STORAGE_ERROR => Raise;
end Concat;

function "+" (Lstr : in Lstring;
Str : in STRING) return Lstring is
-- append Str to the end of Lstr
Temp : Lstring := Lstr;
begin
Temp.Len := Temp.Len + Str'Last;
Temp.Data (Lstr.Len+1..Lstr.Len+Str'Last) := Str;
return Temp;
exception
when STORAGE_ERROR => Raise;
end "+";

function "+" (Str : in STRING;
Lstr : in Lstring) return Lstring is
-- append Lstr to the end of Str
Temp : Lstring (Lstr.Data'Last);
begin
Temp.Data (1..Str'Last) := Str (1..Str'Last);
if Lstr.Len = 0 then
Temp.Len := Str'Last;
else
Temp.Len := Str'Last + Lstr.Len;
Temp.Data (Str'Last+1..Str'Last+Lstr.Len) :=
Lstr.Data (1..Lstr.Len);
end if;
return Temp;
exception
when STORAGE_ERROR => Raise;
end "+";

function "+" (Lstr1, Lstr2 : in Lstring) return Lstring is
-- append Lstr2 to the end of Lstr1
Temp : Lstring := Lstr1;
begin
Temp.Data (1..Lstr1.Len) := Lstr1.Data (1..Lstr1.Len);
Temp.Len := Lstr1.Len + Lstr2.Len;
Temp.Data (Lstr1.Len+1..Lstr1.Len+Lstr2.Len) :=
Lstr2.Data (1..Lstr2.Len);
return Temp;
exception
when STORAGE_ERROR => Raise;
end "+";

function Str (Num : in INTEGER;
Len : in INTEGER := 32) return Lstring is
-- Convert num to CHARACTER string.
Ascii_Str : Lstring (Len);
I : INTEGER := 1;
begin
Int_IO.Put (Ascii_Str.Data, Num);
Ascii_Str.Len := Ascii_Str.Data'Last;
while Ascii_Str.Data(I) = ' ' loop I := I+1; end loop;
Delete (Ascii_Str, 1, I-1);
return Ascii_Str;
exception
when STORAGE_ERROR => Raise;
end Str;

function Lstr (Str : in STRING;
Length : in INTEGER) return LSTRING is
Temp : LSTRING (Length);
begin
Temp.Data (1..Length) := Str (1..Length);
Temp.Len := Length;
return Temp;
end Lstr;

end Strings;


  3 Responses to “Category : Miscellaneous Language Source Code
Archive   : ADAMENU2.ZIP
Filename : STRINGS.PKG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/