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

⟦74ccff7f9⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Reines, seg_00e3bf

Derivation

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

with Expertsystem, Chrono;
use Expertsystem;
package body Reines is
    package Behavior is new Classbehavior (Object, "QUEEN     ", 3000);
    procedure Enroute (Nbrereine : Natural) is
        Init : Reines.Object;
    begin
        Rangcourant := 0;
        Rangfinal := Ttaille (Nbrereine);
        Behavior.Clear;
        Init.Echiquier := (others => 0);
        Init.Niveau := 0;
        Init.Ouvert := False;
        Behavior.Allocate (Init);
    end Enroute;


    function Niveaunonouvert (Niveau : Ttaille) return Collection.Object is
        function Niveauetpasouvert
                    (Uneref : Expertsystem.Reference) return Boolean is
        begin
            return (Behavior.Get (Uneref).Niveau = Niveau and
                    Behavior.Get (Uneref).Ouvert = False);
        end Niveauetpasouvert;
        function Lesniveaux is new Collection.Restrict (Niveauetpasouvert);
    begin
        return Lesniveaux (Behavior.Instances);
    end Niveaunonouvert;

    function Niveaufinal (Niveau : Ttaille) return Collection.Object is
        function Niveaufin (Uneref : Expertsystem.Reference) return Boolean is
        begin
            return (Behavior.Get (Uneref).Niveau = Niveau);
        end Niveaufin;
        function Cesniveaux is new Collection.Restrict (Niveaufin);
    begin
        return (Cesniveaux (Behavior.Instances));
    end Niveaufinal;

    procedure Dessine (N : Natural) is
    begin
        for I in 1 .. N - 1 loop
            Put ("|   ");
        end loop;
        Put ("| o ");
        for I in N + 1 .. Rangfinal loop
            Put ("|   ");
        end loop;
        Put_Line ("|");
    end Dessine;
    procedure Affiche (Uneref : Expertsystem.Reference) is
    begin
        Put_Line (" ");
        Put_Line ("Voici une solution : ");
        for I in 1 .. 4 * Rangfinal + 1 loop
            Put ("=");
        end loop;
        Put_Line (" ");
        for I in 1 .. Rangfinal loop
            Dessine (Reines.Behavior.Get (Uneref).Echiquier (I));
            for I in 1 .. 4 * Rangfinal + 1 loop
                Put ("=");
            end loop;
            Put_Line (" ");
        end loop;
    end Affiche;
    procedure Lesafficher is new Collection.Forall (Affiche);
    procedure Affichersol (Sol : Collection.Object) is
    begin
        Put ("Nombre de solutions :");
        Put (Integer (Collection.Cardinality (Sol)));
        Put_Line ("  ");
        Lesafficher (Sol);
    end Affichersol;

    procedure Ajoutsituation (Sit : Expertsystem.Reference;
                              Rang : Ttaille;
                              Colonne : Ttaille) is
        Situation : Reines.Object;
    begin
        Situation := Behavior.Get (Sit);
        Situation.Echiquier (Rang) := Colonne;
        Situation.Niveau := Situation.Niveau + 1;
        Situation.Ouvert := False;
        Behavior.Allocate (Situation);
    end Ajoutsituation;

    procedure Fermesituation (Sit : Expertsystem.Reference) is
        Situation : Reines.Object;
    begin
        Situation := Behavior.Get (Sit);
        Situation.Ouvert := True;
        Behavior.Set (Sit, Situation);

        Behavior.Dispose (Sit);  -- suppression des situations inutiles
    end Fermesituation;

    function Situationcorrecte
                (Sit : Expertsystem.Reference; -- echiquier courant
                 Rang : Ttaille;           -- nouvelle ligne
                 Colonne : Ttaille)           -- position reine dans
                return Boolean is               -- la ligne
-- rend VRAI si une reine peut etre mise en (rang,colonne) sans risque du aux
-- autres reines etant deja sur l'echiquier sur les lignes 1..rang-1
        Situation : Reines.Object;
    begin
        Situation := Behavior.Get (Sit);
        for Ligne in 1 .. Rang - 1 loop
            if Situation.Echiquier (Ligne) = Colonne          -- meme colonne
                or
               Rang - Ligne =
                  abs (Colonne -
                       Situation.Echiquier (Ligne)) -- meme diagonale a gauche
                then
                return (False);
            end if;
        end loop;
        return True;
    end Situationcorrecte;

end Reines;

    nblk1=5
    nid=0
    hdr6=a
        [0x00] rec0=1d rec1=00 rec2=01 rec3=010
        [0x01] rec0=1f rec1=00 rec2=02 rec3=024
        [0x02] rec0=1b rec1=00 rec2=03 rec3=010
        [0x03] rec0=17 rec1=00 rec2=04 rec3=090
        [0x04] rec0=0e rec1=00 rec2=05 rec3=001
    tail 0x2150a013c821e3fc78150 0x42a00088462060003