|
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: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Tir, seg_05c300
└─⟦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 Asteroide;
with Vaisseau;
package body Tir is
Eternel : constant Boolean := False;
Figure : constant Character := 'o';
Nb : Integer := 0;
type T_Tir;
type A_Tir is access T_Tir;
type Internal is
record
Mon_Solide : Solide.Objet;
T : A_Tir;
end record;
package Bd_Tir is new Bd_Jeu (Solide => Objet, No_Solide => null);
task type T_Tir 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_Tir;
task body T_Tir 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.Tir | Gen.Asteroide | 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;
Solide.Modifier (Le_Solide => Moi, Position => Loc_Position);
end if;
end loop;
end T_Tir;
function Creer (Position : in Gen.Tposition) return Objet is
Loc_Tir : Objet := new Internal;
begin
Loc_Tir.Mon_Solide := Solide.Creer (Un_Solide => Loc_Tir,
Position => Position,
Energie => Gen.Tenergie'Last,
Figure => Figure);
Loc_Tir.T := new T_Tir;
Nb := Nb + 1;
Bd_Tir.Inserer (Le_Solide => Loc_Tir, No => Nb);
Loc_Tir.T.Creer (Mon_Solide => Loc_Tir.Mon_Solide,
Sens => Position.Sens);
return Loc_Tir;
end Creer;
function No_Objet return Objet is
begin
return null;
end No_Objet;
procedure Top (Le_Tir : in Objet;
Fin : out Boolean;
Tiers : out Gen.Tgenre;
Position : out Gen.Tposition) is
begin
Le_Tir.T.Top (Fin => Fin, Tiers => Tiers, Position => Position);
end Top;
procedure Collision (Le_Tir : in Objet;
Tiers : in Gen.Tgenre;
Fin : out Boolean) is
begin
Le_Tir.T.Collision (Tiers => Tiers, Fin => Fin);
end Collision;
procedure Detruire (Le_Tir : in out Objet) is
begin
Bd_Tir.Retirer (Le_Solide => Le_Tir);
Le_Tir.T.Detruire;
Le_Tir := null;
end Detruire;
procedure Initialiser is
Un_Tir : Objet;
begin
null;
end Initialiser;
procedure Traiter is
Un_Tir : 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_Tir.Init;
Un_Tir := Bd_Tir.Prendre;
while Un_Tir /= null loop
Top (Le_Tir => Un_Tir,
Tiers => Tiers,
Fin => Fin,
Position => Position);
Bd_Tir.Suivant;
if Fin then
Detruire (Le_Tir => Un_Tir);
Fin := False;
end if;
case Tiers is
when Gen.Asteroide =>
Asteroide_Percutee := Solide.Prendre (Position => Position);
Asteroide.Collision (L_Asteroide => Asteroide_Percutee,
Tiers => Gen.Tir,
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.Tir, 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.Tir,
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.Tir, Fin => Fin);
if Fin then
Base.Detruire (La_Base => Base_Percutee);
end if;
when Gen.Non_Objet =>
null;
end case;
Un_Tir := Bd_Tir.Prendre;
end loop;
end Traiter;
procedure Terminer is
Un_Tir : Objet;
begin
Bd_Tir.Init;
Un_Tir := Bd_Tir.Prendre;
while Un_Tir /= null loop
Tir.Detruire (Le_Tir => Un_Tir);
Un_Tir := Bd_Tir.Prendre;
end loop;
end Terminer;
end Tir;
nblk1=b
nid=0
hdr6=16
[0x00] rec0=24 rec1=00 rec2=01 rec3=03c
[0x01] rec0=1b rec1=00 rec2=02 rec3=03e
[0x02] rec0=01 rec1=00 rec2=0a rec3=00c
[0x03] rec0=15 rec1=00 rec2=09 rec3=074
[0x04] rec0=1b rec1=00 rec2=06 rec3=012
[0x05] rec0=11 rec1=00 rec2=05 rec3=018
[0x06] rec0=22 rec1=00 rec2=04 rec3=010
[0x07] rec0=00 rec1=00 rec2=0b rec3=014
[0x08] rec0=18 rec1=00 rec2=03 rec3=080
[0x09] rec0=13 rec1=00 rec2=08 rec3=052
[0x0a] rec0=14 rec1=00 rec2=07 rec3=001
tail 0x2176b9c0a895c81f3038c 0x42a00088462060003