DataMuseum.dk

top - download

    Length: 14846 (0x39fe)
    Types: TextFile
    Names: »V«

└─⟦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, Text_Io;
package Role is  -- specifications de l'objet role
    subtype Acteur is String (1 .. 50);
    type Descripteurderole is
        record
            Lacteur : Acteur;
            Lesetapes : Etape.Etape;
            Encours : Boolean;
            Ledebut : Etape.Temps;
            Lindex : Etape.Etape;
            Laduree : Etape.Temps;
        end record;
    type Role is access Descripteurderole;

    function Creerunrole (A : Acteur) return Role;
    function Leroleestvide (Unrole : Role) return Boolean;
    function Lacteurdurole (Unrole : Role) return Acteur;
    function Ladureedurole (Unrole : Role) return Etape.Temps;
    function Leroleestencours (Unrole : Role) return Boolean;
    function Lesetapes (Unrole : Role) return Etape.Etape;
    function Quelleactiondurole
                (Unrole : Role; Untemps : Etape.Temps) return Etape.Action;
    procedure Caseruneactiondansunrole (Unrole : Role;
                                        Untemps : Etape.Temps;
                                        Uneaction : Etape.Action);
    procedure Exclureuneactiondansunrole (Unrole : Role; Untemps : Etape.Temps);
    procedure Decaleruneactiondurole
                 (Unrole : Role; Untemps : Etape.Temps; Delai : Integer);
    procedure Deplaceruneactiondurole
                 (Unrole : Role; Untemps : Etape.Temps; Delai : Integer);
    procedure Decalerlerole
                 (Unrole : Role; Untemps : Etape.Temps; Delai : Integer);
    procedure Viderlerole (Unrole : in out Role);
    function Chargerunacteur (F : in Text_Io.File_Type) return Acteur;
    function Chargeruneaction (F : in Text_Io.File_Type) return Etape.Action;
    function Chargeruntemps (F : in Text_Io.File_Type) return Etape.Temps;
    function Chargerunrole (F : in Text_Io.File_Type) return Role;
    procedure Demarrerlerole (Unrole : in out Role);
    procedure Arreterlerole (Unrole : in out Role);
    procedure Jouerlerole (Unrole : Role);
    procedure Solliciterlerole (Unrole : Role);
    procedure Sauvegarderlerole (Unrole : Role; Fichier : String);
end Role;
--  Nom : TD.ADA
--  Auteur : Sebastien BROCHET
--  Date   : 9 Octobre 1993
--  But    : Ce programme illustre quelques TAD
--  conversion en Ada d'un TD ecrit en Pascal
--

--  -------------- Etape ------------------------------

-- Package Objet_Etape is     -- specifications
--   TYPE Temps is INTEGER;
--   TYPE Action is CHARacter;
--   TYPE Etape is access CelluleEtape;
--   TYPE CelluleEtape is RECORD
--                      LeTemps:Temps;
--                  Laction:Action;
--                  LaSuite:Etape;
--                END RECORD;
--
--   FUNCTION CreerUneEtape(UnTemps:temps;UneAction:Action;UneEtape:Etape) return Etape;
--   FUNCTION LeTempsDeLetape(UneEtape:Etape) return Temps;
--   FUNCTION LactionDeLetape(UneEtape:Etape) return Action;
--   FUNCTION LaSuiteDeLetape(UneEtape:Etape) return Etape;
--   PROCEDURE ChangerLeTempsDeLetape(UneEtape: IN OUT Etape;UnTemps:temps);
--   PROCEDURE ChangerLactionDeLetape(UneEtape:IN OUT Etape;UneAction:Action);
--   PROCEDURE CaserUneActionDansLesEtapes(T:temps;A:Action;E:IN OUT Etape);
--   PROCEDURE DetruireEtape(E:IN OUT Etape);
--   PROCEDURE ExclureUneActionDesEtapes(E:IN OUT Etape;T:temps);
-- End Objet_Etape;
--
-- Package body Objet_Etape is
--   EtapeInexistante: constant:= null;
--
-- -- testee
-- FUNCTION CreerUneEtape(UnTemps:temps;UneAction:Action;UneEtape:Etape) return Etape is
-- EtapeAux:Etape;
-- BEGIN
--   EtapeAux:= NEW CelluleEtape;
--     EtapeAux.LeTemps:=UnTemps;
--     EtapeAux.Laction:=UneAction;
--     EtapeAux.LaSuite:=UneEtape;
--   return EtapeAux;
-- END;
--
-- -- testee
-- FUNCTION LeTempsDeLetape(UneEtape:Etape) return Temps is
-- BEGIN
--   return UneEtape.LeTemps;
-- END;
--
-- -- Testee
-- FUNCTION LactionDeLetape(UneEtape:Etape) return Action is
-- BEGIN
--   return UneEtape.Laction;
-- END;
--
-- -- testee
-- FUNCTION LaSuiteDeLetape(UneEtape:Etape) return Etape is
-- BEGIN
--   return UneEtape.LaSuite;
-- END;
--
-- -- testee
-- PROCEDURE ChangerLeTempsDeLetape(UneEtape: IN OUT Etape;UnTemps:temps) is
-- BEGIN
--   UneEtape.LeTemps:=UnTemps;
-- END;
--
-- -- testee
-- PROCEDURE ChangerLactionDeLetape(UneEtape:IN OUT Etape;UneAction:Action) is
-- BEGIN
--   UneEtape.Laction:=UneAction;
-- END;
--
-- -- testee
-- -- rmq : L'etape E qui est retournee est la meme que celle transmise
-- -- elle n'est pas modifiee mais doit etre passee par adresse pour que
-- -- des affectations ( insertions) puissent se faire pdt la recursion arriere
-- PROCEDURE CaserUneActionDansLesEtapes(T:temps;A:Action;E:IN OUT Etape) is
-- BEGIN
--   IF E = EtapeInexistante THEN  -- OK
--      E:=CreerUneEtape(T,A,E)
--   ELSE
--      IF T = LeTempsDeLetape(E) THEN  -- OK
--         ChangerLactionDeLetape(E,A)
--      ELSE
--     IF T > LeTempsDeLetape(E) THEN -- OK
--            CaserUneActionDansLesEtapes(T,A,E^.LaSuite)
--         ELSE
--        E:=CreerUneEtape(T,A,E);    -- OK
-- END;
--
-- -- testee
-- PROCEDURE DetruireEtape(E:IN OUT Etape) is
-- BEGIN
--   DISPOSE(E);
--   E:=EtapeInexistante;
-- END;
--
-- -- testee
-- PROCEDURE ExclureUneActionDesEtapes(E:IN OUT Etape;T:temps) is
-- A_Jeter:Etape;
-- BEGIN
--   IF E != EtapeInexistante THEN  -- OK
--   BEGIN
--     IF T = LeTempsDeLetape(E) THEN
--     BEGIN
--       A_Jeter:=E;
--       E:=E.LaSuite;
--       DetruireEtape(A_Jeter);   -- OK
--     END
--     ELSE
--        IF T > LeTempsDeLetape(E) THEN  -- OK
--       ExclureUneActionDesEtapes(E.LaSuite,T);
--   END;
-- END;
-- END Objet_Etape;
--
-- -- ---------   Role -------------------------------------
--
-- Package Objet_Role is  -- specifications de l'objet role
-- FUNCTION CreerUnRole(A:Acteur) retunr Role is
-- FUNCTION LeRoleEstVide(UnRole:Role) return BOOLEAN is
-- FUNCTION LacteurDuRole(UnRole:Role)return Acteur is
-- FUNCTION LaDureeDuRole(UnRole:Role) return Temps is
-- FUNCTION LeRoleEstEnCours(UnRole:Role) return BOOLEAN is
-- FUNCTION LesEtapes(UnRole:Role) return Etape is
-- FUNCTION QuelleActionDuRole(UnRole:Role;UnTemps:Temps) return Action is
-- PROCEDURE CaserUneActionDansUnRole(UnRole:Role;UnTemps:Temps;UneAction:Action) is
-- PROCEDURE ExclureUneActionDansUnRole(UnRole:Role;UnTemps:Temps) is
-- PROCEDURE DecalerUneActionDuRole(UnRole:Role;UnTemps:Temps;delai:INTEGER) is
-- PROCEDURE DeplacerUneActionDuRole(UnRole:Role;UnTemps:Temps;delai:INTEGER) is
-- PROCEDURE DecalerLeRole(UnRole:Role;UnTemps:Temps;delai:INTEGER) is
-- PROCEDURE ViderLeRole(UnRole:IN OUT Role) is
-- FUNCTION ChargerUnActeur(F:IN OUT TEXT) return Acteur is
-- FUNCTION ChargerUneAction(F:IN OUT TEXT) return Action is
-- FUNCTION ChargerUnTemps(F:IN OUT TEXT) return Temps is
-- FUNCTION ChargerUnRole(F:IN OUT TEXT) return Role is
-- PROCEDURE DemarrerLeRole(UnRole:IN OUT Role) is
-- PROCEDURE ArreterLeRole(UnRole:IN OUT Role) is
-- PROCEDURE JouerLeRole(UnRole:Role) is
-- PROCEDURE SolliciterLeRole(UnRole:Role) is
-- PROCEDURE SauvegarderLeRole(UnRole:Role;Fichier:STRING) is
-- END Objet_Role;
--
--
-- Package body Objet_Role is
--
-- TYPE Acteur is STRING;
-- TYPE DescripteurDeRole is RECORD
--                            Lacteur:Acteur;
--                            LesEtapes:Etape;
--                            EnCours:BOOLEAN;
--                            LeDebut:Temps;
--                            Lindex:Etape;
--                            LaDuree:Temps;
--              END RECORD;
-- TYPE Role is access DescripteurDeRole;
--
-- FUNCTION CreerUnRole(A:Acteur) retunr Role is
-- Resultat:Role;
-- BEGIN
--   Resultat:=NEW Role;
--     Resultat.Lacteur:=A;
--     Resultat.LesEtapes:=EtapeInexistante;
--     Resultat.EnCours:=FALSE;
--     Resultat.LeDebut:=0;
--     Resultat.Lindex:=EtapeInexistante;
--     Resultat.LaDuree:=0;
--   return Resultat;
-- END;
--
-- FUNCTION LeRoleEstVide(UnRole:Role) return BOOLEAN is
-- BEGIN
--   return (UnRole.LesEtapes=EtapeInexistante);
-- END;
--
-- FUNCTION LacteurDuRole(UnRole:Role)return Acteur is
-- BEGIN
--   return UnRole.Lacteur;
-- END;
--
-- FUNCTION LaDureeDuRole(UnRole:Role) return Temps is
-- BEGIN
--   return UnRole.LaDuree;
-- END;
--
-- FUNCTION LeRoleEstEnCours(UnRole:Role) return BOOLEAN is
-- BEGIN
--   return (UnRole.EnCours=TRUE);
-- END;
--
-- FUNCTION LesEtapes(UnRole:Role) return Etape is
-- BEGIN
--   return UnRole.LesEtapes;
-- END;
--
-- FUNCTION QuelleActionDuRole(UnRole:Role;UnTemps:Temps) return Action is
-- indexRole:Etape;
-- Trouve:BOOLEAN:=FALSE;
-- BEGIN
--   IndexRole:=LesEtapes(UnRole);
--   WHILE (IndexRole<>EtapeInexistante) AND (NOT TROUVE) DO
--   BEGIN
--     IF LeTempsDeLetape(IndexRole)=UnTemps THEN
--     BEGIN
--       Trouve:=TRUE;
--       QuelleActionDuRole:=LactionDeLetape(IndexRole);
--     END;
--     IndexRole:=LaSuiteDeLetape(IndexRole);
--   END;
-- END;
--
-- PROCEDURE CaserUneActionDansUnRole(UnRole:Role;UnTemps:Temps;UneAction:Action) is
-- E:Etape;
-- BEGIN
--   E:=LesEtapes(UnRole);
--   CaserUneActionDansLesEtapes(UnTemps,UneAction,E);
-- END;
--
-- PROCEDURE ExclureUneActionDansUnRole(UnRole:Role;UnTemps:Temps) is
-- E:Etape;
-- BEGIN
--   E:=LesEtapes(UnRole);
--   ExclureUneActionDesEtapes(E,UnTemps);
-- END;
--
-- PROCEDURE DecalerUneActionDuRole(UnRole:Role;UnTemps:Temps;delai:INTEGER) is
-- BEGIN
--   null;
-- END;
--
-- PROCEDURE DeplacerUneActionDuRole(UnRole:Role;UnTemps:Temps;delai:INTEGER) is
-- BEGIN
--   null;
-- END;
--
-- PROCEDURE DecalerLeRole(UnRole:Role;UnTemps:Temps;delai:INTEGER) is
-- BEGIN
--   null;
-- END;
--
-- PROCEDURE ViderLeRole(UnRole:IN OUT Role) is
-- BEGIN
--   UnRole.LesEtapes:=EtapeInexistante;
-- END;
--
-- FUNCTION ChargerUnActeur(F:IN OUT TEXT) return Acteur is
-- ActAux:Acteur;
-- BEGIN
--   READLN(F,ActAux);
--   return ActAux;
-- END;
--
-- FUNCTION ChargerUneAction(F:IN OUT TEXT) return Action is
-- ActionAux:Action;
-- BEGIN
--   READLN(F,ActionAux);
--   return ActionAux;
-- END;
--
-- FUNCTION ChargerUnTemps(F:IN OUT TEXT) return Temps is
-- TempsAux:Temps;
-- BEGIN
--   READLN(F,TempsAux);
--   return TempsAux;
-- END;
--
-- FUNCTION ChargerUnRole(F:IN OUT TEXT) return Role is
-- UnRole:Role;UnActeur:Acteur;
-- UneAction:Action;UnTemps:Temps;
-- Nombre:INTEGER;
-- BEGIN
--   UnActeur:=ChargerUnActeur(F);
--   UnRole:=CreerUnRole(UnActeur);
--   READLN(F,Nombre);
--   FOR i IN 1..Nombre LOOP
--     UneAction:=ChargerUneAction(F);
--     UnTemps:=ChargerUnTemps(F);
--     CaserUneActionDansUnRole(UnRole,UnTemps,UneAction);
--   END LOOP;
--   return UnRole;
-- END;
--
-- PROCEDURE DemarrerLeRole(UnRole:IN OUT Role) is
-- IndiceRole:Role;
-- BEGIN
--   IndiceRole:=UnRole;
--   IndiceRole.EnCours:=TRUE;
--   IF IndiceRole.Etape!='' THEN
--     BEGIN
--       Text_IO.PutLine("Acteur = ",IndiceRole.Laction);
--       IndiceRole.Etape:=IndiceRole.Etape.LaSuite;
--     END;
-- END;
--
-- PROCEDURE ArreterLeRole(UnRole:IN OUT Role) is
-- BEGIN
--   null;
-- END;
--
-- PROCEDURE JouerLeRole(UnRole:Role) is
-- BEGIN
--   null;
-- END;
--
-- PROCEDURE SolliciterLeRole(UnRole:Role) is
-- BEGIN
--   null;
-- END;
--
-- PROCEDURE SauvegarderLeRole(UnRole:Role;Fichier:STRING) is
-- F:TEXT;
-- BEGIN
--   ASSIGN(F,Fichier);
--   APPEND(F);
--   SauverUnActeur(F,UnRole);
-- END;
-- END Objet_Role;
--
--
-- -- Programme principal
--
-- deb,E,debut:Etape;
-- R:Role;
--
-- PROCEDURE Affiche(E:Etape) is
-- UnTemps:Temps;
-- UneAction:Action;
-- BEGIN
--   IF E!=EtapeInexistante THEN
--   BEGIN
--     UnTemps:=LeTempsDeLetape(E);
--     UneAction:=LactionDeLetape(E);
--     WRITELN('Temps : ',UnTemps,' Action : ',UneAction);
--   END
--   ELSE
--   Text_IO.PutLine("Pointeur NIL , erreur");
-- END;
--
-- BEGIN
-- -- TEST des methodes liees a l'objet Etape
--   WRITELN;
--   deb:=CreerUneEtape(1,'S',EtapeInexistante);
--   Affiche(deb);
--   ChangerLeTempsDeLetape(deb,4);
--   ChangerLactionDeLetape(deb,'T');
--   Affiche(deb);
--   deb:=CreerUneEtape(3,'U',deb);
--   Affiche(deb);
--   debut:=deb;
--   deb:=LaSuiteDeLetape(deb);
--   Affiche(deb);
--   E:=EtapeInexistante;
--   CaserUneActionDansLesEtapes(9,'d',E);  -- Inexistante OK
--   Affiche(E);
--   CaserUneActionDansLesEtapes(2,'h',deb);  -- avant , OK
--   Affiche(deb);
--   CaserUneActionDansLesEtapes(2,'k',deb);  -- temps = , OK
--   Affiche(deb);
--   CaserUneActionDansLesEtapes(3,'z',deb);  -- apres
--   Affiche(deb);
--   deb:=LaSuiteDeLetape(deb);
--   Affiche(deb);
--   DetruireEtape(deb);
--   Affiche(deb);
--   E:=EtapeInexistante;
--   ExclureUneActionDesEtapes(E,15);   --  Inexistante
--   Affiche(E);
--   ExclureUneActionDesEtapes(debut,15);   --  T > , OK
--   Affiche(debut);
--   ExclureUneActionDesEtapes(debut,1);   --  T < , OK
--   Affiche(debut);
--   ExclureUneActionDesEtapes(debut,3);   --  T = , OK
--   Affiche(debut);
--
--   -- TEST des methodes liees a l'objet Role
--   -- R:=CreerUnRole('b');
-- END;
-- -- test du package generique Pile
-- -- Auteur : Sebastien BROCHET
-- -- Date   : 28 Octobre 1993
--
-- With Pile;
-- procedure test is
--
-- package Pile_Int is new Pile(Element => integer;Taille => 20);
-- package Pile_Char is new Pile(Element => character;Taille => 20);
-- begin
--   null;
-- end test;
-- -- Test du package generique fifo
-- -- auteur : Sebastien BROCHET
-- -- date   : 3 Novembre 1993
--
-- With Fifo,Text_IO;
-- procedure TestFifo is
-- caractere:character:='s';
-- package FifoChar is new Fifo(Element=> character);
-- Ma_Fifo:FifoChar.Object;
-- begin
--   Ma_Fifo:=FifoChar.EmptyFifo;
--   loop
--     Text_IO.Put_Line("<1> Enfiler un caractere");
--     Text_IO.Put_Line("<2> Defiler un caractere");
--     Text_IO.Put_Line("<9> Quitter");
--     Text_IO.Put("Votre choix : ");
--     Text_IO.Get(caractere);
--     case caractere is
--       when '1'=> Text_IO.Put("Entrer un caractere : ");
--          Text_IO.Get(caractere);
--          FifoChar.EnQueue(Ma_Fifo,caractere);
--          Text_IO.New_Line;
--       when '2'=> FifoChar.DeQueue(Ma_Fifo,caractere);
--          Text_IO.Put_Line("Caractere extrait : " & caractere);
--       when others => null;
--     end case;
--   exit when caractere='9';
--   end loop;
-- end TestFifo;
-- -- fichier : TestLex.ada
-- -- Test du package LEX pour l'analyse lexicale
-- -- auteur : Sebastien BROCHET
-- -- date   : 31 octobre 1993
--
-- With LEX,TEXT_IO;
-- procedure TestLex is
-- aFile:INTEGER:=1;   -- a modifer avec TEXT_IO.File_Type
-- begin
--   TEXT_IO.Put_Line("Entrer une chaine de caracteres : ");
--   LEX.LexOpen(aFile);
--   loop
--     LEX.LexNext;
--     Text_IO.Put_Line(LEX.CurrentValue);
--     Text_IO.Put_Line(LEX.Token'image(LEX.CurrentToken));
--     exit when TEXT_IO.End_Of_File;
--   end loop;
-- end TestLex;
-- With Text_IO;Use Text_IO;
-- procedure exemple is
-- begin
--   Put_Line("Table de multiplication : ");
--   for i in 1..10 loop
--     Put_Line
--   end loop;
-- end;