DataMuseum.dk

top - download

    Length: 6947 (0x1b23)
    Types: TextFile
    Names: »B«

└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
    └─ ⟦124ff5788⟧ »DATA« 
        └─⟦this⟧ 
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
    └─ ⟦6f12a12be⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Expertsystem, Chrono;
use Expertsystem;
package body Reines2 is

    Nbreste : Natural := 0;

    subtype Ttaille is Natural range 0 .. 9;  -- jusqu'a 9 reines
    type Rangee is array (Ttaille) of Ttaille;
    type Object is
        record
            Echiquier : Rangee := (others => 0);
            Rang : Ttaille := 0;
            Niveau : Ttaille := 0;
        end record;

    type Supportobject is
        record
            Name : String (1 .. 10) := "wood table";
            Here : String (1 .. 6) := "saloon";
        end record;

    Rangfinal : Ttaille := Ttaille'Last; -- but a atteindre (hauteur)
    Nivofinal : Ttaille := Ttaille'Last; -- but a atteindre (largeur)

    Affdemande : Boolean := True;

    package Behavior is new Classbehavior (Object, "QUEEN     ", 3000);
    package Support is new Classbehavior (Supportobject, "CHESSBOARD");



    procedure Enroute (Nbrereine : Natural; Affdem : Boolean) is
        Init : Object;
        Init1 : Supportobject;
    begin
        if Affdem then
            Debugger.Resetdebug (Debugger.Text);
            Debugger.Refreshdebug;
        end if;

        Affdemande := Affdem;

        Rangfinal := Ttaille (Nbrereine);
        Nivofinal := Rangfinal;
        Behavior.Clear;

        Init.Echiquier := (others => 0);
        Init.Rang := 0;
        Init.Niveau := 0;
        Behavior.Allocate (Init);

        Support.Clear;
        Support.Allocate (Init1);

    end Enroute;



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



    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 : Reines2.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)) then
                return (False);
            end if;
        end loop;
        return True;
    end Situationcorrecte;


    function Rangterminal return Tuplecollection.Object is
        function Rangfin (R1, R2 : Expertsystem.Reference) return Boolean is
        begin
            return (Behavior.Get (R1).Rang = Rangfinal);
        end Rangfin;
        function Cesrangs is new Tuplecollection.Join2 (Rangfin);
    begin
        return (Cesrangs (Behavior.Instances, Support.Instances));
    end Rangterminal;


    procedure Dessine (N : Natural) is
    begin
        for I in 1 .. N - 1 loop
            Put ("|   ");
        end loop;
        if N /= 0 then
            Put ("| o ");
        end if;
        for I in N + 1 .. Rangfinal loop
            Put ("|   ");
        end loop;
        Put_Line ("|");
    end Dessine;
    procedure Affiche (Uneref : Expertsystem.Reference) is
    begin
        for I in 1 .. 4 * Rangfinal + 1 loop
            Put ("=");
        end loop;
        Put_Line (" ");
        for I in 1 .. Rangfinal loop
            Dessine (Reines2.Behavior.Get (Uneref).Echiquier (I));
            for I in 1 .. 4 * Rangfinal + 1 loop
                Put ("=");
            end loop;
            Put_Line (" ");
        end loop;
    end Affiche;
    procedure Affichersol (Sol : Tuple.Object) is
    begin
        if Affdemande then
            Put_Line ("  ");
            Put_Line ("Voici une solution : ");
            Affiche (Tuple.First (Sol));
        end if;
        Behavior.Dispose (Tuple.First (Sol));

    end Affichersol;


    function Rangouvert return Tuplecollection.Object is
        Tc : Tuplecollection.Object;  
        function Rangetouvert
                    (R1, R2 : Expertsystem.Reference) return Boolean is
        begin
            return (Behavior.Get (R1).Niveau = Nivofinal);
        end Rangetouvert;
        function Lesrangs is new Tuplecollection.Join2 (Rangetouvert);
    begin
        Tc := Lesrangs (Behavior.Instances, Support.Instances);
        Nbreste := Tuplecollection.Cardinality (Tc);
        return Tc;
    end Rangouvert;

    procedure Fermer (Echiquier : Tuple.Object) is
        Sit : Expertsystem.Reference;
        Situation : Reines2.Object;
    begin
        Sit := Tuple.First (Echiquier);
        Situation := Behavior.Get (Sit);
        Situation.Niveau := Nivofinal;
        Behavior.Set (Sit, Situation);
        Behavior.Dispose (Sit);  -- suppression des situations inutiles
    end Fermer;



    function Rangnonouvert return Tuplecollection.Object is
        function Rangetpasouvert
                    (R1, R2 : Expertsystem.Reference) return Boolean is
        begin
            return (Behavior.Get (R1).Niveau /= Nivofinal);
        end Rangetpasouvert;
        function Lesrangs is new Tuplecollection.Join2 (Rangetpasouvert);
    begin
        return Lesrangs (Behavior.Instances, Support.Instances);
    end Rangnonouvert;


    procedure Ouvrir (Echiquier : Tuple.Object) is
        Situation : Reines2.Object;
        Sit : Expertsystem.Reference;
        Essai : Natural;
    begin
        Sit := Tuple.First (Echiquier);
        Situation := Behavior.Get (Sit);
        if Situationcorrecte (Sit, Situation.Rang + 1,
                              Situation.Niveau + 1) then
            Ajoutsituation (Sit, Situation.Rang + 1, Situation.Niveau + 1);
        end if;
        Situation.Niveau := Situation.Niveau + 1;
        Behavior.Set (Sit, Situation);
    end Ouvrir;


    package Tenage is new Engine (Context_Name => "the Queens",
                                  Resolution => Lex,
                                  Used_Rules => 3,
                                  Name_1 => "last level down",
                                  Condition_1 => Rangterminal,
                                  Action_1 => Affichersol,
                                  Name_2 => "last level righ",
                                  Condition_2 => Rangouvert,
                                  Action_2 => Fermer,
                                  Name_3 => "go to right    ",
                                  Condition_3 => Rangnonouvert,
                                  Action_3 => Ouvrir);

    function Continue return Boolean is
    begin
        return (Tenage.Inference (1));
    end Continue;

end Reines2;