DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦fb1747656⟧ Ada Source

    Length: 15360 (0x3c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Form, seg_0046ed

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

with Window_Io;
with Fonts, Window_Utilities;
with String_Utilities;
package body Form is

    Blank_Line : Unbounded.Variable_String := Unbounded.Value ("");

    function "=" (D1, D2 : Window_Io.Designation) return Boolean
        renames Window_Io."=";

    function Tail (F : Form_Definition) return Form_Definition is
        Temp : Form_Definition := F;
    begin
        if F = null then
            return F;
        end if;

        while Temp.Next_Item /= null loop
            Temp := Temp.Next_Item;
        end loop;

        return Temp;
    end Tail;

    function Find_Definition (For_Item : String; In_Def : Form_Definition)
                             return Form_Definition is

        Temp : Form_Definition := In_Def;
    begin
        if In_Def = null then
            raise Item_Not_Found;
        end if;

        while Temp /= null loop
            if Unbounded.Image (Temp.Name) = For_Item then
                return Temp;
            end if;

            Temp := Temp.Next_Item;
        end loop;

        raise Item_Not_Found;

    end Find_Definition;

    function Make return Form_Definition is
    begin
        return null;
    end Make;

    function Copy (Form : Form_Definition) return Form_Definition is

        Form_Copy : Form_Definition :=
           new Form_Item'(Blank_Line, Blank_Line, Window_Io.Normal,
                          Window_Io.Prompt, null);
        Temp_Copy : Form_Definition := Form_Copy;

        Temp : Form_Definition := Form;
    begin
        while Temp /= null loop
            declare
                Name_String   : Item_String;
                Prompt_String : Item_String;
            begin
                Unbounded.Copy (Name_String, Temp.Name);
                Unbounded.Copy (Prompt_String, Temp.Prompt);
                Temp_Copy.Next_Item :=
                   new Form_Item'(Name_String, Prompt_String,
                                  Temp.Prompt_Font, Temp.Prompt_Kind, null);
            end;

            Temp_Copy := Temp_Copy.Next_Item;
            Temp      := Temp.Next_Item;
        end loop;

        return Form_Copy.Next_Item;
    end Copy;

    procedure Add (Item        : Item_Name;
                   Prompt      : String;
                   Prompt_Font : Window_Io.Font := Fonts.Inverse_Bold;
                   Prompt_Kind : Window_Io.Designation := Window_Io.Prompt;
                   To_Form     : in out Form_Definition) is

        Name_String   : Item_String;
        Prompt_String : Item_String;

        Last : Form_Definition := Tail (To_Form);
    begin
        Unbounded.Copy (Name_String, Item);
        Unbounded.Copy (Prompt_String, Prompt);

        if To_Form = null then
            To_Form := new Form_Item'(Name_String, Prompt_String,
                                      Prompt_Font, Prompt_Kind, null);
        else
            Last.Next_Item := new Form_Item'(Name_String, Prompt_String,
                                             Prompt_Font, Prompt_Kind, null);
        end if;

    end Add;

    procedure Modify_Prompt
                 (For_Item    : Item_Name;
                  New_Prompt  : String := "";
                  Prompt_Font : Window_Io.Font := Fonts.Inverse_Bold;
                  Prompt_Kind : Window_Io.Designation := Window_Io.Prompt;
                  In_Form     : in out Form_Definition) is

        The_Item : Form_Definition := Find_Definition (For_Item, In_Form);
    begin
        if New_Prompt /= "" then
            Unbounded.Copy (The_Item.Prompt, New_Prompt);
        end if;

        The_Item.Prompt_Font := Prompt_Font;
        The_Item.Prompt_Kind := Prompt_Kind;
    end Modify_Prompt;

    procedure Display_Form (Output_Window : Window_Io.File_Type;
                            Form          : Form_Definition;
                            Blank_Lines   : Natural) is       Temp_Form : Form_Definition := Form;

        First_Prompt_Column : Positive;
        First_Prompt_Line   : Positive;
        Found_Prompt        : Boolean := False;

        A_Char : Character;
    begin
        Window_Io.Position_Cursor (Output_Window);

        while Temp_Form /= null loop

            Window_Io.Insert (Output_Window,
                              Unbounded.Image (Temp_Form.Name) & " : ",
                              Kind => Window_Io.Protected);

            if not Found_Prompt and then
               Temp_Form.Prompt_Kind = Window_Io.Prompt then
                Found_Prompt := True;
                Window_Io.Report_Cursor (File   => Output_Window,
                                         Line   => First_Prompt_Line,
                                         Column => First_Prompt_Column);
            end if;

            for I in 1 .. Unbounded.Length (Temp_Form.Prompt) loop
                A_Char := Unbounded.Char_At (Temp_Form.Prompt, I);

                if A_Char = Ascii.Lf then
                    Window_Io.New_Line (Output_Window, 1);
                else
                    Window_Io.Insert (Output_Window, A_Char,
                                      Image => Temp_Form.Prompt_Font,
                                      Kind  => Temp_Form.Prompt_Kind);
                end if;
            end loop;

            Window_Io.New_Line (Output_Window, 1);
            for I in 1 .. Blank_Lines loop
                Window_Io.Insert (File  => Output_Window,
                                  Item  => ' ',
                                  Image => Window_Io.Normal,
                                  Kind  => Window_Io.Text);
                Window_Io.New_Line (Output_Window, 1);
            end loop;
            Temp_Form := Temp_Form.Next_Item;
        end loop;

        if Found_Prompt then
            Window_Io.Position_Cursor (File   => Output_Window,
                                       Line   => First_Prompt_Line,
                                       Column => First_Prompt_Column);
        end if;
    end Display_Form;

    function Begins_With (S : String; In_String : String) return Boolean is
    begin
        return
           In_String (In_String'First .. In_String'First + S'Length - 1) = S;
    exception
        when Constraint_Error =>
            return False;
    end Begins_With;

    function Strip (S : String; From_String : String) return String is
    begin
        return From_String (From_String'First + S'Length .. From_String'Last);
    end Strip;

    function Parse_Form (Input_Window : Window_Io.File_Type;
                         Form         : Form_Definition;
                         Blank_Lines  : Natural) return Modification_Iterator is

        Replies_Form : Form_Definition := Copy (Form);

        Temp_Replies_Form : Form_Definition := Replies_Form;
    begin
        Window_Io.Position_Cursor (Input_Window);

        if Begins_With (Unbounded.Image (Temp_Replies_Form.Name) & " : ",
                        Window_Io.Line_Image (Input_Window)) then

            Unbounded.Copy
               (Temp_Replies_Form.Prompt,
                Strip (Unbounded.Image (Temp_Replies_Form.Name) & " : ",
                       Window_Io.Line_Image (Input_Window)));
        else
            raise Unable_To_Parse_Response;
        end if;

        for L in 2 .. Window_Io.Last_Line (Input_Window) loop
            Window_Utilities.Next_Line (Input_Window);

            if String_Utilities.Strip (Window_Io.Line_Image (Input_Window)) =
               "" then
                null;  -- walk over blank lines
            elsif Temp_Replies_Form.Next_Item /= null and then
                  Begins_With
                     (Unbounded.Image (Temp_Replies_Form.Next_Item.Name) &
                      " : ", Window_Io.Line_Image (Input_Window)) then

                Temp_Replies_Form := Temp_Replies_Form.Next_Item;

                Unbounded.Copy (Temp_Replies_Form.Prompt,
                                Strip (Unbounded.Image
                                          (Temp_Replies_Form.Name) & " : ",
                                       Window_Io.Line_Image (Input_Window)));
            else
                Unbounded.Append (Temp_Replies_Form.Prompt, Ascii.Lf);
                Unbounded.Append (Temp_Replies_Form.Prompt,
                                  Window_Io.Line_Image (Input_Window));
            end if;
        end loop;

        if Temp_Replies_Form.Next_Item /= null then
            raise Unable_To_Parse_Response;
        end if;

        return Modification_Iterator (Replies_Form);
    end Parse_Form;

    procedure Create (Form_Output           :     Window_Io.File_Type;
                      Form_Input            :     Window_Io.File_Type;
                      Definition            :     Form_Definition;
                      The_Form              : out Modification_Iterator;
                      Blank_Lines           :     Natural := 0;
                      Wait_For_User_Editing :     Boolean := False) is

        Out_Char : Character;
    begin
        Window_Utilities.Erase (Form_Output);
        Display_Form (Form_Output, Definition, Blank_Lines);

        if Wait_For_User_Editing then

            Window_Io.Get (Form_Input, "", Out_Char);

            The_Form := Parse_Form (Form_Input, Definition, Blank_Lines);
        else

            The_Form := null;
        end if;

    exception

        when Unable_To_Parse_Response =>
            raise;
    end Create;

    function Convert (Mods_Iter : Modification_Iterator)
                     return Form_Definition is
    begin
        return Copy (Form_Definition (Mods_Iter));
    end Convert;

    procedure Next (Iter : in out Modification_Iterator) is
    begin
        if Iter /= null then
            Iter := Modification_Iterator (Iter.Next_Item);
        end if;

    end Next;

    function Done (Iter : Modification_Iterator) return Boolean is
    begin
        return Iter = null;
    end Done;

    function Value (Iter : Modification_Iterator)
                   return Modification_Information is
    begin
        return Modification_Information (Iter.all);
    end Value;

    function Item_Image (Mod_Info : Modification_Information) return String is
    begin
        return Unbounded.Image (Mod_Info.Name);
    end Item_Image;

    function Response (Mod_Info : Modification_Information) return String is
    begin
        return Unbounded.Image (Mod_Info.Prompt);
    end Response;

    function Empty (Mod_Info : Modification_Information) return Boolean is
    begin
        return
           String_Utilities.Equal
              (String_Utilities.Strip (Unbounded.Image (Mod_Info.Prompt)), "");
    end Empty;

end Form;

    nblk1=e
    nid=0
    hdr6=1c
        [0x00] rec0=25 rec1=00 rec2=01 rec3=02c
        [0x01] rec0=21 rec1=00 rec2=02 rec3=01a
        [0x02] rec0=00 rec1=00 rec2=0e rec3=004
        [0x03] rec0=1c rec1=00 rec2=03 rec3=02c
        [0x04] rec0=00 rec1=00 rec2=0d rec3=00e
        [0x05] rec0=1a rec1=00 rec2=04 rec3=002
        [0x06] rec0=19 rec1=00 rec2=05 rec3=064
        [0x07] rec0=00 rec1=00 rec2=0c rec3=012
        [0x08] rec0=18 rec1=00 rec2=06 rec3=042
        [0x09] rec0=1b rec1=00 rec2=07 rec3=052
        [0x0a] rec0=18 rec1=00 rec2=08 rec3=042
        [0x0b] rec0=17 rec1=00 rec2=09 rec3=01e
        [0x0c] rec0=22 rec1=00 rec2=0a rec3=008
        [0x0d] rec0=22 rec1=00 rec2=0b rec3=000
    tail 0x215004dc0815c675e38a2 0x42a00088462061e03