DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - metrics - download
Index: B T

⟦f0faab2d9⟧ TextFile

    Length: 18736 (0x4930)
    Types: TextFile
    Names: »B«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─⟦129cab021⟧ »DATA« 
        └─⟦this⟧

TextFile

with Arguments;
with Bounded_String;
with Easy_X;
with Elementary_Functions;
with Message;
with Msg_Report;
with Object;
with Scanner;
with String_Class;
with String_Utilities;

package body Turtle_Class is

    function Is_Equal_String
                (Str1 : String; Str2 : String; Ignore_Case : Boolean := True)
                return Boolean renames String_Utilities.Equal;

    function Bs_Image (Source : Scanner.B_String) return String
        renames Bounded_String.Image;

    procedure Bs_Copy (Target : in out Scanner.B_String; Source : String)
        renames Bounded_String.Copy;


    Max_Turtle : constant Integer := 100;

    Turtle_Table : array (1 .. Max_Turtle) of Turtle_Ref;


    -- initialisation de la table d'instance des tortues
    -- =================================================

    procedure Init_Instance_Table is
    begin  
        for Ref in Turtle_Table'Range loop
            if Turtle_Table (Ref).Indicator = Used then
                Turtle_Table (Ref).Status := Up;
                Turtle_Table (Ref).Size := Fine;
                Turtle_Table (Ref).X := 0;
                Turtle_Table (Ref).Y := 0;
                Turtle_Table (Ref).Angle := 0;
            end if;
        end loop;

    end Init_Instance_Table;


    -- creation d'un objet tortue
    -- ==========================

    function Create return Object.Reference is

        use Object;

        Found : Boolean := False;
        Value : Integer;

    begin  
        for Ref in Turtle_Table'Range loop
            if Turtle_Table (Ref).Indicator = Unused then
                Found := True;
                Turtle_Table (Ref).Indicator := Used;
                Value := Ref;
                exit;
            end if;
        end loop;  
        if Found then
            return Object.Create (C_Turtle, Value);
        else
            Msg_Report.Interpret_Error
               ("Turtle instance table full, creation of a new object impossible");
            raise Instance_Table_Full;
        end if;

    end Create;


    function Unary_Msg_X (The_Object : Object.Reference)
                         return Object.Reference is
        use Object;
        Ref : Integer;

    begin
        Ref := Object.Identificator (The_Object);
        return Object.Create (C_Integer, Integer (Turtle_Table (Ref).X));

    end Unary_Msg_X;


    function Unary_Msg_Y (The_Object : Object.Reference)
                         return Object.Reference is
        use Object;
        Ref : Integer;

    begin
        Ref := Object.Identificator (The_Object);
        return Object.Create (C_Integer, Integer (Turtle_Table (Ref).Y));

    end Unary_Msg_Y;


    function Unary_Msg_Size (The_Object : Object.Reference)
                            return Object.Reference is
        use Object;
        Ref, Value : Integer;

    begin
        Ref := Object.Identificator (The_Object);
        case Turtle_Table (Ref).Size is
            when Fine =>
                Value := 1;
            when Medium =>
                Value := 2;
            when Large =>
                Value := 3;
        end case;
        return Object.Create (C_Integer, Value);

    end Unary_Msg_Size;


    function Unary_Msg_Angle (The_Object : Object.Reference)
                             return Object.Reference is
        use Object;
        Ref : Integer;

    begin
        Ref := Object.Identificator (The_Object);
        return Object.Create (C_Integer, Integer (Turtle_Table (Ref).Angle));

    end Unary_Msg_Angle;


    function Unary_Msg_Go_Home
                (The_Object : Object.Reference) return Object.Reference is

        Ref : Integer;

    begin
        Ref := Object.Identificator (The_Object);
        Turtle_Table (Ref).X := 0;
        Turtle_Table (Ref).Y := 0;
        Easy_X.Move_To (0, 0);
        return Object.Void_Reference;

    end Unary_Msg_Go_Home;


    function Unary_Msg_Copy (The_Object : Object.Reference)
                            return Object.Reference is

        Ref, New_Ref : Integer;
        New_Object : Object.Reference;

    begin
        Ref := Object.Identificator (The_Object);
        New_Object := Create;
        New_Ref := Object.Identificator (New_Object);
        Turtle_Table (New_Ref) := Turtle_Table (Ref);
        return New_Object;

    end Unary_Msg_Copy;


    function Unary_Msg_Status (The_Object : Object.Reference)
                              return Object.Reference is
        Ref : Integer;
        State_Value : Scanner.B_String;

    begin
        Ref := Object.Identificator (The_Object);

        case Turtle_Table (Ref).Status is
            when Up =>
                Bs_Copy (State_Value, "PlumeLevee");
            when Down =>
                Bs_Copy (State_Value, "PlumeBaissee");
        end case;
        return String_Class.Create (Bs_Image (State_Value));

    end Unary_Msg_Status;


    function Unary_Msg_Up (The_Object : Object.Reference)
                          return Object.Reference is
        Ref : Integer;

    begin
        Ref := Object.Identificator (The_Object);
        Turtle_Table (Ref).Status := Up;
        return Object.Void_Reference;

    end Unary_Msg_Up;


    function Unary_Msg_Down (The_Object : Object.Reference)
                            return Object.Reference is
        Ref : Integer;

    begin
        Ref := Object.Identificator (The_Object);
        Turtle_Table (Ref).Status := Down;
        return Object.Void_Reference;

    end Unary_Msg_Down;


    function Keyword_Msg_X (The_Object : Object.Reference; Arg_Value : Integer)
                           return Object.Reference is
        Ref : Integer;

    begin
        Ref := Object.Identificator (The_Object);
        Turtle_Table (Ref).X := Easy_X.Coordinate (Arg_Value);
        Easy_X.Move_To (Turtle_Table (Ref).X, Turtle_Table (Ref).Y);
        return Object.Void_Reference;

    end Keyword_Msg_X;


    function Keyword_Msg_Y (The_Object : Object.Reference; Arg_Value : Integer)
                           return Object.Reference is
        Ref : Integer;

    begin
        Ref := Object.Identificator (The_Object);
        Turtle_Table (Ref).Y := Easy_X.Coordinate (Arg_Value);
        Easy_X.Move_To (Turtle_Table (Ref).X, Turtle_Table (Ref).Y);
        return Object.Void_Reference;

    end Keyword_Msg_Y;


    function Keyword_Msg_Size
                (The_Object : Object.Reference; Arg_Value : Integer)
                return Object.Reference is

        Ref : Integer;

    begin
        Ref := Object.Identificator (The_Object);
        case Arg_Value is
            when 1 =>
                Turtle_Table (Ref).Size := Fine;

            when 2 =>
                Turtle_Table (Ref).Size := Medium;

            when 3 =>
                Turtle_Table (Ref).Size := Large;

            when others =>
                null;
        end case;
        Easy_X.Set_Pen (Easy_X.Dimension (Arg_Value));
        return Object.Void_Reference;

    end Keyword_Msg_Size;


    function Keyword_Msg_Angle
                (The_Object : Object.Reference; Arg_Value : Integer)
                return Object.Reference is

        Ref : Integer;

    begin
        Ref := Object.Identificator (The_Object);
        Turtle_Table (Ref).Angle := Arg_Value mod 360;
        return Object.Void_Reference;

    end Keyword_Msg_Angle;


    function Keyword_Msg_Go_Ahead
                (The_Object : Object.Reference; Arg_Value : Integer)
                return Object.Reference is

        Pi : constant Float := 3.141592654;

        Ref : Integer;
        Depl_X, Depl_Y : Float;
        New_X, New_Y : Easy_X.Coordinate;

    begin
        Ref := Object.Identificator (The_Object);
        Depl_X := Float (Arg_Value) *
                     Elementary_Functions.Cos
                        (Float (Turtle_Table (Ref).Angle) * Pi / 180.0);
        Depl_Y := Float (Arg_Value) *
                     Elementary_Functions.Sin
                        (Float (Turtle_Table (Ref).Angle) * Pi / 180.0);

        New_X := Easy_X.Coordinate (Float (Turtle_Table (Ref).X) + Depl_X);
        New_Y := Easy_X.Coordinate (Float (Turtle_Table (Ref).Y) - Depl_Y);

        Turtle_Table (Ref).X := New_X;
        Turtle_Table (Ref).Y := New_Y;

        case Turtle_Table (Ref).Status is
            when Up =>
                Easy_X.Move_To (New_X, New_Y);

            when Down =>
                Easy_X.Line_To (New_X, New_Y);
        end case;

        return Object.Void_Reference;

    end Keyword_Msg_Go_Ahead;


    function Keyword_Msg_Right
                (The_Object : Object.Reference; Arg_Value : Integer)
                return Object.Reference is

        Ref : Integer;

    begin
        Ref := Object.Identificator (The_Object);
        Turtle_Table (Ref).Angle :=
           (Turtle_Table (Ref).Angle - Arg_Value) mod 360;
        return Object.Void_Reference;

    end Keyword_Msg_Right;


    function Keyword_Msg_Left
                (The_Object : Object.Reference; Arg_Value : Integer)
                return Object.Reference is

        Ref : Integer;

    begin
        Ref := Object.Identificator (The_Object);
        Turtle_Table (Ref).Angle :=
           (Turtle_Table (Ref).Angle + Arg_Value) mod 360;
        return Object.Void_Reference;

    end Keyword_Msg_Left;


    function Keyword_Msg_Goto_X_Y (The_Object : Object.Reference;
                                   First_Arg_Value, Second_Arg_Value : Integer)
                                  return Object.Reference is
        Ref : Integer;
        New_X, New_Y : Easy_X.Coordinate;

    begin
        Ref := Object.Identificator (The_Object);
        New_X := Easy_X.Coordinate (First_Arg_Value);
        New_Y := Easy_X.Coordinate (Second_Arg_Value);

        Turtle_Table (Ref).X := New_X;
        Turtle_Table (Ref).Y := New_Y;

        case Turtle_Table (Ref).Status is
            when Up =>
                Easy_X.Move_To (New_X, New_Y);
            when Down =>
                Easy_X.Line_To (New_X, New_Y);
        end case;
        return Object.Void_Reference;

    end Keyword_Msg_Goto_X_Y;


    -- envoi d'un message a un objet tortue
    -- ====================================

    function Send (To_Object : Object.Reference;
                   The_Message : Message.Selector;
                   With_Arguments : Arguments.List := Arguments.Void_Arguments)
                  return Object.Reference is

        Nb_Argument : Natural;

        Msg_List, Msg : Message.Selector := Message.Void_Selector;

        Arg_Object, Result : Object.Reference;
        Arg_Value, Second_Arg_Value : Integer;
        Arg_List : Arguments.List;

    begin
        Nb_Argument := Arguments.How_Many (With_Arguments);

        if Nb_Argument = 0 then

            -- reception d'un message unaire

            if Is_Equal_String (Message.Image (The_Message), "TonX") then

                Msg_Report.Information ("Turtle object: unary message -> TonX");
                Result := Unary_Msg_X (To_Object);

            elsif Is_Equal_String (Message.Image (The_Message), "TonY") then

                Msg_Report.Information ("Turtle object: unary message -> TonY");
                Result := Unary_Msg_Y (To_Object);

            elsif Is_Equal_String (Message.Image (The_Message), "TaTaille") then

                Msg_Report.Information
                   ("Turtle object: unary message -> TaTaille");
                Result := Unary_Msg_Size (To_Object);

            elsif Is_Equal_String (Message.Image (The_Message), "TonAngle") then

                Msg_Report.Information
                   ("Turtle object: unary message -> TonAngle");
                Result := Unary_Msg_Angle (To_Object);

            elsif Is_Equal_String
                     (Message.Image (The_Message), "RentreChezToi") then

                Msg_Report.Information
                   ("Turtle object: unary message -> RentreChezToi");
                Result := Unary_Msg_Go_Home (To_Object);

            elsif Is_Equal_String (Message.Image (The_Message), "CopieToi") then

                Msg_Report.Information
                   ("Turtle object: unary message -> CopieToi");
                Result := Unary_Msg_Copy (To_Object);

            elsif Is_Equal_String
                     (Message.Image (The_Message), "EtatPlume") then

                Msg_Report.Information
                   ("Turtle object: unary message -> EtatPlume");
                Result := Unary_Msg_Status (To_Object);

            elsif Is_Equal_String
                     (Message.Image (The_Message), "LeveTaPlume") then

                Msg_Report.Information
                   ("Turtle object: unary message -> LeveTaPlume");
                Result := Unary_Msg_Up (To_Object);

            elsif Is_Equal_String
                     (Message.Image (The_Message), "BaisseTaPlume") then

                Msg_Report.Information
                   ("Turtle object: unary message -> BaisseTaPlume");
                Result := Unary_Msg_Down (To_Object);

            else

                Msg_Report.Interpret_Error
                   ("Incorrect unary method " &
                    Message.Image (The_Message) & " for Turtle object");

                raise Incorrect_Method;
            end if;

        elsif Message.Is_Keyword (The_Message) then

            -- reception d'un message a mots cles

            Message.Cat (Msg_List, The_Message);

            Arg_List := With_Arguments;
            Arguments.First (Arg_List);

            while (Nb_Argument /= 0) loop

                Arguments.Read (Arg_List, Arg_Object);
                Arg_Value := Object.Identificator (Arg_Object);
                Nb_Argument := Nb_Argument - 1;

                Message.Extract_Keyword (Msg_List, Msg);

                if Is_Equal_String (Message.Image (Msg), "TonX") then

                    Msg_Report.Information
                       ("Turtle object: keyword message -> TonX:");
                    Result := Keyword_Msg_X (To_Object, Arg_Value);

                elsif Is_Equal_String (Message.Image (Msg), "TonY") then

                    Msg_Report.Information
                       ("Turtle object: keyword message -> TonY:");
                    Result := Keyword_Msg_Y (To_Object, Arg_Value);

                elsif Is_Equal_String (Message.Image (Msg), "TaTaille") then

                    Msg_Report.Information
                       ("Turtle object: keyword message -> TaTaille:");
                    Result := Keyword_Msg_Size (To_Object, Arg_Value);

                elsif Is_Equal_String (Message.Image (Msg), "TonAngle") then

                    Msg_Report.Information
                       ("Turtle object: keyword message -> TonAngle:");
                    Result := Keyword_Msg_Angle (To_Object, Arg_Value);

                elsif Is_Equal_String (Message.Image (Msg), "Avance") then

                    Msg_Report.Information
                       ("Turtle object: keyword message -> Avance:");
                    Result := Keyword_Msg_Go_Ahead (To_Object, Arg_Value);

                elsif Is_Equal_String (Message.Image (Msg), "ADroite") then

                    Msg_Report.Information
                       ("Turtle object: keyword message -> ADroite:");
                    Result := Keyword_Msg_Right (To_Object, Arg_Value);

                elsif Is_Equal_String (Message.Image (Msg), "AGauche") then

                    Msg_Report.Information
                       ("Turtle object: keyword message -> AGauche:");
                    Result := Keyword_Msg_Left (To_Object, Arg_Value);

                elsif Is_Equal_String (Message.Image (Msg), "VaEnX") then

                    Msg_Report.Information
                       ("Turtle object: keyword message -> VaEnX:");

                    -- recherche de la 2eme partie du message
                    if (Nb_Argument /= 0) then

                        Message.Extract_Keyword (Msg_List, Msg);

                        if (Message.Image (Msg) = "y" or
                            Message.Image (Msg) = "Y") then
                            Arguments.Read (Arg_List, Arg_Object);
                            Second_Arg_Value :=
                               Object.Identificator (Arg_Object);
                            Nb_Argument := Nb_Argument - 1;
                            Msg_Report.Information
                               ("Turtle object: keyword message -> Y:");
                            Result := Keyword_Msg_Goto_X_Y
                                         (To_Object, Arg_Value,
                                          Second_Arg_Value);
                        else
                            -- 2eme partie du message incorrecte
                            Msg_Report.Interpret_Error
                               ("Incorrect keyword method VaEnX " &
                                Message.Image (Msg) & " for Turtle object");

                            raise Incorrect_Method;
                        end if;

                    else
                        -- 2eme partie du message manquante
                        Msg_Report.Interpret_Error
                           ("Incorrect keyword method VaEnX" &
                            " for Turtle object");

                        raise Incorrect_Method;

                    end if;

                else
                    -- message inexistant
                    Msg_Report.Interpret_Error
                       ("Incorrect keyword method " &
                        Message.Image (Msg) & " for Turtle object");

                    raise Incorrect_Method;
                end if;

            end loop;

        else

            -- erreur sur reception d'un message binaire

            Msg_Report.Interpret_Error
               ("No binary method allowed " &
                Message.Image (The_Message) & " for Turtle object");

            raise Incorrect_Method;
        end if;

        return Result;

    end Send;


    -- affichage du contenu de la table d'instance des tortues
    -- =======================================================

    procedure Image_Table is

        Turtle : Turtle_Ref;

    begin  
        Msg_Report.Information ("Turtle Table contents");
        for Ref in Turtle_Table'Range loop  
            Turtle := Turtle_Table (Ref);
            Msg_Report.Continue
               (Enum_Indicator'Image (Turtle.Indicator) &
                ", Status: " & Enum_Status'Image (Turtle.Status) &
                ", Size: " & Enum_Size'Image (Turtle.Size) &
                ", X: " & Easy_X.Coordinate'Image (Turtle.X) &
                ", Y: " & Easy_X.Coordinate'Image (Turtle.Y) &
                ", Angle: " & Integer'Image (Turtle.Angle));
        end loop;

    end Image_Table;

end Turtle_Class;