|
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 - download
Length: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Robotetbrique, procedure Mise_En_Casier_1, seg_011e9a
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Expertsystem;
use Expertsystem;
with Robot, Brique;
use Robot, Brique;
procedure Mise_En_Casier_1 is
package Robotetbrique is
procedure Miseenboite;
end Robotetbrique;
package body Robotetbrique is
Casier : Natural := 0;
function Peutmettreenboite return Boolean is
begin
Regle_Saisir_Tenir:
-- (classe => robot, tache => prendre)
-- (classe => brique, lieu => tas, taille=> <x> )
-- !(classe => brique, lieu => tas, taille=> (> <x>))
--------------------------------------------------------
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);
Robot.Modifiertache (Unrobot, Deposer);
Put_Line ("RegleSaisir : " & Robot.Nom (Unrobot) &
" prend brique (taille=" &
Integer'Image (Brique.Taille (Unebrique)) &
" / couleur = " &
Tcouleur'Image (Brique.Couleur (Unebrique)));
Put_Line (" ");
return True;
end if;
end Regle_Saisir_Tenir;
--
-- Regletenir:
-- -- (classe => robot, tache => prendre)
-- -- (classe => brique, lieu => pince)
-- --------------------------------------------
-- declare
-- Rb : Tuple.Object;
-- Unrobot : Reference;
-- Unebrique : 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);
-- Unebrique := Tuple.Second (Rb);
-- Robot.Modifiertache (Unrobot, Deposer);
--
-- Put ("RegleTenir : Le ");
-- Put (Robot.Nom (Unrobot));
-- Put (" va deposer la brique ");
-- Put_Line (Tcouleur'Image (Brique.Couleur (Unebrique)));
-- Put_Line (" ");
--
-- return True;
-- end if;
-- end Regletenir;
--
Reglecaser:
-- (classe => robot, tache => deposer, case => <c>)
-- (classe => brique, lieu => pince)
------------------------------------------------------
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 ("RegleCaser : 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:
-- (classe => robot, tache => prendre)
-- !(classe => brique, lieu => tas)
-----------------------------------------
declare
Rb : Tuple.Object;
Unrobot : Reference;
function Match (R, B : Reference) return Boolean is
begin
return Peutprendre (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 ("RegleArreter : 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 Mise_En_Casier_1;
nblk1=b
nid=7
hdr6=14
[0x00] rec0=1e rec1=00 rec2=01 rec3=074
[0x01] rec0=00 rec1=00 rec2=0b rec3=004
[0x02] rec0=14 rec1=00 rec2=05 rec3=042
[0x03] rec0=17 rec1=00 rec2=02 rec3=014
[0x04] rec0=16 rec1=00 rec2=06 rec3=04a
[0x05] rec0=01 rec1=00 rec2=03 rec3=01e
[0x06] rec0=15 rec1=00 rec2=08 rec3=030
[0x07] rec0=18 rec1=00 rec2=04 rec3=03a
[0x08] rec0=1e rec1=00 rec2=0a rec3=018
[0x09] rec0=11 rec1=00 rec2=09 rec3=000
[0x0a] rec0=28 rec1=00 rec2=00 rec3=010
tail 0x2170df0fe82466d04f815 0x42a00088462060003
Free Block Chain:
0x7: 0000 00 00 00 17 80 14 65 6e 74 62 72 69 71 75 65 20 ┆ entbrique ┆