DataMuseum.dk

top - download

    Length: 13002 (0x32ca)
    Types: TextFile
    Names: »B«

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

TextFile

-- fichier : Role
-- Body du package ROLE
-- Auteur : Sebastien BROCHET
-- Date   : 24 Novembre 1993
-- Etat   : en cours

with Etape, Text_Io, Formate;
with Serial_Io;

package body Role is

    package Int_Io is new Text_Io.Integer_Io (Integer);

    Chrono : Natural := 0;

    procedure Afficherunrole (R : Role) is
        use Etape;
        E : Etape.Etape;
    begin
        Text_Io.New_Line;
        Text_Io.Put ("Acteur : ");
        Int_Io.Put (Lacteurdurole (R).Peripherique);
        Text_Io.Put (" ");
        Int_Io.Put (Lacteurdurole (R).Numero_Fonction);
        Text_Io.New_Line;
        Text_Io.Put ("Les Etapes : ");
        E := Lesetapesdurole (R);
        while E /= Etape.Etapeinexistante loop
            Etape.Afficheruneetape (E);
            E := Etape.Lasuitedeletape (E);
        end loop;
        Text_Io.New_Line;
        Text_Io.Put ("En Cours : ");
        if Leroleestencours (R) then
            Text_Io.Put ("VRAIE");
        else
            Text_Io.Put ("FAUX");
        end if;
        Text_Io.New_Line;
        Text_Io.Put ("Le Debut : ");
        Int_Io.Put (Ledebutdurole (R));
        Text_Io.New_Line;
        Text_Io.Put ("L'index  : ");
        Text_Io.New_Line;
        Text_Io.Put ("La Duree : ");
        Int_Io.Put (Ladureedurole (R));
        Text_Io.New_Line;
    end Afficherunrole;


-- methodes privees au package Role
    procedure Executer (Qui : Acteur; Quoi : Etape.Action) is
    begin
        if Quoi.Valeur1 = 0 and then Quoi.Valeur2 = 0 then
            Serial_Io.Put
               ('D' & Formate.Entierverschaine (Qui.Peripherique, 2) &
                Formate.Entierverschaine (Qui.Numero_Fonction, 2) &
                Formate.Entierverschaine (Quoi.Valeur1, 4) & 'F', "/dev/tty0");
        else
            Serial_Io.Put
               ('D' & Formate.Entierverschaine (Qui.Peripherique, 2) &
                Formate.Entierverschaine (Qui.Numero_Fonction, 2) &
                Formate.Entierverschaine (Quoi.Valeur1, 4) &
                Formate.Entierverschaine (Quoi.Valeur2, 4) & 'F', "/dev/tty0");
        end if;
        Text_Io.New_Line;
    end Executer;

    procedure Sauvegarderletemps
                 (F : Text_Io.File_Type; Untemps : Etape.Temps) is
    begin
        Int_Io.Put (F, Untemps);
    end Sauvegarderletemps;

    procedure Sauvegarderlacteur (F : Text_Io.File_Type; Unacteur : Acteur) is
    begin
        Int_Io.Put (F, Unacteur.Peripherique);
        Int_Io.Put (F, Unacteur.Numero_Fonction);
    end Sauvegarderlacteur;

    procedure Sauvegarderlaction
                 (F : Text_Io.File_Type; Uneaction : Etape.Action) is
    begin
        Int_Io.Put (F, Uneaction.Valeur1);
        Int_Io.Put (F, Uneaction.Valeur2);
    end Sauvegarderlaction;

-- fin partie privee

-- creation
    function Creerunrole (A : Acteur) return Role is
        Resultat : Role;
    begin
        Resultat := new Descripteurderole;
        Resultat.Lacteur := A;
        Resultat.Lesetapes := Etape.Etapeinexistante;
        Resultat.Encours := False;
        Resultat.Ledebut := 0; -- temps
        Resultat.Lindex := Etape.Etapeinexistante;
        Resultat.Laduree := 0;
        return Resultat;
    end Creerunrole;

    function Chargerunacteur (F : in Text_Io.File_Type) return Acteur is
        Adr_Periph, Num_Fonc : Integer;
        Actaux : Acteur;
    begin
        Int_Io.Get (F, Adr_Periph);
        Int_Io.Get (F, Num_Fonc);
        Actaux.Peripherique := Adresse_Peripherique'(Adr_Periph);
        Actaux.Numero_Fonction := Natural'(Num_Fonc);
        return Actaux;
    end Chargerunacteur;

    function Chargeruneaction (F : in Text_Io.File_Type) return Etape.Action is
        Actionaux : Etape.Action;
        Val1, Val2 : Integer;
    begin
        Int_Io.Get (F, Val1);
        Int_Io.Get (F, Val2);
        Actionaux.Valeur1 := Val1;   -- rajouter protections
        Actionaux.Valeur2 := Val2;
        return Actionaux;
    end Chargeruneaction;

    function Chargeruntemps (F : in Text_Io.File_Type) return Etape.Temps is
        I : Integer;
        Tempsaux : Etape.Temps;
    begin
        Int_Io.Get (F, I);
        Tempsaux := Etape.Temps'(I);
        return Tempsaux;
    end Chargeruntemps;

    function Chargerunrole (F : in Text_Io.File_Type) return Role is
        Unrole : Role;
        Unacteur : Acteur;
        Uneaction : Etape.Action;
        Untemps : Etape.Temps;
        Nombre : Integer;
    begin
        Unacteur := Chargerunacteur (F);
        Unrole := Creerunrole (Unacteur);
        Int_Io.Get (F, Nombre);
        for I in 1 .. Nombre loop
            Uneaction := Chargeruneaction (F);
            Untemps := Chargeruntemps (F);
            Caseruneactiondanslerole (Unrole, Untemps, Uneaction);
        end loop;
        return Unrole;
    end Chargerunrole;

-- acces
    function Lenombredactionsdurole (Unrole : Role) return Integer is
        use Etape;
        Compteur : Integer := 0;
        Ptretape : Etape.Etape;
    begin
        Ptretape := Lesetapesdurole (Unrole);
        while Ptretape /= Etape.Etapeinexistante loop
            Compteur := Compteur + 1;
            Ptretape := Etape.Lasuitedeletape (Ptretape);
        end loop;
        return Compteur;
    end Lenombredactionsdurole;

    function Leroleestvide (Unrole : Role) return Boolean is
        use Etape;
    begin
        return Unrole.Lesetapes = Etape.Etapeinexistante;
    end Leroleestvide;

    function Lacteurdurole (Unrole : Role) return Acteur is
    begin
        return Unrole.Lacteur;
    end Lacteurdurole;

    function Ladureedurole (Unrole : Role) return Etape.Temps is
    begin
        return Unrole.Laduree;
    end Ladureedurole;

    function Leroleestencours (Unrole : Role) return Boolean is
    begin
        return Unrole.Encours;
    end Leroleestencours;

    function Ledebutdurole (Unrole : Role) return Etape.Temps is
    begin
        return Unrole.Ledebut;
    end Ledebutdurole;

    function Lesetapesdurole (Unrole : Role) return Etape.Etape is
    begin
        return Unrole.Lesetapes;
    end Lesetapesdurole;

    procedure Quelleactiondurole (Unrole : Role;
                                  Untemps : Etape.Temps;
                                  Uneaction : out Etape.Action;
                                  Existe : out Boolean) is
        use Etape;
        Indexrole : Etape.Etape;
        Trouve : Boolean := False;
    begin
        Existe := False;
        Indexrole := Lesetapesdurole (Unrole);
        while Indexrole /= Etape.Etapeinexistante and then not Trouve loop
            if Etape.Letempsdeletape (Indexrole) = Untemps then
                Existe := True;
                Trouve := True;
                Uneaction := Etape.Lactiondeletape (Indexrole);
            end if;
            Indexrole := Etape.Lasuitedeletape (Indexrole);
        end loop;
    end Quelleactiondurole;

-- modification
    procedure Caseruneactiondanslerole (Unrole : in out Role;
                                        Untemps : Etape.Temps;
                                        Uneaction : Etape.Action) is
        E : Etape.Etape;
    begin
        E := Lesetapesdurole (Unrole);
        Etape.Caseruneactiondanslesetapes (Untemps, Uneaction, E);
        if Untemps > Unrole.Laduree then
            Unrole.Laduree := Untemps;
        end if;
        Unrole.Lesetapes := E;
    end Caseruneactiondanslerole;

    procedure Exclureuneactiondurole
                 (Unrole : in out Role; Untemps : Etape.Temps) is
        use Etape;
        E : Etape.Etape;
        Letemps : Etape.Temps;
    begin
        E := Lesetapesdurole (Unrole);
        Etape.Exclureuneactiondesetapes (E, Untemps);
        if Untemps = Unrole.Laduree then
            Unrole.Laduree := 0;
            E :=
               Lesetapesdurole
                  (Unrole);  -- verifier si indispensable cad si UnRole modifie
            while E /= Etape.Etapeinexistante loop
                Letemps := Etape.Letempsdeletape (E);
                if Letemps > Unrole.Laduree then
                    Unrole.Laduree := Letemps;
                end if;
                E := Etape.Lasuitedeletape (E);
            end loop;
        end if;
    end Exclureuneactiondurole;

    procedure Decaleruneactiondurole (Unrole : in out Role;
                                      Untemps : Etape.Temps;
                                      Undelai : Delai) is
        use Etape;
        Nouveautemps : Etape.Temps;
    begin
        Nouveautemps := Untemps + Etape.Temps (Undelai);
        if Nouveautemps >= 0 then
            Deplaceruneactiondurole (Unrole, Untemps, Nouveautemps);
        else
            null;  -- traitement erreurs
        end if;
    end Decaleruneactiondurole;

    procedure Deplaceruneactiondurole (Unrole : in out Role;
                                       Ancien : Etape.Temps;
                                       Nouveau : Etape.Temps) is
        Uneaction : Etape.Action;
        Existe : Boolean;
    begin
        Quelleactiondurole (Unrole, Ancien, Uneaction, Existe);
        if Existe then
            Exclureuneactiondurole (Unrole, Ancien);
            Caseruneactiondanslerole (Unrole, Nouveau, Uneaction);
        end if;
    end Deplaceruneactiondurole;

    procedure Decalerlerole (Unrole : in out Role; Undelai : Delai) is
        use Etape;
        Uneetape : Etape.Etape;
        Letemps : Etape.Temps;
    begin
        if not Leroleestvide (Unrole) then
            Uneetape := Lesetapesdurole (Unrole);
            if Etape.Letempsdeletape (Uneetape) + Undelai >= 0 then
                while Uneetape /= Etape.Etapeinexistante loop
                    Letemps := Etape.Letempsdeletape (Uneetape) + Undelai;
                    Etape.Changerletempsdeletape (Uneetape, Letemps);
                end loop;
                Unrole.Laduree := Unrole.Laduree + Undelai;
            else
                null;  -- traitement erreurs
            end if;
        end if;
    end Decalerlerole;

    procedure Viderlerole (Unrole : in out Role) is
        use Etape;
        Etapeajeter : Etape.Etape;
    begin
        while Unrole.Lesetapes /= Etape.Etapeinexistante loop
            Etapeajeter := Unrole.Lesetapes;
            Unrole.Lesetapes := Etape.Lasuitedeletape (Etapeajeter);
            Etape.Detruireletape (Etapeajeter);
        end loop;
    end Viderlerole;

    procedure Startchrono is
    begin
        Chrono := 0;
    end Startchrono;

    function Tempschrono return Natural is
    begin
        return Chrono;
    end Tempschrono;

    procedure Avancerchrono is     -- a modifier
    begin
        delay 0.1;  -- on "perd" un dizieme de seconde
        Chrono := Chrono + 1;
    end Avancerchrono;

-- a mettre ou il faut
-- FUNCTION LeTempsSysteme return INTEGER is
-- LeTemps:Calendar.Time;
-- begin
    -- Letemps:=calendar.clock;
    -- tempsDiziemes:=LeTemps.
--  return 1;
-- end LeTempsSysteme;
-- a mettre ou il faut

-- execution
    procedure Demarrerlerole (Unrole : in out Role) is
        use Etape;
    begin
        Unrole.Lindex := Lesetapesdurole (Unrole);
        if Unrole.Lindex /= Etape.Etapeinexistante then
            Unrole.Encours := True;
            Unrole.Ledebut := 0;  -- LeTempsSysteme;
        end if;
    end Demarrerlerole;

    procedure Arreterlerole (Unrole : in out Role) is
    begin
        Unrole.Encours := False;
    end Arreterlerole;

    procedure Jouerlerole (Unrole : in out Role) is
    begin
        Demarrerlerole (Unrole);
        while Leroleestencours (Unrole) loop
            Solliciterlerole (Unrole);
        end loop;
    end Jouerlerole;



    procedure Solliciterlerole (Unrole : in out Role) is
        use Etape;
        Qui : Acteur;
        Quoi : Etape.Action;
    begin
        if Leroleestencours (Unrole) then
            if Etape.Letempsdeletape (Unrole.Lindex) <=
               Tempschrono then  -- (LeTempsSysteme- UnRole.LeDebut) then
                Qui := Lacteurdurole (Unrole);
                Quoi := Etape.Lactiondeletape (Unrole.Lindex);
                Executer (Qui, Quoi);
                Unrole.Lindex := Etape.Lasuitedeletape (Unrole.Lindex);
                if Unrole.Lindex = Etape.Etapeinexistante then
                    Arreterlerole (Unrole);
                end if;
            else
                null;   -- erreurs
            end if;
        end if;
    end Solliciterlerole;

-- sauvegarde
    procedure Sauvegarderlerole (Unrole : Role; Fichier : String) is
        use Etape;
        Uneetape : Etape.Etape;
        F : Text_Io.File_Type;
    begin
        Sauvegarderlacteur (F, Lacteurdurole (Unrole));
        Int_Io.Put (F, Lenombredactionsdurole (Unrole));
        Uneetape := Lesetapesdurole (Unrole);
        while Uneetape /= Etape.Etapeinexistante loop
            Sauvegarderletemps (F, Etape.Letempsdeletape (Uneetape));
            Sauvegarderlaction (F, Etape.Lactiondeletape (Uneetape));
            Uneetape := Etape.Lasuitedeletape (Uneetape);
        end loop;
    end Sauvegarderlerole;
end Role;