DataMuseum.dk

top - download

    Length: 9913 (0x26b9)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Etape, Role, Text_Io;
package body Scene is
    package Int_Io is new Text_Io.Integer_Io (Integer);
    Tempsderniereaction : Natural := 0;

    procedure Creerunescene (Unescene : in out Scene) is
    begin
        Unescene := new Descripteurdescene;
        Unescene.Nbrescriptes := 0;
        for I in 1 .. Nbscriptes loop
            Unescene.Contenu (I).Nom := Role.Adresse_Vide;
            for J in 1 .. Nbroles loop
                Unescene.Contenu (I).Contenu (J) := Role.Role_Vide;
            end loop;
        end loop;
    end Creerunescene;

    procedure Detruireunescene (Unescene : in out Scene) is
    begin
        null;
    end Detruireunescene;

-- peut faire l'objet d'un package separe

    function Chargeruneoperation (F : Text_Io.File_Type) return Operation is
        Unacteur : Role.Acteur;
        Untemps : Etape.Temps;
        Uneaction : Etape.Action;
        Uneoperation : Operation;
    begin
        Unacteur := Role.Chargerunacteur (F);
        Untemps := Role.Chargeruntemps (F);
        Uneaction := Role.Chargeruneaction (F);


        -- UneOperation:=New Descripteur_Operation;
        Uneoperation.Temps := Untemps;

        if Untemps > Tempsderniereaction then
            Tempsderniereaction := Untemps;
        end if;

        Uneoperation.Acteur := Unacteur;
        Uneoperation.Action := Uneaction;

        Text_Io.New_Line;
        Int_Io.Put (Unacteur.Peripherique);
        Text_Io.Put ("  ");
        Int_Io.Put (Unacteur.Numero_Fonction);
        Text_Io.Put ("  ");
        Int_Io.Put (Untemps);
        Text_Io.Put ("  ");
        Int_Io.Put (Uneaction.Valeur1);
        Text_Io.Put ("  ");
        Int_Io.Put (Uneaction.Valeur2);
        Text_Io.Put ("  ");

        return Uneoperation;
    end Chargeruneoperation;
-- fin du package separe

    procedure Scripteexiste (Uneoperation : Operation;
                             Unescene : in out Scene;
                             Existe : in out Boolean;
                             Indice_Scripte : in out Natural) is
    begin
        Indice_Scripte := 1;
        Existe := False;
        while Indice_Scripte <= Nbscriptes and then not Existe loop
            if Unescene.Contenu (Indice_Scripte).Nom =
               Uneoperation.Acteur.Peripherique then
                Existe := True;
            else
                Indice_Scripte := Indice_Scripte + 1;
            end if;
        end loop;
    end Scripteexiste;

    procedure Roleexiste (Uneoperation : Operation;
                          Unscripte : in out Scripte;
                          Existe : in out Boolean;
                          Indice_Role : in out Natural) is
        use Role;
    begin
        Indice_Role := 1;
        Existe := False;
        -- FonctionPeripherique: Natural renames UneOperation.Acteur.Numero_Fonction;
        while Indice_Role <= Nbroles and then not Existe loop
            if Unscripte.Contenu (Indice_Role) /= Role.Role_Vide and then
               Unscripte.Contenu (Indice_Role).Lacteur.Numero_Fonction =
                  Uneoperation.Acteur.Numero_Fonction then
                Existe := True;
            else
                Indice_Role := Indice_Role + 1;
            end if;
        end loop;
    end Roleexiste;

    function Trouverscriptelibre (Unescene : in Scene) return Natural is
        Indice_Scripte : Natural := 1;
        Trouve : Boolean := False;
    begin
        while Indice_Scripte <= Nbscriptes and then not Trouve loop
            if Unescene.Contenu (Indice_Scripte).Nom = Role.Adresse_Vide then
                return Indice_Scripte;
            end if;
            Indice_Scripte := Indice_Scripte + 1;
        end loop;
        -- raise Scene_Full
        -- return 0;
    end Trouverscriptelibre;

    procedure Creerunscripte (Unacteur : in Role.Acteur;
                              Unescene : in out Scene;
                              Indice_Scripte : in out Natural) is
    begin
        Indice_Scripte := Trouverscriptelibre (Unescene);
        Unescene.Contenu (Indice_Scripte).Nom := Unacteur.Peripherique;
    end Creerunscripte;

    function Trouverrolelibre (Unscripte : in Scripte) return Natural is
        use Role;
        Indice_Role : Natural := 1;
        Trouve : Boolean := False;
    begin
        while Indice_Role <= Nbroles and then not Trouve loop
            if Unscripte.Contenu (Indice_Role) = Role.Role_Vide then
                return Indice_Role;
            end if;
            Indice_Role := Indice_Role + 1;
        end loop;
        -- raise Scripte_Full
        -- return 0;
    end Trouverrolelibre;

    procedure Creerroledansscripte (Unacteur : in Role.Acteur;
                                    Unscripte : in out Scripte;
                                    Indice_Role : in out Natural) is
        Unrole : Role.Role;
    begin
        Indice_Role := Trouverrolelibre (Unscripte);
        Unrole := Role.Creerunrole (Unacteur);
        Unscripte.Contenu (Indice_Role) := Unrole;
    end Creerroledansscripte;

    procedure Traiteruneoperation
                 (Uneoperation : in Operation; Unescene : in out Scene) is
        Indice_Scripte : Natural := 1;
        Indice_Role : Natural := 1;
        Existe : Boolean := False;
        Unrole : Role.Role;
    begin
        -- recherche si le scripte lie au peripherique existe
        Scripteexiste (Uneoperation, Unescene, Existe, Indice_Scripte);
        -- creation si n'existe pas
        if not Existe then
            Creerunscripte (Uneoperation.Acteur, Unescene, Indice_Scripte);
        end if;
        Int_Io.Put (Integer (Indice_Scripte));
        Text_Io.New_Line;
        -- a partir de la, on travaille sur un scripte particulier :
        -- UneScene.Contenu(Indice_Scripte)
        -- recherche si le role (ou acteur) du scripte existe
        Roleexiste (Uneoperation, Unescene.Contenu (Indice_Scripte),
                    Existe, Indice_Role);
        if not Existe then
            Creerroledansscripte
               (Uneoperation.Acteur,
                Unescene.Contenu (Indice_Scripte), Indice_Role);
        end if;
        Int_Io.Put (Integer (Indice_Role));
        Text_Io.New_Line;
        -- on travaille sur role particulier :
        -- UneScene.Contenu(Indice_Scripte).Contenu(Indice_Role)
        -- Inserer Action dans une etape de l'acteur avec UnTemps comme clef
        --  Role_Courant: Scripte renames UneScene.Contenu(Indice_Scripte).Contenu(Indice_Role);
        Role.Caseruneactiondanslerole
           (Unescene.Contenu (Indice_Scripte).Contenu (Indice_Role),
            Uneoperation.Temps, Uneoperation.Action);
    end Traiteruneoperation;

    function Chargerunescene (F : Text_Io.File_Type) return Scene is
        Uneoperation : Operation;
        Unescene : Scene;
    begin
        Creerunescene (Unescene);
        while not Text_Io.End_Of_File (F) loop
            Uneoperation := Chargeruneoperation (F);
            Traiteruneoperation (Uneoperation, Unescene);
            if Text_Io.End_Of_Line (F) then
                Text_Io.Skip_Line (F);
            end if;
        end loop;
        return Unescene;
    end Chargerunescene;

    procedure Ajouterunrole (Unescene : in out Scene; Unrole : Role.Role) is
    begin
        null;
    end Ajouterunrole;

    procedure Ajouterunacteur (Unescene : in out Scene;
                               Unacteur : Role.Acteur) is
    begin
        null;
    end Ajouterunacteur;

    procedure Afficherunscripte (Unscripte : in Scripte) is
        use Role;
        Unrole : Role.Role;
    begin
        for Indice_Role in 1 .. Nbroles loop
            Unrole := Unscripte.Contenu (Indice_Role);
            if Unrole /= Role.Role_Vide then
                Role.Afficherunrole (Unrole);
            end if;
        end loop;
    end Afficherunscripte;

    procedure Afficherunescene (Unescene : in Scene) is
        Unscripte : Scripte;
    begin
        for Indice_Scripte in 1 .. Nbscriptes loop
            Unscripte := Unescene.Contenu (Indice_Scripte);
            if Unscripte.Nom /= Role.Adresse_Vide then
                Afficherunscripte (Unscripte);
            end if;
        end loop;
    end Afficherunescene;

    procedure Jouerunescene (Unescene : in out Scene) is   -- bloquant
        use Role;
    begin
        for Indice_Scripte in 1 .. Nbscriptes loop
            for Indice_Role in 1 .. Nbroles loop
                if Unescene.Contenu (Indice_Scripte).Contenu (Indice_Role) /=
                   Role.Role_Vide then
                    Role.Demarrerlerole
                       (Unescene.Contenu (Indice_Scripte).Contenu
                           (Indice_Role));
                end if;
            end loop;
        end loop;
        Role.Startchrono;
        while Role.Tempschrono <= Tempsderniereaction loop
            Text_Io.Put ("Chrono = ");
            Int_Io.Put (Integer (Role.Tempschrono));
            Text_Io.New_Line;
            for Indice_Scripte in 1 .. Nbscriptes loop
                for Indice_Role in 1 .. Nbroles loop
                    if Unescene.Contenu (Indice_Scripte).Contenu
                          (Indice_Role) /= Role.Role_Vide then
                        Role.Solliciterlerole
                           (Unescene.Contenu (Indice_Scripte).Contenu
                               (Indice_Role));
                    end if;
                end loop;
            end loop;
            Role.Avancerchrono;
        end loop;
    end Jouerunescene;

    function Quellescene (Unrole : Role.Role) return Scene is
        Unescene : Scene;
    begin
        return Unescene;
    end Quellescene;

    function Quellescene (Unacteur : Role.Acteur) return Scene is
        Unescene : Scene;
    begin
        return Unescene;
    end Quellescene;
end Scene;
--  Nom    :  SCENE.ADS
--  specifications du package Scene
--  Auteur : Sebastien BROCHET
--  Date   : 29 Novembre 1993
--  Etat   : en cours