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 - download
Index: ┃ B T

⟦3e69e97b3⟧ TextFile

    Length: 16487 (0x4067)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Bounded_String;
with Errors;
with Integer_Class;
with String_Class;

package body Pen_Class is

    type Unary_Message is (Nul, En_Texte, Ton_X, Ton_Y, Ta_Taille, Fin, Moyen,
                           Epais, Rentre_Chez_Toi, Va_Au_Centre, Duplique_Toi);
    type Keyword_Message is (Nul, Ton_X, Ton_Y, Va_En_X_Y, Ecris, Ton_X_Ton_Y,
                             En_Haut, En_Bas, A_Gauche, A_Droite);
    Iterator : Natural := 0;

    function Convert_To_Unary
                (The_Message : Scanner.Lexeme) return Unary_Message is
    begin
        if Bounded_String.Image (The_Message) = "TON_X" then
            return Ton_X;
        elsif Bounded_String.Image (The_Message) = "TON_Y" then
            return Ton_Y;
        elsif Bounded_String.Image (The_Message) = "EN_TEXTE" then
            return En_Texte;
        elsif Bounded_String.Image (The_Message) = "FIN" then
            return Fin;
        elsif Bounded_String.Image (The_Message) = "MOYEN" then
            return Moyen;
        elsif Bounded_String.Image (The_Message) = "EPAIS" then
            return Epais;
        elsif Bounded_String.Image (The_Message) = "TA_TAILLE" then
            return Ta_Taille;
        elsif Bounded_String.Image (The_Message) = "RENTRE_CHEZ_TOI" then
            return Rentre_Chez_Toi;
        elsif Bounded_String.Image (The_Message) = "VA_AU_CENTRE" then
            return Va_Au_Centre;
        elsif Bounded_String.Image (The_Message) = "DUPLIQUE_TOI" then
            return Duplique_Toi;
        else
            return Nul;
        end if;
    end Convert_To_Unary;

    procedure Convert_To_List (The_Message : in out Message.Selector;
                               Back : out Keyword_Message) is
    begin
        Back := Nul;
        case Message.Arg_Number (The_Message) is
            when 1 =>
                Message.Init (The_Message);
                if Bounded_String.Image (Message.Value (The_Message)) =
                   "TON_X:" then
                    Back := Ton_X;
                elsif Bounded_String.Image (Message.Value (The_Message)) =
                      "TON_Y:" then
                    Back := Ton_Y;
                elsif Bounded_String.Image (Message.Value (The_Message)) =
                      "ECRIS:" then
                    Back := Ecris;
                elsif Bounded_String.Image (Message.Value (The_Message)) =
                      "EN_HAUT:" then
                    Back := En_Haut;
                elsif Bounded_String.Image (Message.Value (The_Message)) =
                      "EN_BAS:" then
                    Back := En_Bas;
                elsif Bounded_String.Image (Message.Value (The_Message)) =
                      "A_GAUCHE:" then
                    Back := A_Gauche;
                elsif Bounded_String.Image (Message.Value (The_Message)) =
                      "A_DROITE:" then
                    Back := A_Droite;
                end if;
            when 2 =>
                Message.Init (The_Message);
                if Bounded_String.Image (Message.Value (The_Message)) =
                   "VA_EN_X:" then
                    Message.Next (The_Message);
                    if Bounded_String.Image (Message.Value (The_Message)) =
                       "Y:" then
                        Back := Va_En_X_Y;
                    end if;
                elsif Bounded_String.Image (Message.Value (The_Message)) =
                      "TON_X:" then
                    Message.Next (The_Message);
                    if Bounded_String.Image (Message.Value (The_Message)) =
                       "TON_Y:" then
                        Back := Ton_X_Ton_Y;
                    end if;
                end if;
            when others =>
                null;
        end case;
    end Convert_To_List;

    function Create return Object.Reference is
    begin
        Iterator := Iterator + 1;
        if Iterator <= Custom.Pen_Max_Number then
            return Object.Create (Object.Stylo, Iterator);
        else
            raise Errors.Max_Pen_Number_Exceeded;
        end if;
    end Create;

    function Send (To_Object : Object.Reference; The_Message : Scanner.Lexeme)
                  return Object.Reference is
        Current_Message : Unary_Message := Nul;
        Index : Integer := Object.Get_Id (To_Object);
        Current_Entexte : Scanner.Lexeme;
        New_Pen : Object.Reference;
    begin
        Current_Message := Convert_To_Unary (The_Message);
        case Current_Message is
            when Nul =>
                raise Errors.Unknown_Message_For_Pen;
            when Ton_X =>
                return Integer_Class.Create (Pen_Table
                                                (Object.Get_Id (To_Object)).X);
            when Ton_Y =>
                return Integer_Class.Create (Pen_Table
                                                (Object.Get_Id (To_Object)).Y);
            when Fin =>
                Pen_Table (Index).Width := Easy_X.Small_Font;  
                return Object.Void_Reference;
            when Moyen =>
                Pen_Table (Index).Width := Easy_X.Medium_Font;
                return Object.Void_Reference;
            when Epais =>
                Pen_Table (Index).Width := Easy_X.Large_Font;
                return Object.Void_Reference;
            when Ta_Taille =>
                case Pen_Table (Object.Get_Id (To_Object)).Width is
                    when Easy_X.Small_Font =>
                        return String_Class.Create ("Fin");  
                    when Easy_X.Medium_Font =>
                        return String_Class.Create ("Moyen");
                    when Easy_X.Large_Font =>
                        return String_Class.Create ("Epais");
                end case;
            when Rentre_Chez_Toi =>
                Pen_Table (Object.Get_Id (To_Object)).X := 0;
                Pen_Table (Object.Get_Id (To_Object)).Y := 0;
                Easy_X.Move_To (Easy_X.Coordinate (Pen_Table (Index).X),
                                Easy_X.Coordinate (Pen_Table (Index).Y));
                return Object.Void_Reference;
            when Va_Au_Centre =>
                Pen_Table (Object.Get_Id (To_Object)).X :=
                   Natural (Custom.Width) / 2;
                Pen_Table (Object.Get_Id (To_Object)).Y :=
                   Natural (Custom.Height) / 2;
                Easy_X.Move_To (Easy_X.Coordinate (Pen_Table (Index).X),
                                Easy_X.Coordinate (Pen_Table (Index).Y));
                return Object.Void_Reference;
            when Duplique_Toi =>
                New_Pen := Create;
                Pen_Table (Object.Get_Id (New_Pen)).X :=
                   Pen_Table (Object.Get_Id (To_Object)).X;
                Pen_Table (Object.Get_Id (New_Pen)).Y :=
                   Pen_Table (Object.Get_Id (To_Object)).Y;
                Pen_Table (Object.Get_Id (New_Pen)).Width :=
                   Pen_Table (Object.Get_Id (To_Object)).Width;
                return New_Pen;
            when En_Texte =>
                Bounded_String.Append
                   (Current_Entexte, Bounded_String.Value
                                        ("Stylo no", Custom.String_Max_Length));
                Bounded_String.Append
                   (Current_Entexte, Integer'Image (Object.Get_Id (To_Object)));

                Bounded_String.Append
                   (Current_Entexte, Bounded_String.Value
                                        (". X:", Custom.String_Max_Length));
                Bounded_String.Append
                   (Current_Entexte,
                    Integer'Image (Pen_Table (Object.Get_Id (To_Object)).X));
                Bounded_String.Append
                   (Current_Entexte, Bounded_String.Value
                                        (". Y:", Custom.String_Max_Length));
                Bounded_String.Append
                   (Current_Entexte,
                    Integer'Image (Pen_Table (Object.Get_Id (To_Object)).Y));

                Bounded_String.Append
                   (Current_Entexte, Bounded_String.Value
                                        (". Font: ", Custom.String_Max_Length));
                case Pen_Table (Object.Get_Id (To_Object)).Width is
                    when Easy_X.Small_Font =>
                        Bounded_String.Append
                           (Current_Entexte,
                            Bounded_String.Value
                               ("Fin", Custom.String_Max_Length));
                    when Easy_X.Medium_Font =>
                        Bounded_String.Append
                           (Current_Entexte,
                            Bounded_String.Value
                               ("Moyen", Custom.String_Max_Length));
                    when Easy_X.Large_Font =>
                        Bounded_String.Append
                           (Current_Entexte,
                            Bounded_String.Value
                               ("Epais", Custom.String_Max_Length));
                end case;
                return String_Class.Create (Current_Entexte);  
        end case;
    end Send;

    procedure Send (To_Object : Object.Reference;
                    The_Message : in out Message.Selector;
                    With_Arguments : in out Parameters.List;
                    Back_Object : out Object.Reference) is
        Current_Message : Keyword_Message;
        Index : Integer := Object.Get_Id (To_Object);
        Current_Number : Integer;
        Current_Object : Object.Reference;
        use Object; -- erreur sur egalite entre classes d'objets si absent
    begin
        Message.Init (The_Message);
        Parameters.Init (With_Arguments);
        while not Message.Done (The_Message) loop
            Current_Object := Parameters.Value (With_Arguments);
            case Object.Get_Class (Current_Object) is
                when Object.Entier =>
                    Convert_To_List (The_Message, Current_Message);
                    case Current_Message is
                        when Nul =>
                            raise Errors.Unknown_Message_For_Pen;
                        when Ton_X =>
                            Pen_Table (Index).X :=
                               Object.Get_Id (Current_Object);
                        when Ton_Y =>
                            Pen_Table (Index).Y :=
                               Object.Get_Id (Current_Object);
                        when En_Haut =>
                            Current_Number := Pen_Table (Index).Y -
                                                 Object.Get_Id (Current_Object);
                            if Current_Number < 0 then
                                Current_Number := 0;
                            end if;
                            Pen_Table (Index).Y := Natural (Current_Number);
                            Easy_X.Move_To (Easy_X.Coordinate
                                               (Pen_Table (Index).X),
                                            Easy_X.Coordinate
                                               (Pen_Table (Index).Y));
                        when En_Bas =>
                            Current_Number := Pen_Table (Index).Y +
                                                 Object.Get_Id (Current_Object);
                            if Current_Number > Integer (Custom.Height) then  
                                Current_Number := Integer (Custom.Height);
                            end if;
                            Pen_Table (Index).Y := Natural (Current_Number);
                            Easy_X.Move_To (Easy_X.Coordinate
                                               (Pen_Table (Index).X),
                                            Easy_X.Coordinate
                                               (Pen_Table (Index).Y));
                        when A_Gauche =>
                            Current_Number := Pen_Table (Index).X -
                                                 Object.Get_Id (Current_Object);
                            if Current_Number < 0 then
                                Current_Number := 0;
                            end if;
                            Pen_Table (Index).X := Natural (Current_Number);
                            Easy_X.Move_To (Easy_X.Coordinate
                                               (Pen_Table (Index).X),
                                            Easy_X.Coordinate
                                               (Pen_Table (Index).Y));
                        when A_Droite =>
                            Current_Number := Pen_Table (Index).X +
                                                 Object.Get_Id (Current_Object);
                            if Current_Number > Integer (Custom.Width) then
                                Current_Number := Integer (Custom.Width);
                            end if;
                            Pen_Table (Index).X := Natural (Current_Number);
                            Easy_X.Move_To (Easy_X.Coordinate
                                               (Pen_Table (Index).X),
                                            Easy_X.Coordinate
                                               (Pen_Table (Index).Y));
                        when Va_En_X_Y =>
                            Pen_Table (Index).X :=
                               Object.Get_Id (Current_Object);
                            Parameters.Next (With_Arguments);
                            if Object.Get_Class
                                  (Parameters.Value (With_Arguments)) =
                               Object.Entier then
                                Pen_Table (Index).Y :=
                                   Object.Get_Id (Parameters.Value
                                                     (With_Arguments));
                                Easy_X.Move_To (Easy_X.Coordinate
                                                   (Pen_Table (Index).X),
                                                Easy_X.Coordinate
                                                   (Pen_Table (Index).Y));
                            else
                                raise Errors.
                                         Integer_Required_As_Argument_For_Pen;
                            end if;
                        when Ton_X_Ton_Y =>
                            Pen_Table (Index).X :=
                               Object.Get_Id (Current_Object);
                            Parameters.Next (With_Arguments);
                            if Object.Get_Class
                                  (Parameters.Value (With_Arguments)) =
                               Object.Entier then
                                Pen_Table (Index).Y :=
                                   Object.Get_Id (Parameters.Value
                                                     (With_Arguments));
                            else
                                raise Errors.
                                         Integer_Required_As_Argument_For_Pen;
                            end if;
                        when Ecris =>
                            raise Errors.String_Required_As_Argument_For_Pen;
                    end case;
                when Object.Chaine =>
                    Convert_To_List (The_Message, Current_Message);
                    case Current_Message is
                        when Ecris =>
                            Easy_X.Move_To (Easy_X.Coordinate
                                               (Pen_Table (Index).X),
                                            Easy_X.Coordinate
                                               (Pen_Table (Index).Y));
                            Easy_X.Set_Font (Pen_Table (Index).Width);
                            Easy_X.Draw_String (Bounded_String.Image
                                                   (String_Class.Get_Value
                                                       (Current_Object)));
                        when others =>
                            raise Errors.String_Required_As_Argument_For_Pen;
                    end case;
                when others =>
                    raise Errors.Integer_Required_As_Argument_For_Pen;
            end case;
            Message.Next (The_Message);
            Parameters.Next (With_Arguments);
        end loop;
        Back_Object := Object.Void_Reference;
    end Send;

    function Get_For_Error return Object.Reference is
    begin
        return Object.Create (Object.Stylo, 1);
    end Get_For_Error;

end Pen_Class;