DataMuseum.dk

top - metrics - download

    Length: 17285 (0x4385)
    Types: TextFile
    Names: »B«

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

TextFile

with Bloc;
with Standard_String;
use Standard_String;
with Motor;

separate (Semantique)
package body Script is

    package Bloc_Scenario is
       new Bloc (Standard_String.Object, Standard_String.Equal);


    Nombres : constant Boolean := False;
    Noms : constant Boolean := True;


    type Mise_A_Jour is (Nbr, Id, Liste_Nbr, Liste_Id);


    Est_Dans_Scenario : Boolean := False;
    Oper_Temps_Simple : Boolean := True;  
    Var_Maj : Mise_A_Jour;
    Nbr_Courant : Integer := 0;
    Var_De, Var_Vers, Var_En : Integer := -1;
    Id_Courant_1, Id_Courant_2 : Standard_String.Object;
    Liste_Courante_Nbr : Bloc_Scenario.Liste (Nombres);
    Liste_Courante_Id : Bloc_Scenario.Liste (Noms);
    Ptr_Courant_Nbr : Bloc_Scenario.Pliste := Bloc_Scenario.Liste_Vide;  
    Ptr_Courant_Id : Bloc_Scenario.Pliste := Bloc_Scenario.Liste_Vide;
    Cpt_Erreur_Scene : Integer := 0;


    procedure Ouvrir_Nouveau_Bloc_Scenario is
        Ok : Boolean := False;
    begin
        Est_Dans_Scenario := True;
        Ok := Bloc_Scenario.Nouveau_Pere;
    end Ouvrir_Nouveau_Bloc_Scenario;


    procedure Fermer_Bloc_Scenario is
        Un_Offset : Integer;
    begin
        --tri des actions par odre chronologique
        Bloc_Scenario.Construit_Liste_Offset;
    end Fermer_Bloc_Scenario;


    procedure Ouvrir_Nouveau_Bloc_Scene (Une_Scene : Standard_String.Object) is
        Profondeur : Integer := 0;
        Ok, Possible : Boolean := False;
        Nom_Errone : Standard_String.Object;
    begin

        while Bloc_Scenario.Va_Bloc_Pere loop
            null;
        end loop;
        Profondeur := Bloc_Scenario.Donne_Profondeur;
        if Profondeur = 0 then
            Possible := Bloc_Scenario.Nouveau_Bloc_Fils;
            Ok := Bloc_Scenario.Va_Bloc_Fils;
            if not Possible then  
                while Bloc_Scenario.Va_Bloc_Frere_Aine loop
                    null;
                end loop;
                Ok := Bloc_Scenario.Nouveau_Bloc_Frere_Aine;
                Ok := Bloc_Scenario.Va_Bloc_Frere_Aine;
            end if;
            if Bloc_Scenario.Scene_Existe (Une_Scene) then
                Erreurs.Ajouter ("Ce nom de scene existe deja");
                Standard_String.Put_Contents (Nom_Errone,
                                              Integer'Image (Cpt_Erreur_Scene));
                Ok := Bloc_Scenario.Insere_Scene (Nom_Errone);
                Cpt_Erreur_Scene := Cpt_Erreur_Scene + 1;
            else
                Ok := Bloc_Scenario.Insere_Scene (Une_Scene);
            end if;

        else
            Erreurs.Ajouter ("Impossible d'avoir une scene imbriquee");
        end if;
    end Ouvrir_Nouveau_Bloc_Scene;


    procedure Fermer_Bloc_Scene is
    begin
        null;
    end Fermer_Bloc_Scene;


    procedure Ouvrir_Bloc_Enchainement is
        Ok : Boolean;
    begin  
        Est_Dans_Scenario := False;  
    end Ouvrir_Bloc_Enchainement;


    procedure Fermer_Bloc_Enchainement is
    begin
        null;-- pour la production du code
    end Fermer_Bloc_Enchainement;


    procedure Ouvrir_Bloc (Nature : Lexical.Token) is
        Ok : Boolean := False;
        Le_String : Standard_String.Object;


        procedure Insere_Bloc (Un_Nombre : Integer) is
        begin  
            if Bloc_Scenario.Nouveau_Bloc_Fils then
                Ok := Bloc_Scenario.Va_Bloc_Fils;  
            else
                Ok := Bloc_Scenario.Va_Bloc_Fils;
                while Bloc_Scenario.Va_Bloc_Frere_Aine loop
                    null;
                end loop;
                Ok := Bloc_Scenario.Nouveau_Bloc_Frere_Aine;
                Ok := Bloc_Scenario.Va_Bloc_Frere_Aine;
            end if;
            Standard_String.Put_Contents (Le_String,
                                          Lexical.Token'Image (Nature));
            Bloc_Scenario.Insere_Type_Bloc (Le_String);
            Bloc_Scenario.Insere_Offset (Un_Nombre);
        end Insere_Bloc;


    begin
        if Est_Dans_Scenario then
            case Nature is
                when L_Dans =>  
                    if Var_Maj = Nbr then
                        Insere_Bloc (Nbr_Courant);
                    elsif Var_Maj = Liste_Nbr then
                        Bloc_Scenario.Prend_Liste (Liste_Courante_Nbr);
                        Insere_Bloc (Bloc_Scenario.Donne_Element);
                        while Bloc_Scenario.Suivant loop
                            Insere_Bloc (Bloc_Scenario.Donne_Element);
                        end loop;
                    else
                        Erreurs.Ajouter
                           ("Erreur semantique Ouvrir_bloc(Nature)");
                    end if;
                when L_Repeter =>
                    Ok := Bloc_Scenario.Nouveau_Bloc_Fils;
                    Standard_String.Put_Contents (Le_String,
                                                  Lexical.Token'Image (Nature));
                    Bloc_Scenario.Insere_Type_Bloc (Le_String);
                when others =>
                    null;
            end case;
        else
            case Nature is
                when L_Dans | L_Toutes | L_Repeter_Ad_Eternam | L_Repeter =>
                    Erreurs.Ajouter
                       ("Ne pas faire de declaration de bloc dans la partie enchainement");
                when others =>
                    null;
            end case;
        end if;
    end Ouvrir_Bloc;


    procedure Fermer_Bloc (Nature : Lexical.Token) is  
        Ok : Boolean := False;
    begin
        Ok := Bloc_Scenario.Va_Bloc_Pere;
    end Fermer_Bloc;


    procedure Lire_Liste_Temps is
    begin
        if Var_Maj = Nbr then
            Bloc_Scenario.Insere_Offset (Nbr_Courant);
        elsif Var_Maj = Liste_Nbr then
            null;
        else
            Erreurs.Ajouter ("Erreur semantique Lire_liste_Temps");
        end if;
    end Lire_Liste_Temps;


    procedure Lire_Nombre (Un_Nombre : Integer) is
    begin
        Nbr_Courant := Un_Nombre;
    end Lire_Nombre;


    procedure Lire_Nombre (Un_Id : Standard_String.Object) is
    begin  
        if Acteurs.Acteur_Existe (Un_Id) then
            Erreurs.Ajouter ("Pas de calcul avec un acteur => remplace par 0.");
        end if;
        if Materiels.Action_Existe (L_Action => Un_Id) then
            Erreurs.Ajouter
               ("Pas de calcul avec une action => remplace par 0.");
        end if;
        Bloc_Scenario.Prend_Liste (Bloc_Scenario.Qui_Es_Tu (Un_Id));
        if Bloc_Scenario.Donne_Type_Liste = Nombres then
            if not (Bloc_Scenario.Donne_Taille_Liste = 1) then
                Erreurs.Ajouter
                   ("Une variable simple est demandee et non une liste de valeurs");
            end if;
            Nbr_Courant := Bloc_Scenario.Donne_Element;
        else
            Erreurs.Ajouter
               ("Une variable simple est demandee et non une liste de symboles");
            Nbr_Courant := 0;
        end if;  
    end Lire_Nombre;


    procedure Complete_Liste (Un_Nom : Standard_String.Object) is
    begin  
        if Est_Dans_Scenario then
            Standard_String.Copy (From => Un_Nom, To => Id_Courant_1);
        else
            Erreurs.Ajouter ("Erreur interne Complete_Liste(Un_nom)");
        end if;
    end Complete_Liste;


    procedure Controle_Option (Une_Option : Lexical.Token) is
        Ok : Boolean := False;
    begin  
        case Une_Option is
            when L_De =>
                Ok := Verif_Actions.Action_Possible (Une_Action => Id_Courant_1,
                                                     Un_Acteur => Id_Courant_2,
                                                     De => L_Ok);
                if Ok then
                    Var_De := Nbr_Courant;
                else
                    Var_De := -1;
                end if;
            when L_Vers =>
                Ok := Verif_Actions.Action_Possible (Une_Action => Id_Courant_1,
                                                     Un_Acteur => Id_Courant_2,
                                                     Vers => L_Ok);
                if Ok then
                    Var_Vers := Nbr_Courant;
                else
                    Var_Vers := -1;
                end if;
            when L_En =>
                Ok := Verif_Actions.Action_Possible (Une_Action => Id_Courant_1,
                                                     Un_Acteur => Id_Courant_2,
                                                     En => L_Ok);
                if Ok then
                    Var_En := Nbr_Courant;
                else
                    Var_En := -1;
                end if;
            when others =>
                null;
        end case;
        if not Ok then
            Erreurs.Ajouter
               ("Option non declaree pour l'action '" &
                Standard_String.Get_Contents (Id_Courant_1) & "'.");
        end if;
    end Controle_Option;


    procedure Complete_Action (Une_Action : Standard_String.Object) is
    begin
        Standard_String.Copy (From => Une_Action, To => Id_Courant_2);
    end Complete_Action;


    procedure Insere_Action is
        La_Liste_Acteur : Bloc_Scenario.Liste (Noms);
        String_Courant : Standard_String.Object;
    begin
        Bloc_Scenario.Prend_Liste (Bloc_Scenario.Qui_Es_Tu (Id_Courant_2));
        if Bloc_Scenario.Donne_Type_Liste = Noms then
            String_Courant := Bloc_Scenario.Donne_Element;
            if Verif_Actions.Action_Possible (Id_Courant_1, String_Courant) then
                Bloc_Scenario.Insere_Liste_Action (Une_Action => Id_Courant_1,
                                                   Un_Acteur => String_Courant,
                                                   De => -1,
                                                   Vers => -1,
                                                   En => -1);
            end if;  
            while Bloc_Scenario.Suivant loop
                String_Courant := Bloc_Scenario.Donne_Element;
                if Verif_Actions.Action_Possible
                      (Id_Courant_1, String_Courant) then
                    Bloc_Scenario.Insere_Liste_Action
                       (Une_Action => Id_Courant_1,
                        Un_Acteur => String_Courant,
                        De => -1,
                        Vers => -1,
                        En => -1);
                end if;
            end loop;
        else
            if Verif_Actions.Action_Possible (Id_Courant_1, Id_Courant_2) then
                Bloc_Scenario.Insere_Liste_Action (Une_Action => Id_Courant_1,
                                                   Un_Acteur => Id_Courant_2,
                                                   De => Var_De,
                                                   Vers => Var_Vers,
                                                   En => Var_En);
            end if;
        end if;
        Var_De := -1;
        Var_Vers := -1;
        Var_En := -1;
    end Insere_Action;


    procedure Nouveau_Bloc_Groupe_Temps (Un_Jeton : Lexical.Token) is
    begin
        Oper_Temps_Simple := False;
        Ptr_Courant_Nbr := Bloc_Scenario.Donne_Nouvelle_Liste (Nombres);
    end Nouveau_Bloc_Groupe_Temps;


    procedure Ajouter_Bloc_Groupe_Temps (Un_Nombre : Integer) is
    begin
        if Oper_Temps_Simple then
            Nbr_Courant := Un_Nombre;
            Var_Maj := Nbr;
        else
            Bloc_Scenario.Concate (Un_Nombre, Ptr_Courant_Nbr);
            Var_Maj := Liste_Nbr;
        end if;
    end Ajouter_Bloc_Groupe_Temps;


    procedure Ajouter_Bloc_Groupe_Temps (Un_Nom : Standard_String.Object) is
        La_Liste : Bloc_Scenario.Liste (Nombres);
        La_Valeur : Integer := 0;
    begin  
        if Acteurs.Acteur_Existe (Un_Nom) or else
           Materiels.Action_Existe (L_Action => Un_Nom) then
            Oper_Temps_Simple := True;
            Ajouter_Bloc_Groupe_Temps (0);
            Erreurs.Ajouter
               ("Impossible d'utiliser un acteur ou une action a cet endroit => remplace par 0.");
        else
            La_Liste := Bloc_Scenario.Qui_Es_Tu (Un_Nom);
            Bloc_Scenario.Prend_Liste (La_Liste);
            La_Valeur := Bloc_Scenario.Donne_Element;
            if Bloc_Scenario.Donne_Taille_Liste /= 1 then
                Nouveau_Bloc_Groupe_Temps (Lexical.L_Open);
                Ajouter_Bloc_Groupe_Temps (La_Valeur);
                while Bloc_Scenario.Suivant loop
                    La_Valeur := Bloc_Scenario.Donne_Element;
                    Ajouter_Bloc_Groupe_Temps (La_Valeur);
                end loop;
            else
                Oper_Temps_Simple := True;
                Ajouter_Bloc_Groupe_Temps (La_Valeur);
            end if;
        end if;


    end Ajouter_Bloc_Groupe_Temps;


    procedure Fermer_Bloc_Groupe_Temps is
    begin
        Oper_Temps_Simple := True;
    end Fermer_Bloc_Groupe_Temps;


    function Donne_Nombre_Courant return Integer is
    begin
        return Nbr_Courant;
    end Donne_Nombre_Courant;


    function Donne_Id_Courant return Standard_String.Object is
    begin
        return Id_Courant_1;
    end Donne_Id_Courant;


    procedure Inserer_Liste_Symbole
                 (Un_Element : Standard_String.Object; Une_Valeur : Integer) is
    begin
        Bloc_Scenario.Insere_Liste_Symbole (Un_Element, Une_Valeur);
    end Inserer_Liste_Symbole;


    procedure Genere_Scene (Une_Scene : Standard_String.Object) is  
        L_Offset : Integer;
        Ok : Boolean := False;
        Offset_Precedent, Offset_Courant : Integer := 0;

        procedure Donne_A_Bouffer_Au_Moteur_Qu_Olivier_A_Fait_Avec_Amour is
            Une_Action, Un_Acteur : Standard_String.Object;
            De, Vers, En : Integer := -1;
            Le_Type : Standard_String.Object;
            L_Adresse, Le_Code_Action : Integer;
            Index_Courant : Integer;
        begin
            Bloc_Scenario.Liste_Action_Donne
               (Une_Action, Un_Acteur, De, Vers, En);
            Le_Type := Acteurs.Donne_Type_Acteur (Un_Acteur);
            Index_Courant := Verif_Actions.Donne_Indice_Tableau_Acteurs
                                (Le_Type, Un_Acteur);
            L_Adresse := Tableau_Acteurs (Index_Courant).L_Adresse;
            Index_Courant := Verif_Actions.Donne_Indice_Tableau_Actions
                                (Le_Type, Une_Action);

            Le_Code_Action := Tableau_Actions (Index_Courant).Le_Code;
            Offset_Courant := L_Offset - Offset_Precedent;
            Offset_Precedent := L_Offset;
            Text_Io.Put_Line ("L'offset absolu est : " &
                              Integer'Image (L_Offset));
            Text_Io.Put_Line ("L'offset relatif est : " &
                              Integer'Image (Offset_Courant));
            Text_Io.Put_Line (Standard_String.Get_Contents (Un_Acteur) &
                              " " & Integer'Image (L_Adresse));
            Text_Io.Put_Line (Standard_String.Get_Contents (Une_Action) &
                              " " & Integer'Image (Le_Code_Action));
            Text_Io.Put_Line (Integer'Image (De));  
            Text_Io.Put_Line (Integer'Image (Vers));
            Text_Io.Put_Line (Integer'Image (En));  
            Text_Io.Put_Line ("");
            Motor.Inserer_Une_Action (Un_Temps_Relatif => Offset_Courant,
                                      Une_Adresse_Station => L_Adresse,
                                      Une_Action => Le_Code_Action,
                                      De => De,
                                      Vers => Vers,
                                      En => En);
        end Donne_A_Bouffer_Au_Moteur_Qu_Olivier_A_Fait_Avec_Amour;


    begin
        if Bloc_Scenario.Init_Liste_Offset (Une_Scene) then
            while Bloc_Scenario.Suivant_Liste_Offset_Est_Bloc_Courant loop
                if Bloc_Scenario.Liste_Action_Init then
                    L_Offset := Bloc_Scenario.Donne_Offset;
                    Donne_A_Bouffer_Au_Moteur_Qu_Olivier_A_Fait_Avec_Amour;
                    while Bloc_Scenario.Liste_Action_Suivante loop
                        L_Offset := Bloc_Scenario.Donne_Offset;
                        Donne_A_Bouffer_Au_Moteur_Qu_Olivier_A_Fait_Avec_Amour;
                    end loop;
                end if;
            end loop;  
        else
            Erreurs.Ajouter ("Nom de scene inconnu");
        end if;
    end Genere_Scene;


    procedure Nouveau_Bloc_Groupe_Affecte
                 (Un_Groupe : Standard_String.Object) is
    begin
        Standard_String.Copy (From => Un_Groupe, To => Id_Courant_1);
    end Nouveau_Bloc_Groupe_Affecte;


    procedure Nouveau_Bloc_Groupe is
    begin
        Ptr_Courant_Id := Bloc_Scenario.Donne_Nouvelle_Liste (Noms);
    end Nouveau_Bloc_Groupe;


    procedure Ajouter_Bloc_Groupe (Un_Groupe : Standard_String.Object) is
    begin
        Bloc_Scenario.Concate (Un_Element => Un_Groupe,
                               Une_Liste => Ptr_Courant_Id);
    end Ajouter_Bloc_Groupe;


    procedure Fermer_Bloc_Groupe is
    begin
        Bloc_Scenario.Insere_Liste_Symbole
           (Id_Courant_1, Bloc_Scenario.Donne_Liste (Ptr_Courant_Id));
    end Fermer_Bloc_Groupe;


    procedure Fermer_Bloc_Groupe_Affecte is
    begin
        null;
    end Fermer_Bloc_Groupe_Affecte;

end Script;