|
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 - metrics - download
Length: 9216 (0x2400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Reines2, seg_00e3c1
└─⟦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 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;
nblk1=8
nid=0
hdr6=10
[0x00] rec0=22 rec1=00 rec2=01 rec3=01e
[0x01] rec0=26 rec1=00 rec2=02 rec3=000
[0x02] rec0=18 rec1=00 rec2=03 rec3=068
[0x03] rec0=20 rec1=00 rec2=04 rec3=028
[0x04] rec0=1f rec1=00 rec2=05 rec3=04a
[0x05] rec0=1e rec1=00 rec2=06 rec3=00e
[0x06] rec0=14 rec1=00 rec2=07 rec3=07a
[0x07] rec0=0b rec1=00 rec2=08 rec3=000
tail 0x2150a0140821e3fc9f2e6 0x42a00088462060003