|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ R T ┃
Length: 10912 (0x2aa0)
Types: TextFile
Names: »ROBOT_ADA«
└─⟦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⟧
with expertSystem; use expertSystem;
package Brique is
subtype tTaille is natural;
type tCouleur is (rose, grise, blanche);
type tLieu is (tas, pince, boite);
subtype tCase is positive;
type object is private;
function lesBriques return collection.object;
function surTas (r : reference) return boolean;
function dansPince (r : reference) return boolean;
function laPlusGrandeDuTas(r : reference) return boolean;
function taille (r : reference) return tTaille;
procedure creer;
procedure modifierLieu (r : reference ; l : tLieu);
procedure modifierBoite (r : reference ; c : tCase);
private
type object is record
taille : tTaille :=1;
couleur : tCouleur :=rose;
lieu : tLieu :=tas;
boite : tCase;
end record;
end Brique;
with expertSystem ; use expertSystem;
package body Brique is
package Behavior is new classBehavior(object,"BRIQUES ");
function lesBriques return collection.object is
begin
return Behavior.allInstances;
end lesBriques;
function surTas(r : reference) return boolean is
begin
return Behavior.get(r).lieu = tas;
end surTas;
function dansPince(r : reference) return boolean is
begin
return Behavior.get(r).lieu = pince;
end dansPince;
function briquesSurTas is new collection.restrict(surTas);
function plusGrande(r, any : reference) return boolean is
begin
return Behavior.get(r).taille > Behavior.get(any).taille;
end plusGrande;
function laPlusGrande is new collection.theMost(plusGrande);
function laPlusGrandeDuTas(r : reference) return boolean is
begin
return Behavior.get(r).taille =
Behavior.get(laPlusGrande(briquesSurTas(Behavior.instances))).taille;
end laPlusGrandeDuTas;
function taille(r : reference) return tTaille is
begin
return Behavior.get(r).taille;
end taille;
procedure creer is
begin
for i in 10..30 loop
behavior.allocate(object'(tTaille(i),rose,tas,tCase(1)));
end loop;
put_line(" ");
put(" Nb briques : ");
put(Behavior.cardinality);
put_line(" ");
end creer;
procedure modifierLieu(r : reference ; l : tLieu) is
uneBrique : object;
begin
uneBrique := Behavior.get(r);
uneBrique.lieu := l;
Behavior.set(r,uneBrique);
end modifierLieu;
procedure modifierBoite(r : reference ; c : tCase) is
uneBrique : object;
begin
uneBrique := Behavior.get(r);
uneBrique.boite := c;
Behavior.set(r,uneBrique);
end modifierBoite;
end Brique;
with expertSystem ; use expertSystem;
package Robot is
type object is private;
subtype tNom is string(1..10);
type tTache is (prendre, deposer);
subtype tCase is positive;
function lesRobots return collection.object;
function derniereBoite return tCase;
function nom (r : reference) return tNom;
function numeroBoite (r : reference) return tCase;
function peutPrendre (r : reference) return boolean;
function peutDeposer (r : reference) return boolean;
function tientBrique (r : reference) return boolean;
procedure creer;
procedure modifierPince(r : reference ; b : boolean);
procedure modifierTache(r : reference ; a : tTache);
procedure modifierBoite(r : reference ; c : tCase);
procedure seSuicide (r : reference);
private
NumeroCourant : tCase :=1;
type object is record
nom : tNom;
boite : tCase;
tache : tTache;
pinceOccupee : boolean :=FALSE;
end record;
end Robot;
with expertSystem ; use expertSystem;
package body Robot is
package Behavior is new classBehavior(object,"ROBOTS ");
function lesRobots return collection.object is
begin
return Behavior.instances;
end lesRobots;
function peutPrendre(r : reference) return boolean is
begin
return Behavior.get(r).tache = prendre;
end peutPrendre;
function peutDeposer(r : reference) return boolean is
begin
return Behavior.get(r).tache = deposer;
end peutDeposer;
function tientBrique(r : reference) return boolean is
begin
return Behavior.get(r).pinceOccupee;
end tientBrique;
function nom(r : reference) return tNom is
begin
return Behavior.get(r).nom;
end nom;
function numeroBoite(r : reference) return tCase is
begin
return Behavior.get(r).boite;
end numeroBoite;
function derniereBoite return tCase is
begin
NumeroCourant := NumeroCourant+1;
return NumeroCourant-1;
end derniereBoite;
procedure creer is
begin
behavior.allocate(object'("Robot No 1",1,prendre,FALSE));
behavior.allocate(object'("Robot No 2",1,prendre,FALSE));
put(" Nb robots : ");
put(Behavior.cardinality);
put_line(" ");
end creer;
procedure modifierPince(r : reference ; b : boolean) is
unRobot : object;
begin
unRobot := Behavior.get(r);
unRobot.pinceOccupee := b;
Behavior.set(r,unRobot);
end modifierPince;
procedure modifierTache(r : reference ; a : tTache) is
unRobot : object;
begin
unRobot := Behavior.get(r);
unRobot.tache := a;
Behavior.set(r,unRobot);
end modifierTache;
procedure modifierBoite(r : reference ; c : tCase) is
unRobot : object;
begin
unRobot := Behavior.get(r);
unRobot.boite := c;
Behavior.set(r,unRobot);
end modifierBoite;
procedure seSuicide(r : reference) is
begin
Behavior.dispose(r);
end seSuicide;
end Robot;
-------------------------------------------------------------------------------
-- DESCRIPTION DES REGLES --
-------------------------------------------------------------------------------
with expertSystem ; use expertSystem;
with Robot,Brique ; use Robot,Brique;
procedure travailler is
package robotEtBrique is
procedure miseEnBoite;
end robotEtBrique;
package body robotEtBrique is
function peutMettreEnBoite return boolean is
begin
regleSaisir:
declare
RB : tuple.object;
uneBrique, unRobot: reference;
function match(R, B : reference) return
boolean is
begin
return peutPrendre(R) and then
not tientBrique(R) and then
surTas(B) and then
laPlusGrandeDuTas(B);
end match;
function robotSaisir is new tupleCollection.join2(match);
begin
RB := tupleCollection.first(
robotSaisir(lesRobots,lesBriques));
if tuple.isNotNull(RB) then
unRobot := tuple.first(RB);
uneBrique := tuple.second(RB);
Robot.modifierPince(unRobot,TRUE);
Brique.modifierLieu (uneBrique,pince);
put("Le ") ; put(Robot.nom(unRobot));
put(" prend la plus grande brique (taille=");
put(integer(Brique.taille(uneBrique)));
put_line(") du tas dans sa pince ");
return TRUE;
end if;
end regleSaisir;
regleTenir:
declare
RB : tuple.object;
unRobot : reference;
function match(R, B: reference) return
boolean is
begin
return peutPrendre(R) and then
tientBrique(R) and then
dansPince(B);
end match;
function robotTenir is new tupleCollection.join2(match);
begin
RB := tupleCollection.first(robotTenir(lesRobots,lesBriques));
if tuple.isNotNull(RB) then
unRobot := tuple.first(RB);
Robot.modifierTache(unRobot,deposer);
put("Le "); put(Robot.nom(unRobot));
put_line(" va deposer la brique ");
return TRUE;
end if;
end regleTenir;
regleCaser:
declare
RB : tuple.object;
uneBrique, unRobot : reference;
function match(R, B: reference) return
boolean is
begin
return peutDeposer(R) and then
dansPince(B);
end match;
function robotCaser is new tupleCollection.join2(match);
begin
RB := tupleCollection.first(robotCaser(lesRobots,lesBriques));
if tuple.isNotNull(RB) then
unRobot := tuple.first(RB);
uneBrique := tuple.second(RB);
Brique.modifierLieu(uneBrique,boite);
Robot.modifierTache(unRobot,prendre);
Robot.modifierBoite(unRobot,Robot.derniereBoite);
Brique.modifierBoite(uneBrique,Robot.numeroBoite(unRobot));
put("Le "); put(Robot.nom(unRobot));
put(" depose la brique dans la case");
put(integer(Robot.numeroBoite(unRobot))); put_line("");
Robot.modifierPince(unRobot,FALSE);
return TRUE;
end if;
end regleCaser;
regleArreter:
declare
RB : tuple.object;
unRobot : reference;
function match(R, B: reference) return
boolean is
begin
return peutPrendre(R) and then
not tientBrique(R) and then
not surTas(B);
end match;
function robotArreter is new tupleCollection.join2(match);
begin
RB := tupleCollection.first(robotArreter(lesRobots,lesBriques));
if not tuple.isNull(RB) then
unRobot := tuple.first(RB);
put("Le "); put(Robot.nom(unRobot));
put_line(" se suicide (plus de briques)");
Robot.seSuicide(unRobot);
return TRUE;
end if;
end regleArreter;
return FALSE;
end peutMettreEnBoite;
procedure mettreEnBoite is
begin
loop
exit when not peutMettreEnBoite;
end loop;
end mettreEnBoite;
procedure miseEnBoite is
begin
Robot.creer;
Brique.creer;
loop
mettreEnBoite;
-- autres contextes a traiter
exit;
end loop;
end miseEnBoite;
end robotEtBrique;
begin
robotEtBrique.miseEnBoite;
end travailler;