|
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: 15360 (0x3c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Solide, seg_05c1ae
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Gen;
use Gen;
with Maitre;
with Cellule;
with Services;
with Mon_Terminal;
package body Solide is
No_Solide : Integer := 0;
type Enfant (Genre : Gen.Tgenre := Gen.Non_Objet) is
record
case Genre is
when Gen.Asteroide =>
O_A : Asteroide.Objet;
when Gen.Tir =>
O_T : Tir.Objet;
when Gen.Base =>
O_B : Base.Objet;
when Gen.Vaisseau =>
O_V : Vaisseau.Objet;
when Gen.Non_Objet =>
null;
end case;
end record;
type Internal is
record
Ma_Cellule : Cellule.Objet;
Energie : Gen.Tenergie;
Figure : Character;
X : Gen.Tcoordonnees;
Mon_Enfant : Enfant;
end record;
procedure Afficher_Energie (De : in Objet) is
begin
for T in 1 .. Maitre.Dernier_Term loop
Maitre.Ecrire
(S => " ", X => De.X, Y => Maitre.Last_Y, T => T);
Maitre.Ecrire
(S => De.Figure & ": " & Gen.Tenergie'Image (De.Energie),
X => De.X,
Y => Maitre.Last_Y,
T => T);
end loop;
end Afficher_Energie;
function Creer (Mon_Enfant : in Enfant;
Position : in Gen.Tposition;
Energie : in Gen.Tenergie;
Figure : Character) return Objet is
Loc_Solide : Objet := new Internal;
begin
Loc_Solide.Ma_Cellule := Cellule.Creer
(Pour => Loc_Solide, Position => Position);
Loc_Solide.Energie := Energie;
Loc_Solide.Figure := Figure;
Loc_Solide.Mon_Enfant := Mon_Enfant;
Cellule.Entrer (La_Cellule => Loc_Solide.Ma_Cellule,
Position => Position);
if Mon_Enfant.Genre = Gen.Vaisseau then
No_Solide := No_Solide + 1;
Loc_Solide.X := No_Solide * 8;
Afficher_Energie (De => Loc_Solide);
elsif Mon_Enfant.Genre = Gen.Base then
No_Solide := No_Solide + 1;
Loc_Solide.X := 1;
Afficher_Energie (De => Loc_Solide);
end if;
return Loc_Solide;
end Creer;
function Creer (Un_Solide : in Vaisseau.Objet;
Position : in Gen.Tposition;
Energie : in Gen.Tenergie;
Figure : in Character) return Objet is
Mon_Enfant : Enfant (Genre => Gen.Vaisseau);
begin
Mon_Enfant.O_V := Un_Solide;
return Creer (Position => Position,
Energie => Energie,
Figure => Figure,
Mon_Enfant => Mon_Enfant);
end Creer;
function Creer (Un_Solide : in Asteroide.Objet;
Position : in Gen.Tposition;
Energie : in Gen.Tenergie;
Figure : in Character) return Objet is
Mon_Enfant : Enfant (Genre => Gen.Asteroide);
begin
Mon_Enfant.O_A := Un_Solide;
return Creer (Position => Position,
Energie => Energie,
Figure => Figure,
Mon_Enfant => Mon_Enfant);
end Creer;
function Creer (Un_Solide : in Tir.Objet;
Position : in Gen.Tposition;
Energie : in Gen.Tenergie;
Figure : in Character) return Objet is
Mon_Enfant : Enfant (Genre => Gen.Tir);
begin
Mon_Enfant.O_T := Un_Solide;
return Creer (Position => Position,
Energie => Energie,
Figure => Figure,
Mon_Enfant => Mon_Enfant);
end Creer;
function Creer (Un_Solide : in Base.Objet;
Position : in Gen.Tposition;
Energie : in Gen.Tenergie;
Figure : in Character) return Objet is
Mon_Enfant : Enfant (Genre => Gen.Base);
begin
Mon_Enfant.O_B := Un_Solide;
return Creer (Position => Position,
Energie => Energie,
Figure => Figure,
Mon_Enfant => Mon_Enfant);
end Creer;
procedure Modifier (Le_Solide : in Objet; Position : in Gen.Tposition) is
begin
Cellule.Quitter (La_Cellule => Le_Solide.Ma_Cellule);
Cellule.Entrer (La_Cellule => Le_Solide.Ma_Cellule,
Position => Position);
end Modifier;
procedure Deplacer (Le_Solide : in Objet;
Sens : in Gen.Tsens;
Limites : in Boolean := False;
Limite : out Boolean;
Tiers : out Gen.Tgenre;
Position : out Gen.Tposition) is
Loc_Collision : Gen.Tgenre := Gen.Non_Objet;
Loc_Position : Gen.Tposition := Cellule.Position (Le_Solide.Ma_Cellule);
Hors_Ecran : Boolean;
Autre_Solide : Objet;
begin
Cellule.Quitter (La_Cellule => Le_Solide.Ma_Cellule);
Services.Calculer
(Position => Loc_Position, Sens => Sens, Hors_Ecran => Hors_Ecran);
if Limites and Hors_Ecran then
Limite := True;
else
Limite := False;
Cellule.Entrer (La_Cellule => Le_Solide.Ma_Cellule,
Position => Loc_Position);
Autre_Solide := Cellule.Collision (Le_Solide.Ma_Cellule);
if Autre_Solide = null then
Loc_Collision := Gen.Non_Objet;
else
Loc_Collision := Autre_Solide.Mon_Enfant.Genre;
end if;
end if;
Tiers := Loc_Collision;
Position := Loc_Position;
end Deplacer;
function Non_Solide return Objet is
begin
return null;
end Non_Solide;
procedure Deplacer (Le_Solide : in Objet;
Sens : in Gen.Tsens;
Tiers : out Gen.Tgenre;
Position : out Gen.Tposition) is
Limite : Boolean;
begin
Deplacer (Le_Solide => Le_Solide,
Sens => Sens,
Limites => False,
Limite => Limite,
Tiers => Tiers,
Position => Position);
end Deplacer;
procedure Deplacer_Limite (Le_Solide : in Objet;
Sens : in Gen.Tsens;
Limite : out Boolean;
Tiers : out Gen.Tgenre;
Position : out Gen.Tposition) is
begin
Deplacer (Le_Solide => Le_Solide,
Sens => Sens,
Limites => True,
Limite => Limite,
Tiers => Tiers,
Position => Position);
end Deplacer_Limite;
procedure Doper (Le_Solide : in Objet; Energie : in Gen.Tenergie) is
begin
if Gen.Tenergie'Last - Le_Solide.Energie < Energie then
Le_Solide.Energie := Gen.Tenergie'Last;
else
Le_Solide.Energie := Le_Solide.Energie + Energie;
end if;
Afficher_Energie (De => Le_Solide);
end Doper;
procedure Vider (Le_Solide : in Objet; Energie : in Gen.Tenergie) is
begin
if Le_Solide.Energie < Energie then
Le_Solide.Energie := Gen.Tenergie'First;
else
Le_Solide.Energie := Le_Solide.Energie - Energie;
end if;
Afficher_Energie (De => Le_Solide);
end Vider;
function Vide (Le_Solide : in Objet) return Boolean is
begin
if Le_Solide.Energie = Gen.Tenergie'First then
return True;
else
return False;
end if;
end Vide;
function Position (Le_Solide : in Objet) return Gen.Tposition is
begin
return Cellule.Position (Le_Solide.Ma_Cellule);
end Position;
function Prendre (Position : Gen.Tposition) return Asteroide.Objet is
begin
return Cellule.Prendre (Position => Position).Mon_Enfant.O_A;
end Prendre;
function Prendre (Position : Gen.Tposition) return Base.Objet is
begin
return Cellule.Prendre (Position => Position).Mon_Enfant.O_B;
end Prendre;
function Prendre (Position : Gen.Tposition) return Tir.Objet is
begin
return Cellule.Prendre (Position => Position).Mon_Enfant.O_T;
end Prendre;
function Prendre (Position : Gen.Tposition) return Vaisseau.Objet is
begin
return Cellule.Prendre (Position => Position).Mon_Enfant.O_V;
end Prendre;
procedure Afficher (Le_Solide : in Objet) is
Blink : Boolean;
begin
if Le_Solide.Energie < Maitre.Alerte_Energie then
Blink := True;
else
Blink := False;
end if;
Cellule.Afficher (La_Cellule => Le_Solide.Ma_Cellule,
Figure => Le_Solide.Figure,
Blink => Blink);
end Afficher;
procedure Detruire (Le_Solide : in out Objet) is
begin
Cellule.Detruire (La_Cellule => Le_Solide.Ma_Cellule);
end Detruire;
end Solide;
nblk1=e
nid=e
hdr6=1a
[0x00] rec0=27 rec1=00 rec2=01 rec3=00c
[0x01] rec0=16 rec1=00 rec2=06 rec3=04e
[0x02] rec0=03 rec1=00 rec2=04 rec3=002
[0x03] rec0=19 rec1=00 rec2=0c rec3=05c
[0x04] rec0=03 rec1=00 rec2=0d rec3=00e
[0x05] rec0=19 rec1=00 rec2=08 rec3=056
[0x06] rec0=18 rec1=00 rec2=03 rec3=020
[0x07] rec0=1d rec1=00 rec2=0b rec3=014
[0x08] rec0=1a rec1=00 rec2=09 rec3=022
[0x09] rec0=1e rec1=00 rec2=02 rec3=00a
[0x0a] rec0=03 rec1=00 rec2=0a rec3=000
[0x0b] rec0=1b rec1=00 rec2=05 rec3=004
[0x0c] rec0=0b rec1=00 rec2=07 rec3=000
[0x0d] rec0=0b rec1=00 rec2=07 rec3=000
tail 0x2176b68a889594210ea30 0x42a00088462060003
Free Block Chain:
0xe: 0000 00 00 00 04 80 01 20 01 02 03 04 05 06 20 20 20 ┆ ┆