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

⟦ccc2b9b48⟧ Ada Source

    Length: 7168 (0x1c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Magique, seg_04d075

Derivation

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

with Io;  
with Text_Io;
package body Magique is
    procedure Initialiser (Damier : in out Tdamier;
                           Courant : in out Tjeton;
                           Compteur : in out Tcompteur) is
    begin
        Damier := (1 .. Cases => (1 .. Cases => 0));
        Compteur := 1;
        Courant.X := ((Cases - 1) / 2) + 1;
        Courant.Y := ((Cases - 1) / 2) + 2;
        Damier (Courant.X, Courant.Y) := Compteur;
    end Initialiser;

    function Correction (Courant : Tjeton) return Tjeton is
        Retour : Tjeton;
    begin  
        Retour.X := Courant.X;
        Retour.Y := Courant.Y;
        if Courant.X = 0 then
            Retour.X := Cases;
        end if;
        if Courant.X = (Cases + 1) then
            Retour.X := 1;
        end if;
        if Courant.Y = (Cases + 1) then
            Retour.Y := 1;
        end if;  
        return Retour;
    end Correction;


    function Avance_Gauche (Courant : Tjeton) return Tjeton is
        Retour : Tjeton;
    begin
        Retour.X := T_Nb_Case'Pred (Courant.X);
        Retour.Y := T_Nb_Case'Succ (Courant.Y);
        return Correction (Courant => Retour);
    end Avance_Gauche;


    procedure Est_Ce_Occupe (Damier : in out Tdamier;
                             Courant : in out Tjeton) is
    begin  
        while (Damier (Courant.X, Courant.Y) /= 0) loop
            Courant := Avance_Gauche (Courant);
        end loop;
    end Est_Ce_Occupe;


    function Avance_Droit (Courant : Tjeton) return Tjeton is
        Retour : Tjeton;
    begin
        Retour.X := T_Nb_Case'Succ (Courant.X);
        Retour.Y := T_Nb_Case'Succ (Courant.Y);
        return Correction (Courant => Retour);
    end Avance_Droit;


    procedure Placer (Damier : in out Tdamier;
                      Courant : Tjeton;
                      Compteur : Tcompteur) is
    begin
        Damier (Courant.X, Courant.Y) := Compteur;
    end Placer;

    function Fin (Compteur : Tcompteur) return Boolean is
    begin
        return (Compteur /= Tcompteur'Last);
    end Fin;

    procedure Afficher (Damier : Tdamier) is
        I, J : Integer;           --????integer
    begin
        Io.Put ("   Carre Magique ");
        Io.New_Line;
        for J in reverse 1 .. Cases loop
            for I in 1 .. Cases loop  
                Io.Put (Tcompteur'Image (Damier (I, J)));
                Io.Put (" ");
            end loop;
            Io.New_Line;
        end loop;
    end Afficher;

    procedure Lancer_Magique is
        Damier : Tdamier;
        Compteur : Tcompteur;
        Courant : Tjeton;
    begin
        Initialiser (Damier => Damier,
                     Courant => Courant,
                     Compteur => Compteur);
        while (Compteur /= Tcompteur'Last) loop
            Courant := Avance_Droit (Courant => Courant);
            Est_Ce_Occupe (Damier => Damier, Courant => Courant);
            Compteur := Tcompteur'Succ (Compteur);
            Placer (Damier => Damier, Courant => Courant, Compteur => Compteur);
        end loop;
        Afficher (Damier => Damier);
    end Lancer_Magique;
end Magique;

    nblk1=6
    nid=6
    hdr6=8
        [0x00] rec0=22 rec1=00 rec2=01 rec3=04e
        [0x01] rec0=1f rec1=00 rec2=04 rec3=064
        [0x02] rec0=20 rec1=00 rec2=02 rec3=056
        [0x03] rec0=07 rec1=00 rec2=05 rec3=000
        [0x04] rec0=04 rec1=00 rec2=02 rec3=000
        [0x05] rec0=43 rec1=a7 rec2=ad rec3=0c9
    tail 0x217545c4887508b219fed 0x42a00088462060003
Free Block Chain:
  0x6: 0000  00 03 00 f3 80 01 3b 01 00 32 20 20 20 20 20 20  ┆      ;  2      ┆
  0x3: 0000  00 00 00 aa 80 2f 64 61 6d 69 65 72 3b 20 43 6f  ┆     /damier; Co┆