DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦ed7569a25⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Cellule, seg_05c2f1

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

with Mon_Terminal;  
with Maitre;
package body Cellule is
    type Internal is
        record
            Position : Gen.Tposition;
            Mon_Solide : Solide.Objet;
            Collision : Boolean;
            Figure : Character;  
            Blink : Boolean;
        end record;  
    type Cases is
        record
            Cel_1, Cel_2 : Objet;
        end record;  
    Case_Nulle : constant Cases := (Cel_1 => null, Cel_2 => null);
    Espace : array (Gen.Tcoordonnees, Gen.Tcoordonnees) of Cases;

    function Creer (Pour : in Solide.Objet; Position : in Gen.Tposition)
                   return Objet is
        Loc_Objet : Objet := new Internal;
    begin  
        Loc_Objet.Position := Position;
        Loc_Objet.Mon_Solide := Pour;  
        Loc_Objet.Collision := False;
        return Loc_Objet;
    end Creer;

    function Collision (La_Cellule : in Objet) return Solide.Objet is
        X : Gen.Tcoordonnees renames La_Cellule.Position.X;
        Y : Gen.Tcoordonnees renames La_Cellule.Position.Y;
    begin
        if Espace (X, Y).Cel_1 = La_Cellule then
            if Espace (X, Y).Cel_2 /= null then
                return Espace (X, Y).Cel_2.Mon_Solide;
            else
                return Solide.Non_Solide;
            end if;
        else
            return Espace (X, Y).Cel_1.Mon_Solide;
        end if;
    end Collision;

    procedure Entrer (La_Cellule : in Objet; Position : in Gen.Tposition) is
    begin
        La_Cellule.Position := Position;
        if Espace (Position.X, Position.Y).Cel_1 /= null then
            La_Cellule.Collision := True;
            Espace (Position.X, Position.Y).Cel_2 := La_Cellule;
            Espace (Position.X, Position.Y).Cel_1.Collision := True;
        else
            Espace (Position.X, Position.Y).Cel_1 := La_Cellule;
        end if;
    end Entrer;

    procedure Detruire (La_Cellule : in Objet) is
        X : Gen.Tcoordonnees renames La_Cellule.Position.X;
        Y : Gen.Tcoordonnees renames La_Cellule.Position.Y;
    begin
        if Espace (X, Y).Cel_2 /= null then
            Espace (X, Y).Cel_2.Collision := False;
        end if;
        if Espace (X, Y).Cel_1 = La_Cellule then
            Espace (X, Y).Cel_1 := Espace (X, Y).Cel_2;
        end if;
        Espace (X, Y).Cel_2 := null;
        La_Cellule.Collision := False;
        if Espace (X, Y).Cel_1 = null then
            Afficher (La_Cellule => La_Cellule, Figure => ' ', Blink => False);
        else  
            Afficher (La_Cellule => La_Cellule,
                      Figure => Espace (X, Y).Cel_1.Figure,
                      Blink => Espace (X, Y).Cel_1.Blink);
        end if;
    end Detruire;

    function Position (La_Cellule : in Objet) return Gen.Tposition is
    begin
        return La_Cellule.Position;
    end Position;

    function Prendre (Position : Gen.Tposition) return Solide.Objet is
    begin
        return Espace (Position.X, Position.Y).Cel_1.Mon_Solide;
    end Prendre;

    procedure Afficher (La_Cellule : in Objet;
                        Figure : in Character;
                        Blink : in Boolean) is
    begin  
        La_Cellule.Figure := Figure;
        La_Cellule.Blink := Blink;
        for I in 1 .. Maitre.Dernier_Term loop
            Mon_Terminal.Ecrire (Terminal => Maitre.Terms (I),
                                 C => Figure,
                                 X => La_Cellule.Position.X,
                                 Y => La_Cellule.Position.Y,
                                 Blink => Blink);
        end loop;
    end Afficher;

    procedure Quitter (La_Cellule : in Objet) is
        X : Gen.Tcoordonnees renames La_Cellule.Position.X;
        Y : Gen.Tcoordonnees renames La_Cellule.Position.Y;
    begin
        Detruire (La_Cellule => La_Cellule);
    end Quitter;  
begin
    for I in Gen.Tcoordonnees loop
        for J in Gen.Tcoordonnees loop
            Espace (I, J) := Case_Nulle;
        end loop;
    end loop;
end Cellule;

    nblk1=7
    nid=2
    hdr6=a
        [0x00] rec0=1f rec1=00 rec2=01 rec3=066
        [0x01] rec0=1b rec1=00 rec2=03 rec3=034
        [0x02] rec0=1a rec1=00 rec2=07 rec3=00c
        [0x03] rec0=1b rec1=00 rec2=05 rec3=004
        [0x04] rec0=05 rec1=00 rec2=06 rec3=000
        [0x05] rec0=44 rec1=8a rec2=c7 rec3=575
        [0x06] rec0=c0 rec1=00 rec2=00 rec3=042
    tail 0x2176b9b2c895c81decf36 0x42a00088462060003
Free Block Chain:
  0x2: 0000  00 04 00 61 00 28 20 20 20 20 20 20 20 20 20 20  ┆   a (          ┆
  0x4: 0000  00 00 00 34 80 0f 20 20 20 20 20 20 65 6e 64 20  ┆   4        end ┆