DataMuseum.dk

top - download

    Length: 8086 (0x1f96)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Text_Io;

use Text_Io;
package body Bounded_String_Generic is
    procedure Copy (Target : in out Variable_String;
                    Source :        Variable_String) is
    begin
        Target.Contents (1 .. Source.Length) :=
           Source.Contents (1 .. Source.Length);
        Target.Length                        := Source.Length;
    end Copy;


    procedure Copy (Target : in out Variable_String; Source : String) is
    begin
        Target.Contents (1 .. Source'Length) := Source;
        Target.Length                        := Source'Length;
    end Copy;

    procedure Copy (Target : in out Variable_String; Source : Character) is
    begin
        Target.Contents (1) := Source;
        Target.Length       := 1;
    end Copy;


    procedure Move (Target : in out Variable_String;
                    Source : in out Variable_String) is
    begin
        Target.Contents (1 .. Source.Length) :=
           Source.Contents (1 .. Source.Length);
        Target.Length                        := Source.Length;
        Source.Length                        := 0;
    end Move;


    function Image (V : Variable_String) return String is
    begin
        return V.Contents (1 .. V.Length);
    end Image;


    function Value (S : String; Max_Length : Natural) return Variable_String is
        String_Value : String (1 .. Max_Length);
    begin
        String_Value (1 .. S'Length) := S;
        return Variable_String'(Maximum_Length => Max_Length,
                                Length         => S'Length,
                                Contents       => String_Value);
    end Value;


    function Value (S : String) return Variable_String is
        String_Value : String (1 .. S'Length) := S;
    begin

        return Variable_String'(Maximum_Length => S'Length,
                                Length         => S'Length,
                                Contents       => String_Value);

    end Value;


    procedure Free (V : in out Variable_String) is
    begin
        V.Length := 0;
    end Free;


    procedure Append (Target : in out Variable_String; Source : String) is
        Len : Natural := Target.Length + Source'Length;
    begin
        Target.Contents (Target.Length + 1 .. Len) := Source;
        Target.Length := Len;
    end Append;


    procedure Append (Target : in out Variable_String;
                      Source :        Variable_String) is
    begin
        Append (Target, Image (Source));
    end Append;


    procedure Append (Target : in out Variable_String; Source : Character) is
        Len : Natural := Target.Length + 1;
    begin
        Target.Contents (Len) := Source;
        Target.Length         := Len;
    end Append;


    procedure Append (Target : in out Variable_String;
                      Source :        Character;
                      Count  :        Natural) is
        Value_String : String (1 .. Count) := String'(1 .. Count => Source);
    begin
        Append (Target, Value_String);
    end Append;


    procedure Insert (Target : in out Variable_String;
                      At_Pos :        Positive;
                      Source :        String) is
    begin
        if At_Pos = Target.Length + 1 then
            Append (Target, Source);
        elsif At_Pos <= Target.Length then
            declare
                Len : Natural := Target.Length + Source'Length;
            begin
                Target.Contents (At_Pos .. Len) :=
                   Source & Target.Contents (At_Pos .. Target.Length);
                Target.Length                   := Len;
            end;
        else
            raise Constraint_Error;
        end if;
    end Insert;


    procedure Insert (Target : in out Variable_String;
                      At_Pos :        Positive;
                      Source :        Variable_String) is
    begin
        Insert (Target, At_Pos, Source.Contents (1 .. Source.Length));
    end Insert;


    procedure Insert (Target : in out Variable_String;
                      At_Pos :        Positive;
                      Source :        Character) is
        New_Len : Natural := Target.Length + 1;
    begin
        if At_Pos = New_Len then
            Append (Target, Source);
        elsif At_Pos > New_Len then
            raise Constraint_Error;
        else
            Target.Contents (At_Pos + 1 .. New_Len) :=
               Target.Contents (At_Pos .. Target.Length);
            Target.Contents (At_Pos) := Source;
            Target.Length := New_Len;
        end if;
    end Insert;


    procedure Insert (Target : in out Variable_String;
                      At_Pos :        Positive;
                      Source :        Character;
                      Count  :        Natural) is
        Value_String : String (1 .. Count) := String'(1 .. Count => Source);
    begin
        Insert (Target, At_Pos, Value_String);
    end Insert;


    procedure Delete (Target : in out Variable_String;
                      At_Pos :        Positive;
                      Count  :        Natural := 1) is
        Len : Natural := Target.Length - Count;
    begin
        if At_Pos - 1 > Len then
            raise Constraint_Error;
        end if;
        if At_Pos <= Len then
            Target.Contents (At_Pos .. Len) :=
               Target.Contents (At_Pos + Count .. Target.Length);
        end if;
        Target.Length := Len;
    end Delete;


    procedure Replace (Target : in out Variable_String;
                       At_Pos :        Positive;
                       Source :        Character) is
    begin
        if At_Pos > Target.Length then
            raise Constraint_Error;
        else
            Target.Contents (At_Pos) := Source;
        end if;
    end Replace;


    procedure Replace (Target : in out Variable_String;
                       At_Pos :        Positive;
                       Source :        String) is
        End_Pos : constant Positive := At_Pos + Source'Length - 1;
    begin
        if End_Pos > Target.Length then
            raise Constraint_Error;
        else
            Target.Contents (At_Pos .. End_Pos) := Source;
        end if;
    end Replace;

    procedure Replace (Target : in out Variable_String;
                       At_Pos :        Positive;
                       Source :        Character;
                       Count  :        Natural) is
        Value_String : String (1 .. Count) := String'(1 .. Count => Source);
    begin
        Replace (Target, At_Pos, Value_String);
    end Replace;

    procedure Replace (Target : in out Variable_String;
                       At_Pos :        Positive;
                       Source :        Variable_String) is
    begin
        Replace (Target, At_Pos, Image (Source));
    end Replace;


    procedure Set_Length (Target     : in out Variable_String;
                          New_Length :        Natural;
                          Fill_With  :        Character := ' ') is
        Current_Length : Natural := Target.Length;
    begin
        for I in Current_Length + 1 .. New_Length loop
            Target.Contents (I) := Fill_With;
        end loop;
        Target.Length := New_Length;
    end Set_Length;


    function Length (Source : Variable_String) return Natural is
    begin
        return Source.Length;
    end Length;


    function Max_Length (Source : Variable_String) return Natural is
    begin
        return Source.Maximum_Length;
    end Max_Length;


    function Char_At (Source : Variable_String; At_Pos : Positive)
                     return Character is
    begin
        if At_Pos > Source.Length then
            raise Constraint_Error;
        else
            return Source.Contents (At_Pos);
        end if;
    end Char_At;

    function Extract (Source    : Variable_String;
                      Start_Pos : Positive;
                      End_Pos   : Natural) return String is
    begin
        if End_Pos > Source.Length then
            raise Constraint_Error;
        else
            return Source.Contents (Start_Pos .. End_Pos);
        end if;
    end Extract;

end Bounded_String_Generic;