DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 12185 (0x2f99) Types: TextFile Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11 └─ ⟦129cab021⟧ »DATA« └─⟦this⟧
with Etape; with Text_Io; with Formate; with Serial_Io; package body Role is package Int_Io is new Text_Io.Integer_Io (Integer); 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; procedure Executer (Qui : Acteur; Quoi : Etape.Action) is begin if Quoi.Valeur2 = 0 then Serial_Io.Put ('D' & Formate.Inttostr (Qui.Peripherique, 2) & Formate.Inttostr (Qui.Numero_Fonction, 2) & Formate.Inttostr (Quoi.Valeur1, 4) & 'F', "/dev/tty0"); Text_Io.Put ('D' & Formate.Inttostr (Qui.Peripherique, 2) & Formate.Inttostr (Qui.Numero_Fonction, 2) & Formate.Inttostr (Quoi.Valeur1, 4) & 'F'); else Serial_Io.Put ('D' & Formate.Inttostr (Qui.Peripherique, 2) & Formate.Inttostr (Qui.Numero_Fonction, 2) & Formate.Inttostr (Quoi.Valeur1, 4) & Formate.Inttostr (Quoi.Valeur2, 4) & 'F', "/dev/tty0"); Text_Io.Put ('D' & Formate.Inttostr (Qui.Peripherique, 2) & Formate.Inttostr (Qui.Numero_Fonction, 2) & Formate.Inttostr (Quoi.Valeur1, 4) & Formate.Inttostr (Quoi.Valeur2, 4) & 'F'); 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; -- 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; 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); 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; 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; 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; -- 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; end if; end Demarrerlerole; procedure Arreterlerole (Unrole : in out Role) is begin Unrole.Encours := False; end Arreterlerole; procedure Solliciterlerole (Unrole : in out Role; Tempscourant : Integer) is use Etape; Qui : Acteur; Quoi : Etape.Action; begin if Leroleestencours (Unrole) then if Etape.Letempsdeletape (Unrole.Lindex) <= Tempscourant 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; 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;