|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 13312 (0x3400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Asteroide, seg_05c2eb
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Bd_Jeu;
with Services;
with Gen;
use Gen;
with Solide;
with Maitre;
with Base;
with Tir;
with Vaisseau;
package body Asteroide is
Eternel : constant Boolean := True;
Figure : constant Character := '*';
Nb : Integer := 0;
type T_Asteroide;
type A_Asteroide is access T_Asteroide;
type Internal is
record
Mon_Solide : Solide.Objet;
T : A_Asteroide;
end record;
package Bd_Asteroide is new Bd_Jeu (Solide => Objet, No_Solide => null);
task type T_Asteroide is
entry Creer (Mon_Solide : in Solide.Objet; Sens : in Gen.Tsens);
entry Collision (Tiers : in Gen.Tgenre; Fin : out Boolean);
entry Top (Fin : out Boolean;
Tiers : out Gen.Tgenre;
Position : out Gen.Tposition);
entry Detruire;
end T_Asteroide;
task body T_Asteroide is
Moi : Solide.Objet;
Loc_Tiers : Gen.Tgenre := Gen.Non_Objet;
Loc_Fin, En_Vie : Boolean := True;
Loc_Sens : Gen.Tsens;
Loc_Position : Gen.Tposition;
Limite : Boolean;
procedure Traiter_Collision
(Tiers : in Gen.Tgenre; Fin : out Boolean) is
begin
case Tiers is
when Gen.Vaisseau | Gen.Asteroide | Gen.Tir | Gen.Base =>
Fin := True;
when Gen.Non_Objet =>
Fin := False;
end case;
end Traiter_Collision;
begin
accept Creer (Mon_Solide : in Solide.Objet; Sens : in Gen.Tsens) do
Moi := Mon_Solide;
Loc_Sens := Sens;
end Creer;
while En_Vie loop
Solide.Afficher (Le_Solide => Moi);
select
accept Collision (Tiers : in Gen.Tgenre; Fin : out Boolean) do
Traiter_Collision (Tiers => Tiers, Fin => Loc_Fin);
if Eternel then
Fin := False;
else
Fin := Loc_Fin;
end if;
end Collision;
or
accept Top (Fin : out Boolean;
Tiers : out Gen.Tgenre;
Position : out Gen.Tposition) do
if Eternel then
Loc_Fin := False;
end if;
Position := Gen.Position_Nulle;
Loc_Tiers := Gen.Non_Objet;
Solide.Deplacer_Limite (Le_Solide => Moi,
Sens => Loc_Sens,
Limite => Limite,
Tiers => Loc_Tiers,
Position => Position);
if Limite then
Loc_Fin := True;
else
Traiter_Collision (Tiers => Loc_Tiers, Fin => Loc_Fin);
end if;
if Eternel then
Fin := False;
else
Fin := Loc_Fin;
end if;
Tiers := Loc_Tiers;
end Top;
or
accept Detruire do
Solide.Detruire (Le_Solide => Moi);
En_Vie := False;
end Detruire;
end select;
if Eternel and Loc_Fin then
Loc_Position := Services.Pos_Random;
Loc_Sens := Loc_Position.Sens;
Solide.Modifier (Le_Solide => Moi, Position => Loc_Position);
end if;
end loop;
end T_Asteroide;
function Creer (Position : in Gen.Tposition) return Objet is
Loc_Asteroide : Objet := new Internal;
begin
Loc_Asteroide.Mon_Solide := Solide.Creer (Un_Solide => Loc_Asteroide,
Position => Position,
Energie => Gen.Tenergie'Last,
Figure => Figure);
Loc_Asteroide.T := new T_Asteroide;
Nb := Nb + 1;
Bd_Asteroide.Inserer (Le_Solide => Loc_Asteroide, No => Nb);
Loc_Asteroide.T.Creer (Mon_Solide => Loc_Asteroide.Mon_Solide,
Sens => Position.Sens);
return Loc_Asteroide;
end Creer;
procedure Top (L_Asteroide : in Objet;
Tiers : out Gen.Tgenre;
Fin : out Boolean;
Position : out Gen.Tposition) is
begin
L_Asteroide.T.Top (Fin => Fin, Tiers => Tiers, Position => Position);
end Top;
procedure Collision (L_Asteroide : in Objet;
Tiers : in Gen.Tgenre;
Fin : out Boolean) is
begin
L_Asteroide.T.Collision (Tiers => Tiers, Fin => Fin);
end Collision;
procedure Detruire (L_Asteroide : in out Objet) is
begin
Bd_Asteroide.Retirer (Le_Solide => L_Asteroide);
L_Asteroide.T.Detruire;
L_Asteroide := null;
end Detruire;
procedure Initialiser is
Un_Asteroide : Objet;
begin
for Nb in 1 .. Maitre.Nb_Asteroide loop
Un_Asteroide := Creer (Position => Services.Pos_Random);
end loop;
end Initialiser;
procedure Traiter is
Un_Asteroide : Objet;
Asteroide_Percutee : Asteroide.Objet;
Base_Percutee : Base.Objet;
Tir_Percute : Tir.Objet;
Vaisseau_Percute : Vaisseau.Objet;
Tiers : Gen.Tgenre;
Fin : Boolean;
Position : Gen.Tposition;
begin
Bd_Asteroide.Init;
Un_Asteroide := Bd_Asteroide.Prendre;
while Un_Asteroide /= null loop
Top (L_Asteroide => Un_Asteroide,
Tiers => Tiers,
Fin => Fin,
Position => Position);
Bd_Asteroide.Suivant;
if Fin then
Detruire (L_Asteroide => Un_Asteroide);
Fin := False;
end if;
case Tiers is
when Gen.Asteroide =>
Asteroide_Percutee := Solide.Prendre (Position => Position);
Asteroide.Collision (L_Asteroide => Asteroide_Percutee,
Tiers => Gen.Asteroide,
Fin => Fin);
if Fin then
Asteroide.Detruire (L_Asteroide => Asteroide_Percutee);
end if;
when Gen.Tir =>
Tir_Percute := Solide.Prendre (Position => Position);
Tir.Collision (Le_Tir => Tir_Percute,
Tiers => Gen.Asteroide,
Fin => Fin);
if Fin then
Tir.Detruire (Le_Tir => Tir_Percute);
end if;
when Gen.Vaisseau =>
Vaisseau_Percute := Solide.Prendre (Position => Position);
Vaisseau.Collision (Le_Vaisseau => Vaisseau_Percute,
Tiers => Gen.Asteroide,
Fin => Fin);
if Fin then
Vaisseau.Detruire (Le_Vaisseau => Vaisseau_Percute);
end if;
when Gen.Base =>
Base_Percutee := Solide.Prendre (Position => Position);
Base.Collision (La_Base => Base_Percutee,
Tiers => Gen.Asteroide,
Fin => Fin);
if Fin then
Base.Detruire (La_Base => Base_Percutee);
end if;
when Gen.Non_Objet =>
null;
end case;
Un_Asteroide := Bd_Asteroide.Prendre;
end loop;
end Traiter;
procedure Terminer is
Un_Asteroide : Objet;
begin
Bd_Asteroide.Init;
Un_Asteroide := Bd_Asteroide.Prendre;
while Un_Asteroide /= null loop
Asteroide.Detruire (L_Asteroide => Un_Asteroide);
Un_Asteroide := Bd_Asteroide.Prendre;
end loop;
end Terminer;
end Asteroide;
nblk1=c
nid=c
hdr6=16
[0x00] rec0=22 rec1=00 rec2=01 rec3=046
[0x01] rec0=1b rec1=00 rec2=07 rec3=02a
[0x02] rec0=00 rec1=00 rec2=09 rec3=008
[0x03] rec0=16 rec1=00 rec2=08 rec3=030
[0x04] rec0=1b rec1=00 rec2=03 rec3=030
[0x05] rec0=09 rec1=00 rec2=04 rec3=032
[0x06] rec0=1f rec1=00 rec2=05 rec3=01c
[0x07] rec0=1b rec1=00 rec2=02 rec3=096
[0x08] rec0=13 rec1=00 rec2=06 rec3=02e
[0x09] rec0=19 rec1=00 rec2=0a rec3=040
[0x0a] rec0=04 rec1=00 rec2=0b rec3=001
[0x0b] rec0=0a rec1=00 rec2=00 rec3=000
tail 0x2176b9ad2895c81d6be48 0x42a00088462060003
Free Block Chain:
0xc: 0000 00 00 00 1f 80 08 65 72 6d 69 6e 65 72 3b 08 00 ┆ erminer; ┆