|
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: 8483 (0x2123)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Etape;
with Role;
with Text_Io;
with Tic;
package body Scene is
package Int_Io is new Text_Io.Integer_Io (Integer);
Tempsderniereaction : Natural := 0;
Chronocourant : Integer := 0;
Ticrate : Duration := 0.1; -- lie a Bitbus
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;
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.Temps := Untemps;
if Untemps > Tempsderniereaction then
Tempsderniereaction := Untemps;
end if;
Uneoperation.Acteur := Unacteur;
Uneoperation.Action := Uneaction;
return Uneoperation;
end Chargeruneoperation;
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;
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;
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;
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;
-- 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;
-- on travaille sur un role particulier :
-- UneScene.Contenu(Indice_Scripte).Contenu(Indice_Role)
-- Inserer Action dans une etape de l'acteur avec UnTemps comme clef
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 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;
Tic.Setticrate (Ticrate); -- par defaut TicRate = 0.1 s
while Chronocourant <= Tempsderniereaction loop
Tic.Starttic;
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), Chronocourant);
end if;
end loop;
end loop;
Tic.Waitfortic; -- attente bloquante
Chronocourant := Chronocourant + Integer (10 * Ticrate);
-- TicRate en s , Chrono courant en 1/10 de s
end loop;
end Jouerunescene;
end Scene;