DataMuseum.dk

top - download

    Length: 6848 (0x1ac0)
    Types: TextFile
    Names: »B«

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

TextFile

with Text_Io, Bounded_String, Scanner, Tiny_X, Easy_X, Scanner, Message;
package body Tiny_Error is

    package Bs renames Bounded_String;
    procedure Write (Error : String) is
        use Easy_X;
        P : Natural;
        Error_Message : Message.Tiny_String;
    begin
        Tiny_X.Close;
        Tiny_X.Open ("Une erreur est apparue", 200, 400, 900, 200);
        Bs.Copy (Error_Message,
                 "Ligne " & Natural'Image (Scanner.Get_Line_Number) &
                    ": " & Error);
        loop
            case Easy_X.Next_Event is
                when Easy_X.Update =>
                    Easy_X.Set_Font (Easy_X.Medium_Font);
                    Easy_X.Move_To
                       (Easy_X.Coordinate
                           ((900 - 10 * Bs.Image (Error_Message)'Length) / 2),
                        100);
                    Easy_X.Draw_String (Bs.Image (Error_Message));
                    Easy_X.Set_Font (Easy_X.Small_Font);
                    Easy_X.Move_To (300, 170);
                    Easy_X.Draw_String ("Cliquer dans la fenetre pour sortir");
                when Easy_X.Button_Down =>
                    exit;
                when others =>
                    null;
            end case;
        end loop;  
        P := (900 - 10 * Bs.Image (Error_Message)'Length) / 2;
        Easy_X.Set_Font (Easy_X.Medium_Font);
        for I in 0 .. Integer ((Bs.Image (Error_Message)'Length * 5) / 4) loop
            Easy_X.Move_To (Easy_X.Coordinate (P + I * 5), 100);
            Easy_X.Draw_String (" ");
            Easy_X.Move_To (Easy_X.Coordinate (900 - (P + I * 5)), 100);
            Easy_X.Draw_String (" ");  
        end loop;
        Tiny_X.Close;
    end Write;

    procedure String_Class_Full is
    begin
        Write ("La table des chaines est pleine !!!");
    end String_Class_Full;

    procedure String_Large_Overflow is
    begin
        Write ("La chaine de caractere est trop grande!!!");
    end String_Large_Overflow;

    procedure Search_No_String_Object is
    begin
        Write
           ("Recherche d'un chaine a partir d'un objet n'etant pas de la classe des chaines");
    end Search_No_String_Object;

    procedure Missing_Point is
    begin
        Write ("Il manque un point");
    end Missing_Point;

    procedure Missing_Reserved_Word is
    begin
        Write ("Il manque un mot reserve");
    end Missing_Reserved_Word;

    procedure Missing_Right_Parentheses is
    begin
        Write ("Il manque une parenthese fermante");
    end Missing_Right_Parentheses;

    procedure Missing_Right_Brace is
    begin
        Write ("Il manque une accolade fermante");
    end Missing_Right_Brace;

    procedure Mismatch_Arguments_List is
    begin
        Write ("La liste des arguments du bloc n'est pas coherente.");
    end Mismatch_Arguments_List;

    procedure Undefined_Name_In_Symbol_Table is
    begin
        Write
           (" La reference recherchee dans la table des symboles n'existe pas");
    end Undefined_Name_In_Symbol_Table;

    procedure Not_Enough_Messages is
    begin
        Write ("Il n'y a pas assez de messages pour un bloc");
    end Not_Enough_Messages;

    procedure Too_Many_Messages is
    begin
        Write ("Il y a trop de messages pour un bloc");
    end Too_Many_Messages;

    procedure Too_Many_Blocks is
    begin
        Write ("Il y a trop de blocs crees... ");
    end Too_Many_Blocks;

    procedure Block_Not_Found is
    begin
        Write ("Impossible de retrouver un bloc");
    end Block_Not_Found;


    procedure Unknown_Block_Message is
    begin
        Write ("Un objet bloc a recu un message inconnu");
    end Unknown_Block_Message;

    procedure Unknown_Integer_Message is
    begin
        Write ("Un Objet entier a recu un message inconnu");
    end Unknown_Integer_Message;

    procedure Unknown_Boolean_Message is
    begin
        Write ("Un Objet booleen a recu un message inconnu");
    end Unknown_Boolean_Message;

    procedure Unknown_Turtle_Message is
    begin
        Write ("Un Objet tortue a recu un message inconnu");

    end Unknown_Turtle_Message;

    procedure Turtle_Table_Full is
    begin
        Write ("Toutes les tortues sont deja utilisees !!!");
    end Turtle_Table_Full;

    procedure Too_Many_Pens is
    begin
        Write ("Tous les stylos sont deja utilises !!!");
    end Too_Many_Pens;

    procedure Unknown_String_Message is
    begin
        Write ("Un Objet string a recu un message inconnu");
    end Unknown_String_Message;

    procedure Unknown_Pen_Message is
    begin
        Write ("Un Objet Stylo a recu un message inconnu");
    end Unknown_Pen_Message;

    procedure Unknown_Date_Message is
    begin
        Write ("Un Objet date a recu un message inconnu");
    end Unknown_Date_Message;

    procedure Unexpected_Action_On_Date is
    begin
        Write ("Une action inattendue est survenue sur un object Date");
    end Unexpected_Action_On_Date;

    procedure Incorrect_Object is
    begin
        Write ("Un message vient d'etre emis vers un objet incorrect");
    end Incorrect_Object;

    procedure Too_Many_Keywords is
    begin
        Write ("Il y a trop de message");
    end Too_Many_Keywords;

    procedure Not_Enough_Keywords is
    begin
        Write ("Il n'y a pas asse de message");
    end Not_Enough_Keywords;

    procedure Missing_Identifier is
    begin
        Write ("Il manque un identifieur dans une liste d'argument");
    end Missing_Identifier;

    procedure Unexpected_Token is
    begin
        Write ("Il y a quelque chose d'inattendue");
    end Unexpected_Token;

    procedure Mismatch_Type is
    begin
        Write ("Operation sur objets de types incompatibles");
    end Mismatch_Type;

    procedure Mismatch_Message is
    begin
        Write ("Message incoherent");
    end Mismatch_Message;

    procedure Too_Many_Includes is
    begin
        Write ("Il y a trop de fichiers a inclure");
    end Too_Many_Includes;

    procedure Bad_File_Name is
    begin
        Write ("Nom de fichier incorrect");
    end Bad_File_Name;

    procedure Fatal_X is
    begin
        Text_Io.Put_Line
           ("Je ne peux pas ouvrir de fenetre sur l'ecran precise");
    end Fatal_X;

    procedure Numeric_Error is
    begin
        Write ("Erreur de calcul (dans le genre division par zero...)");
    end Numeric_Error;

    procedure Internal_Error is
    begin
        Write ("Erreur interne...???");
    end Internal_Error;

    procedure Out_Of_Range is
    begin
        Write ("Depassement de bornes");
    end Out_Of_Range;

    procedure Out_Of_Memory is
    begin
        Write ("Plus de memoire disponible");
    end Out_Of_Memory;

    procedure Unexpected_Include_File_Name is
    begin
        Write ("Nom du fichier a inclure incorrect");
    end Unexpected_Include_File_Name;

end Tiny_Error;