⟦f8e76f3ad⟧

E3 Source Code



with Unbounded_String;
with String_Utilities;
with Table_Sort_Generic;
package body Line_Buffer_Bounded_Width is

    package Unbounded is new Unbounded_String (256);

    procedure Reset (The_Buffer : in out Buffer) is
    begin
        The_Buffer.Current := 1;
        The_Buffer.Size    := 0;
    end Reset;

    procedure Append (The_Buffer :        Buffer;  
                      To         : in out Buffer) is
    begin
        if The_Buffer.Size + To.Size > To.Length then
            raise Overflow;
        else
            To.Buf (To.Current .. To.Current + The_Buffer.Size - 1) :=
               The_Buffer.Buf (1 .. The_Buffer.Size);  
            To.Current := To.Current + The_Buffer.Size;
            To.Size := To.Size + The_Buffer.Size;
        end if;
    end Append;

    procedure Append_Line (The_Line : Line; To : in out Buffer) is
    begin
        if To.Current > To.Length or The_Line'Length > Width then
            raise Overflow;
        else
            Bounded_String.Copy (To.Buf (To.Current), The_Line);
            To.Current := To.Current + 1;
            To.Size    := To.Size + 1;
        end if;
    end Append_Line;

    procedure Prepend_Line (The_Line : Line; To : in out Buffer) is
    begin
        if To.Current > To.Length or The_Line'Length > Width then
            raise Overflow;
        else
            To.Buf (2 .. To.Size + 1) := To.Buf (1 .. To.Size);
            Bounded_String.Copy (To.Buf (1), The_Line);
            To.Current := To.Current + 1;
            To.Size    := To.Size + 1;
        end if;
    end Prepend_Line;

    procedure Overwrite (The_Line    :        Line;
                         At_Location :        Positive;
                         To          : in out Buffer) is
    begin
        if The_Line'Length > Width then
            raise Overflow;
        end if;
        if At_Location <= To.Length and At_Location <= To.Size then
            Bounded_String.Copy (To.Buf (At_Location), The_Line);
        else
            raise Overflow;
        end if;
    end Overwrite;

    procedure Remove (Line_At_Location :        Positive;  
                      In_Buffer        : in out Buffer) is
    begin
        if Line_At_Location <= In_Buffer.Size then
            In_Buffer.Buf (Line_At_Location .. In_Buffer.Size - 1) :=
               In_Buffer.Buf (Line_At_Location + 1 .. In_Buffer.Size);
            In_Buffer.Size := In_Buffer.Size - 1;
            In_Buffer.Current := In_Buffer.Current - 1;
        else
            raise Overflow;
        end if;
    end Remove;

    function Buffer_Length (Of_Buffer : Buffer) return Natural is
    begin
        return Natural (Of_Buffer.Size);
    end Buffer_Length;

    function String_Image (Of_Buffer : Buffer; Add_Line_Feeds : Boolean := True)
                          return String is
        Image : Unbounded.Variable_String;
    begin
        for I in 1 .. Of_Buffer.Size loop
            Unbounded.Append (Image, Bounded_String.Image (Of_Buffer.Buf (I)));
            if Add_Line_Feeds then
                Unbounded.Append (Image, Ascii.Lf);
            end if;
        end loop;
        return Unbounded.Image (Image);
    end String_Image;

    procedure Prepend (Text : String; To_All_Lines_In_Buffer : in out Buffer) is
    begin
        for I in 1 .. To_All_Lines_In_Buffer.Size loop
            Bounded_String.Insert (To_All_Lines_In_Buffer.Buf (I), 1, Text);
        end loop;
    exception
        when Constraint_Error =>
            raise Overflow;
    end Prepend;

    procedure Append (Text : String; To_All_Lines_In_Buffer : in out Buffer) is
    begin
        for I in 1 .. To_All_Lines_In_Buffer.Size loop
            Bounded_String.Append (To_All_Lines_In_Buffer.Buf (I), Text);
        end loop;
    exception
        when Constraint_Error =>
            raise Overflow;
    end Append;

    procedure Modify (The_Buffer : in out Buffer) is
    begin
        for I in 1 .. The_Buffer.Size loop
            Bounded_String.Copy (The_Buffer.Buf (I),
                                 Process (Bounded_String.Image
                                             (The_Buffer.Buf (I))));
        end loop;

    exception
        when Constraint_Error =>
            raise Overflow;
    end Modify;

    procedure Strip (The_Buffer : in out Buffer; Char : Character := ' ') is

        function Process (The_Line : Line) return Line is
        begin
            return String_Utilities.Strip (The_Line, Char);
        end Process;

        procedure Str is new Modify (Process);
    begin
        Str (The_Buffer);
    end Strip;

    procedure Strip_Leading (The_Buffer : in out Buffer;
                             Char       :        Character := ' ') is
        function Process (The_Line : Line) return Line is
        begin
            return String_Utilities.Strip_Leading (The_Line, Char);
        end Process;

        procedure Str is new Modify (Process);
    begin
        Str (The_Buffer);
    end Strip_Leading;

    procedure Strip_Trailing (The_Buffer : in out Buffer;
                              Char       :        Character := ' ') is

        function Process (The_Line : Line) return Line is
        begin
            return String_Utilities.Strip_Trailing (The_Line, Char);
        end Process;

        procedure Str is new Modify (Process);
    begin
        Str (The_Buffer);
    end Strip_Trailing;

    procedure Filter (The_Buffer : in out Buffer) is
        Filtered_Buffer : Buffer (The_Buffer.Length);
    begin
        for I in 1 .. The_Buffer.Size loop
            declare
                Line : constant String :=
                   Bounded_String.Image (The_Buffer.Buf (I));
            begin
                if not Discard (Line) then
                    Append_Line (Line, To => Filtered_Buffer);
                end if;
            end;
        end loop;
        The_Buffer := Filtered_Buffer;
    end Filter;

    procedure Sort (The_Buffer : in out Buffer) is

        The_Buf : Buffer_Lines (1 .. The_Buffer.Size) :=
           The_Buffer.Buf (1 .. The_Buffer.Size);

        function "<" (Left, Right : Var_String) return Boolean is
        begin
            return Bounded_String.Image (Left) < Bounded_String.Image (Right);
        end "<";

        procedure Buffer_Sort is
           new Table_Sort_Generic (Var_String, Positive, Buffer_Lines, "<");
    begin
        Buffer_Sort (The_Buf);
        The_Buffer.Buf (1 .. The_Buffer.Size) := The_Buf;
    end Sort;

    function Max (Left, Right : Natural) return Positive is
    begin
        if Left > Right then
            return Left;
        else
            return Right;
        end if;
    end Max;

    procedure Left_Right_Justify (The_Buffer : in out Buffer) is
        Max_Break : Natural := 0;  
    begin
        for I in 1 .. The_Buffer.Size loop

            declare
                Line          : constant String :=
                   Bounded_String.Image (The_Buffer.Buf (I));
                Current_Break : Natural         := Break_Point (Line);
            begin
                if Current_Break > Line'Last or else
                   Current_Break < Line'First then
                    null;
                else
                    Max_Break := Max (Max_Break, Current_Break);
                end if;
            end;
        end loop;

        for I in 1 .. The_Buffer.Size loop
            declare
                Line : constant String :=
                   Bounded_String.Image (The_Buffer.Buf (I));
                Current_Break : constant Positive := Break_Point (Line);
                Pad : constant String (1 .. Max_Break - Current_Break + 1) :=
                   (others => ' ');
            begin
                if Current_Break > Line'Last or else
                   Current_Break < Line'First then

                    Bounded_String.Copy (The_Buffer.Buf (I), Line);
                else
                    Bounded_String.Copy
                       (The_Buffer.Buf (I),
                        Line (Line'First .. Current_Break - 1) &
                           Pad & Line (Current_Break .. Line'Last));
                end if;
            end;
        end loop;

    end Left_Right_Justify;

    procedure Display (The_Buffer : Buffer) is
    begin
        for I in 1 .. The_Buffer.Size loop
            Put_Line (Bounded_String.Image (The_Buffer.Buf (I)));
        end loop;
    end Display;

    procedure Init (Iter : in out Iterator; From_Buffer : Buffer) is
    begin
        Iter         := new Buffer'(From_Buffer);
        Iter.Current := 1;
    end Init;

    function Done (Iter : Iterator) return Boolean is
    begin
        return Iter.Current > Iter.Size;
    end Done;

    function Value (Iter : Iterator) return Line is
    begin
        return Bounded_String.Image (Iter.Buf (Iter.Current));
    end Value;

    procedure Next (Iter : in out Iterator) is
    begin
        Iter.Current := Iter.Current + 1;
    end Next;
end Line_Buffer_Bounded_Width;
DataMuseum.dk

Rational R1000/400

⟦f8e76f3ad⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
